Commit a6dec362 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim
Browse files

Implement CreateModule

parent 5dd42c33
...@@ -15,7 +15,7 @@ import PmDriver ...@@ -15,7 +15,7 @@ import PmDriver
import PmEnvironment import PmEnvironment
import PmProject import PmProject
import set_return_code import set_return_code
import StdEnv import StdEnv, StdFile
import Text import Text
import UtilIO import UtilIO
import UtilStrictLists import UtilStrictLists
...@@ -37,9 +37,13 @@ import UtilStrictLists ...@@ -37,9 +37,13 @@ import UtilStrictLists
| RemovePathAction String | RemovePathAction String
:: ModuleAction :: ModuleAction
= CreateModule = CreateModule ModuleType
| ModuleHelp | ModuleHelp
:: ModuleType
= ApplicationModule
| LibraryModule
pNotSpace :: CParser Char [Char] a pNotSpace :: CParser Char [Char] a
pNotSpace = sp (<+> (satisfy (not o isWhite))) pNotSpace = sp (<+> (satisfy (not o isWhite)))
...@@ -66,7 +70,8 @@ pIDEEnvs = spstrtok "--envs" &> (<?> (spsymbol '=')) &> pNotSpace <@ toString <! ...@@ -66,7 +70,8 @@ pIDEEnvs = spstrtok "--envs" &> (<?> (spsymbol '=')) &> pNotSpace <@ toString <!
pModule :: CParser Char CpmAction a pModule :: CParser Char CpmAction a
pModule = spstrtok "module" &> pNotSpace <&> \mn -> (pModuleAction <!> yield ModuleHelp) <@ Module (toString mn) 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 -> *World
Start world Start world
...@@ -91,7 +96,7 @@ doCpmAction world _ _ _ = ...@@ -91,7 +96,7 @@ doCpmAction world _ _ _ =
help "cpm <target>" help "cpm <target>"
[ "Where <target> is one of the following:" [ "Where <target> is one of the following:"
, " project <projectname> : project actions" , " project <projectname> : project actions"
, " module : module actions" , " module <modulename> : module actions"
, "" , ""
, "Execute `cpm <target> help` to get help for specific actions."] world , "Execute `cpm <target> help` to get help for specific actions."] world
...@@ -169,15 +174,38 @@ openProject cleanhome projectfile world ...@@ -169,15 +174,38 @@ openProject cleanhome projectfile world
= (Error err, world) = (Error err, world)
doModuleAction :: *World .String .String .ModuleAction -> .World doModuleAction :: *World .String .String .ModuleAction -> .World
doModuleAction world cleanhome mn CreateModule doModuleAction world cleanhome mn (CreateModule mt)
# basenm = dropExtension mn
# dclnm = addExtension basenm "dcl"
# iclnm = addExtension basenm "icl"
# (dclexists, world) = fileExists dclnm world # (dclexists, world) = fileExists dclnm world
| dclexists = error ("Definition module '" +++ dclnm +++ "' already exists.") world | dclexists = dexerr world
# (iclexists, world) = fileExists iclnm world # (iclexists, world) = fileExists iclnm world
| dclexists = error ("Implementation module '" +++ iclnm +++ "' already exists.") world | iclexists = iexerr world
= undef = 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 _ _ _ = doModuleAction world _ _ _ =
help "cpm module <modulename> <action>" help "cpm module <modulename> <action>"
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment