Commit a6dec362 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim

Implement CreateModule

parent 5dd42c33
......@@ -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>"
......
Markdown is supported
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