No more catch-all aliases, and default aliases go to a separate file
[hcoop/domtool2.git] / src / plugins / alias.sml
index 6d6ab43..b96d57d 100644 (file)
@@ -24,39 +24,41 @@ open Ast
 
 structure SM = DataStructures.StringMap
 
 
 structure SM = DataStructures.StringMap
 
-val aliases : TextIO.outstream SM.map ref = ref SM.empty
+val aliases : Domain.files SM.map ref = ref SM.empty
 fun aliasesF node = valOf (SM.find (!aliases, node))
 
 fun aliasesF node = valOf (SM.find (!aliases, node))
 
-val aliasesD : TextIO.outstream SM.map ref = ref SM.empty
+val aliasesD : Domain.files SM.map ref = ref SM.empty
 fun aliasesDF node = valOf (SM.find (!aliasesD, node))
 
 fun write nodes =
     let
        val files = map (fn node => aliasesF node) nodes
     in
 fun aliasesDF node = valOf (SM.find (!aliasesD, node))
 
 fun write nodes =
     let
        val files = map (fn node => aliasesF node) nodes
     in
-       fn s => app (fn file => TextIO.output (file, s)) files
+       (fn s => app (fn file => #write file s) files,
+        fn () => app (fn file => #writeDom file ()) files)
     end
 
 fun writeD nodes =
     let
        val files = map (fn node => aliasesDF node) nodes
     in
     end
 
 fun writeD nodes =
     let
        val files = map (fn node => aliasesDF node) nodes
     in
-       fn s => app (fn file => TextIO.output (file, s)) files
+       (fn s => app (fn file => #write file s) files,
+        fn () => app (fn file => #writeDom file ()) files)
     end
 
 fun openInAll base = foldl (fn (node, r) =>
                               SM.insert (r,
                                          node,
     end
 
 fun openInAll base = foldl (fn (node, r) =>
                               SM.insert (r,
                                          node,
-                                         Domain.domainFile {node = node, name = base}))
-                          SM.empty Config.nodes
+                                         Domain.domainsFile {node = node, name = base}))
+                          SM.empty Domain.nodes
 
 val _ = Domain.registerBefore
            (fn _ => (aliases := openInAll "aliases";
                      aliasesD := openInAll "aliases.default"))
        
 val _ = Domain.registerAfter
 
 val _ = Domain.registerBefore
            (fn _ => (aliases := openInAll "aliases";
                      aliasesD := openInAll "aliases.default"))
        
 val _ = Domain.registerAfter
-       (fn _ => (SM.app TextIO.closeOut (!aliases);
-                 SM.app TextIO.closeOut (!aliasesD)))
+       (fn _ => (SM.app (fn file => #close file ()) (!aliases);
+                 SM.app (fn file => #close file ()) (!aliasesD)))
 
 fun validEmailUser s =
     size s > 0 andalso size s < 50
 
 fun validEmailUser s =
     size s > 0 andalso size s < 50
@@ -83,12 +85,10 @@ val _ = Env.type_one "email"
 datatype aliasSource =
         User of string
        | Default
 datatype aliasSource =
         User of string
        | Default
-       | CatchAll
 
 val source = fn (EApp ((EVar "userSource", _), e), _) =>
                Option.map User (Env.string e)
              | (EVar "defaultSource", _) => SOME Default
 
 val source = fn (EApp ((EVar "userSource", _), e), _) =>
                Option.map User (Env.string e)
              | (EVar "defaultSource", _) => SOME Default
-             | (EVar "catchAllSource", _) => SOME CatchAll
              | _ => NONE
 
 datatype aliasTarget =
              | _ => NONE
 
 datatype aliasTarget =
@@ -117,8 +117,8 @@ fun writeSource (env, s, t) =
     let
        val nodes = Env.env (Env.list Env.string) (env, "MailNodes")
 
     let
        val nodes = Env.env (Env.list Env.string) (env, "MailNodes")
 
-       val write = write nodes
-       val writeD = writeD nodes
+       val (write, writeDom) = write nodes
+       val (writeD, writeDomD) = writeD nodes
 
        fun writeTarget (writer, t) =
            case t of
 
        fun writeTarget (writer, t) =
            case t of
@@ -130,20 +130,15 @@ fun writeSource (env, s, t) =
        case s of
            User s => (write s;
                       write "@";
        case s of
            User s => (write s;
                       write "@";
-                      write (Domain.currentDomain ());
+                      writeDom ();
                       write ": ";
                       writeTarget (write, t);
                       write "\n")
                       write ": ";
                       writeTarget (write, t);
                       write "\n")
-         | Default => (write "*@";
-                       write (Domain.currentDomain ());
-                       write ": ";
-                       writeTarget (write, t);
-                       write "\n")
-         | CatchAll => (writeD "*@";
-                        writeD (Domain.currentDomain ());
-                        writeD ": ";
-                        writeTarget (writeD, t);
-                        writeD "\n")
+         | Default => (writeD "*@";
+                       writeDomD ();
+                       writeD ": ";
+                       writeTarget (writeD, t);
+                       writeD "\n")
     end
                        
 val _ = Env.actionV_two "aliasPrim"
     end
                        
 val _ = Env.actionV_two "aliasPrim"