Refactoring plugins

[hcoop/domtool2.git] / src / domain.sml

diff --git a/src/domain.sml b/src/domain.sml
index 4ec6f55..394bf80 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -60,6 +60,8 @@ fun registerAfter f =
 val current = ref ""
 val currentPath = ref ""
 
+val scratch = ref ""
+
 fun currentDomain () = !current
 
 fun domainFile name = TextIO.openOut (!currentPath ^ name)
@@ -72,6 +74,7 @@ fun getPath domain =
                              let
                                  val elems = piece :: elems
                                  val path = String.concatWith "/" (Config.resultRoot :: rev elems)
+                                 val tmpPath = String.concatWith "/" (Config.tmpDir :: rev elems)
                              in
                                  (if Posix.FileSys.ST.isDir
                                          (Posix.FileSys.stat path) then
@@ -80,17 +83,138 @@ fun getPath domain =
                                       (OS.FileSys.remove path;
                                        OS.FileSys.mkDir path))
                                  handle OS.SysErr _ => OS.FileSys.mkDir path;
+
+                                 (if Posix.FileSys.ST.isDir
+                                         (Posix.FileSys.stat tmpPath) then
+                                      ()
+                                  else
+                                      (OS.FileSys.remove tmpPath;
+                                       OS.FileSys.mkDir tmpPath))
+                                 handle OS.SysErr _ => OS.FileSys.mkDir tmpPath;
+
                                  elems
                              end) [] toks
     in
-       String.concatWith "/" (Config.resultRoot :: rev ("" :: elems))
+       fn root => String.concatWith "/" (root :: rev ("" :: elems))
+    end
+
+datatype file_action' =
+        Add' of {src : string, dst : string}
+       | Delete' of string
+       | Modify' of {src : string, dst : string}
+
+fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss))
+
+fun shellF (ss, msg) =
+    let
+       val s = String.concat ss
+    in
+       if OS.Process.isSuccess (OS.Process.system s) then
+           ()
+       else
+           ErrorMsg.error NONE (msg s)
+    end
+
+fun findDiffs dom =
+    let
+       val realPath = getPath dom Config.resultRoot
+       val tmpPath = !currentPath
+
+       val dir = Posix.FileSys.opendir realPath
+
+       fun loopReal acts =
+           case Posix.FileSys.readdir dir of
+               NONE => (Posix.FileSys.closedir dir;
+                        acts)
+             | SOME fname =>
+               let
+                   val real = OS.Path.joinDirFile {dir = realPath,
+                                                   file = fname}
+                   val tmp = OS.Path.joinDirFile {dir = tmpPath,
+                                                  file = fname}
+               in
+                   if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
+                       loopReal acts
+                   else if Posix.FileSys.access (tmp, []) then
+                       if shell [Config.diff, " ", real, " ",  tmp] then
+                           loopReal acts
+                       else
+                           loopReal (Modify' {src = tmp, dst = real} :: acts)
+                   else
+                       loopReal (Delete' real :: acts)
+               end
+
+       val acts = loopReal []
+
+       val dir = Posix.FileSys.opendir realPath
+
+       fun loopTmp acts =
+           case Posix.FileSys.readdir dir of
+               NONE => (Posix.FileSys.closedir dir;
+                        acts)
+             | SOME fname =>
+               let
+                   val real = OS.Path.joinDirFile {dir = realPath,
+                                                   file = fname}
+                   val tmp = OS.Path.joinDirFile {dir = tmpPath,
+                                                  file = fname}
+               in
+                   if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
+                       loopTmp acts
+                   else if Posix.FileSys.access (real, []) then
+                       loopTmp acts
+                   else
+                       loopTmp (Add' {src = tmp, dst = real} :: acts)
+               end
+
+       val acts = loopTmp acts
+    in
+       acts
     end
 
 val _ = Env.container_one "domain"
                          ("domain", Env.string)
-                         (fn dom => (current := dom;
-                                     currentPath := getPath dom;
-                                     !befores dom),
-                          fn () => !afters (!current))
+                         (fn dom =>
+                             let
+                                 val path = getPath dom Config.tmpDir
+                             in
+                                 current := dom;
+                                 currentPath := path;
+                                 !befores dom
+                             end,
+                          fn () =>
+                             let
+                                 val dom = !current
+                                 val () = !afters dom
+
+                                 val diffs = findDiffs dom
+
+                                 val diffs = map (fn Add' {src, dst} =>
+                                                     (shellF ([Config.cp, " ", src, " ", dst],
+                                                             fn cl => "Copy failed: " ^ cl);
+                                                      {action = Slave.Add,
+                                                       domain = dom,
+                                                       file = dst})
+                                                   | Delete' dst =>
+                                                     (OS.FileSys.remove dst
+                                                      handle OS.SysErr _ =>
+                                                             ErrorMsg.error NONE ("Delete failed for " ^ dst);
+                                                      {action = Slave.Delete,
+                                                       domain = dom,
+                                                       file = dst})
+                                                   | Modify' {src, dst} =>
+                                                     (shellF ([Config.cp, " ", src, " ", dst],
+                                                          fn cl => "Copy failed: " ^ cl);
+                                                      {action = Slave.Modify,
+                                                       domain = dom,
+                                                       file = dst})) diffs
+                             in
+                                 if !ErrorMsg.anyErrors then
+                                     ()
+                                 else
+                                     Slave.handleChanges diffs;
+                                 ignore (shellF ([Config.rm, " -rf ", Config.tmpDir, "/*"],
+                                                 fn cl => "Temp file cleanup failed: " ^ cl))
+                             end)
 
 end