Implement CreateModule

cpm/Cpm.icl

@@ -15,7 +15,7 @@ import PmDriver
 import PmEnvironment
 import PmProject
 import set_return_code
-import StdEnv
+import StdEnv, StdFile
 import Text
 import UtilIO
 import UtilStrictLists
@@ -37,9 +37,13 @@ import UtilStrictLists
   |  RemovePathAction String
 
 :: ModuleAction
-  =  CreateModule
+  =  CreateModule ModuleType
   |  ModuleHelp
 
+:: ModuleType
+  =  ApplicationModule
+  |  LibraryModule
+
 pNotSpace :: CParser Char [Char] a
 pNotSpace = sp (<+> (satisfy (not o isWhite)))
 
@@ -66,7 +70,8 @@ pIDEEnvs = spstrtok "--envs" &> (<?> (spsymbol '=')) &> pNotSpace <@ toString <!
 
 pModule :: CParser Char CpmAction a
 pModule = spstrtok "module" &> pNotSpace <&> \mn -> (pModuleAction <!> yield ModuleHelp) <@ Module (toString mn)
-  where  pModuleAction  =  spstrtok "create" <@ const CreateModule
+  where  pModuleAction  =  spstrtok "create" &> pModuleType <@ CreateModule
+         pModuleType    =  spstrtok "application" <@ const ApplicationModule <|> yield LibraryModule
 
 Start :: *World -> *World
 Start world
@@ -91,7 +96,7 @@ doCpmAction world _          _    _                =
   help  "cpm <target>"
     [  "Where <target> is one of the following:"
     ,  "  project <projectname>  : project actions"
-    ,  "  module                 : module actions"
+    ,  "  module <modulename>    : module actions"
     ,  ""
     ,  "Execute `cpm <target> help` to get help for specific actions."] world
 
@@ -169,15 +174,38 @@ openProject cleanhome projectfile world
         = (Error err, world)
 
 doModuleAction :: *World .String .String .ModuleAction -> .World
-doModuleAction world cleanhome mn  CreateModule
-  # basenm              = dropExtension mn
-  # dclnm               = addExtension basenm "dcl"
-  # iclnm               = addExtension basenm "icl"
+doModuleAction world cleanhome mn  (CreateModule mt)
   # (dclexists, world)  = fileExists dclnm world
-  | dclexists           = error ("Definition module '" +++ dclnm +++ "' already exists.") world
+  | dclexists           = dexerr world
   # (iclexists, world)  = fileExists iclnm world
-  | dclexists           = error ("Implementation module '" +++ iclnm +++ "' already exists.") world
-  = undef
+  | iclexists           = iexerr world
+  = writeMods world mt
+  where  basenm     = dropExtension mn
+         dclnm      = addExtension basenm "dcl"
+         iclnm      = addExtension basenm "icl"
+
+         mkmod mty  = mty +++ "module " +++ basenm
+
+         writeMods world ApplicationModule  = writeicl world ApplicationModule
+         writeMods world LibraryModule
+           # world = writeicl world ApplicationModule
+           = writedcl world
+
+         writeicl world ApplicationModule = writeicl` world "implementation "
+
+         writeicl world LibraryModule = writeicl` world ""
+
+         writeicl` world pref = writemod world iclnm pref ("Failed to write implementation module '" +++ basenm +++ "'")
+
+         writedcl world = writemod world dclnm "definition " ("Failed to write definition module '" +++ basenm +++ "'")
+
+         writemod world nm pref errmsg
+           # (me, world)  = writeFile nm (mkmod pref) world
+           | isError me   = error errmsg world
+           = world
+
+         dexerr world = error ("Definition module '" +++ dclnm +++ "' already exists.") world
+         iexerr world = error ("Implementation module '" +++ iclnm +++ "' already exists.") world
 
 doModuleAction world _ _   _                  =
   help "cpm module <modulename> <action>"