Commit 30d97304 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim

Adhere to platform conventions. Use a more functional style of programming.

parent 4f22fc33
......@@ -15,10 +15,11 @@ import PmDriver
import PmEnvironment
import PmProject
import set_return_code
import StdEnv, StdFile
import StdBool, StdEnum, StdFile, StdFunc, StdMisc
import Text
import UtilIO
import UtilStrictLists
import Reader, State
:: CpmAction
= Project FilePath ProjectAction
......@@ -74,13 +75,15 @@ pForce :: CParser Char Bool a
pForce = (spstrtok "--force" <@ const True) <|> (yield False)
pIDEEnvs :: CParser Char String a
pIDEEnvs = (spstrtok "--envs" &> (<?> (spsymbol '=')) &> pNotSpace <@ toString) <!> (yield EnvsFileName)
pIDEEnvs = (spstrtok "--envs" &> (<?> (spsymbol '=')) &> pNotSpace <@ toString)
<!> (yield EnvsFileName)
pModule :: CParser Char CpmAction a
pModule = spstrtok "module" &> pNotSpace <&> \mn -> pModuleAction <@ Module (toString mn)
where pModuleAction = (spstrtok "create" &> pModuleType <@ CreateModule)
<!> (yield ModuleHelp)
pModuleType = (spstrtok "application" <@ const ApplicationModule) <|> (yield LibraryModule)
<!> (pHelp ModuleHelp)
pModuleType = (spstrtok "application" <@ const ApplicationModule)
<|> (yield LibraryModule)
pHelp :: c -> CParser Char c a
pHelp c = (spstrtok "help" <@ const c) <|> (yield c)
......@@ -94,17 +97,17 @@ Start world
(ch, world) = case getEnvironmentVariable "CLEAN_HOME" world of
(Just ch, world) -> (ch, world)
(_, world) -> (pwd, world)
= doCpmAction world ch pwd cpm
= doCpmAction ch pwd cpm world
startParse :: [.Char] -> CpmAction
startParse args = case filter (\(xs, _) -> xs == []) (begin pCpm args) of
[(_, as):_] -> as
_ -> CpmHelp
doCpmAction :: *World String String .CpmAction -> .World
doCpmAction world cleanhome pwd (Project pn pa) = doProjectAction world cleanhome pwd pn pa
doCpmAction world cleanhome pwd (Module mn ma) = doModuleAction world cleanhome mn ma
doCpmAction world _ _ _ =
doCpmAction :: String String .CpmAction *World -> .World
doCpmAction cleanhome pwd (Project pn pa) world = doProjectAction cleanhome pwd pn pa world
doCpmAction cleanhome pwd (Module mn ma) world = doModuleAction cleanhome mn ma world
doCpmAction _ _ _ world =
help "cpm <target>"
[ "Where <target> is one of the following:"
, " project <projectname> : project actions"
......@@ -112,28 +115,30 @@ doCpmAction world _ _ _ =
, ""
, "Execute `cpm <target> help` to get help for specific actions."] world
doProjectAction :: *World .String .String .String .ProjectAction -> .World
doProjectAction world cleanhome pwd pn CreateProject
# basefilename = dropExtension pn
# mainmodule = addExtension basefilename "icl"
# projectfile = addExtension basefilename "prj"
compilerOptions :: CompilerOptions
compilerOptions = DefaultCompilerOptions
doProjectAction :: .String .String .String .ProjectAction *World -> .World
doProjectAction cleanhome pwd pn CreateProject world
//Check if main module exists
# (exists,world) = fileExists mainmodule world
| not exists = error ("Main module " +++ mainmodule +++ " does not exist.") world
//Create project file using the Clean IDE libraries
# edit_options = {eo={newlines=NewlineConventionUnix},pos_size=NoWindowPosAndSize}
# compiler_options = DefaultCompilerOptions;
# project = PR_NewProject mainmodule edit_options compiler_options DefCodeGenOptions
DefApplicationOptions [!!] DefaultLinkOptions
# project = PR_SetRoot mainmodule edit_options compiler_options project
# (prjok, world) = accFiles (SaveProjectFile projectfile project cleanhome) world
| not prjok = error ("Could not create project file " +++ projectfile) world
= world
where basefilename = dropExtension pn
mainmodule = addExtension basefilename "icl"
projectfile = addExtension basefilename "prj"
edit_options = {eo={newlines=NewlineConventionUnix},pos_size=NoWindowPosAndSize}
project = PR_SetRoot mainmodule edit_options compilerOptions prj
//Create project file using the Clean IDE libraries
where prj = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions
DefApplicationOptions [!!] DefaultLinkOptions
doProjectAction world cleanhome pwd pn ShowProject
doProjectAction cleanhome pwd pn ShowProject world
# projectfile = addExtension (dropExtension pn) "prj"
//Open the projectfile
# (mbProj ,world) = openProject cleanhome projectfile world
# (mbProj, world) = openProject cleanhome projectfile world
= case mbProj of
Error e -> error e world
Ok project -> showLines
......@@ -144,29 +149,27 @@ doProjectAction world cleanhome pwd pn ShowProject
: [toString p \\ p <- StrictListToList (PR_GetPaths project)]
] world
doProjectAction world cleanhome pwd pn (BuildProject force ideenvs)
# envsfile = cleanhome </> ideenvs
doProjectAction cleanhome pwd pn (BuildProject force ideenvs) world
# (envs, world) = openEnvironments cleanhome envsfile world
# proj_path = GetLongPathName pn
# ((proj, ok, err), world) = accFiles (ReadProjectFile proj_path pwd) world
| not ok || err <> "" = error ("CPM failed while opening project: "+++.err+++."\n") world
# (ok, logfile, world) = openLogfile proj_path world
| not ok = error ("CPM failed while opening logfile.\n") world
# default_compiler_options = DefaultCompilerOptions
# iniGeneral = initGeneral True default_compiler_options pwd proj_path proj envs logfile
# ps = {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
# {ls, gst_world} = pinit force ps
# iniGeneral = initGeneral True compilerOptions pwd proj_path proj envs logfile
# {ls, gst_world} = pinit force {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
= gst_world
where envsfile = cleanhome </> ideenvs
proj_path = GetLongPathName pn
doProjectAction world cleanhome _ pn (ProjectPath pa)
doProjectAction cleanhome _ pn (ProjectPath pa) world
# projectfile = addExtension (dropExtension pn) "prj"
//Open the projectfile
# (mbProj, world) = openProject cleanhome projectfile world
= case mbProj of
Error e = error e world
Ok project = doProjectPathAction world cleanhome projectfile project pa
Error e -> error e world
Ok project -> doProjectPathAction cleanhome projectfile project pa world
doProjectAction world _ _ _ _ =
doProjectAction _ _ _ _ world =
help "cpm project <projectname> <action>"
[ "Where <action> is one of the following"
, " create : create a new project"
......@@ -175,27 +178,27 @@ doProjectAction world _ _ _ _ =
, " Optionally specify the environments file (default: 'IDEEnvs')"
, " path : manage project paths"] world
doProjectPathAction :: *World .String .String Project .PathAction -> .World
doProjectPathAction world cleanhome pn project (AddPathAction path)
# paths = PR_GetPaths project
# prj = PR_SetPaths False paths (path :! paths) project // TODO: Double check to see if PR_SetPaths is used correctly
doProjectPathAction :: .String .String Project .PathAction *World -> .World
doProjectPathAction cleanhome pn project (AddPathAction path) world
# (ok, world) = saveProject cleanhome prj pn world
| not ok = abort "Failed to add path to project" // TODO: Improve
= showLines ["Path '" +++ path +++ "' successfully added to project"] world
where prj = PR_SetPaths False paths (path :! paths) project // TODO: Double check to see if PR_SetPaths is used correctly
paths = PR_GetPaths project
doProjectPathAction world cleanhome pn project (RemovePathAction n)
# paths = PR_GetPaths project
# paths` = rmStrictListIdx n paths
# prj = PR_SetPaths False paths paths` project // TODO: Double check to see if PR_SetPaths is used correctly
doProjectPathAction cleanhome pn project (RemovePathAction n) world
# (ok, world) = saveProject cleanhome prj pn world
| not ok = abort "Failed to remove path from project" // TODO: Improve
= showLines ["Path " +++ toString n +++ " successfully removed from project"] world
where paths = PR_GetPaths project
paths` = rmStrictListIdx n paths
prj = PR_SetPaths False paths paths` project // TODO: Double check to see if PR_SetPaths is used correctly
doProjectPathAction world _ _ project ListPathsAction = showLines ["Paths for project:" : paths] world
doProjectPathAction _ _ project ListPathsAction world = showLines ["Paths for project:" : paths] world
where paths = map f (zip2 [0..] (StrictListToList (PR_GetPaths project)))
f (n, p) = " [" +++ toString n +++ "] " +++ p
doProjectPathAction world _ _ _ _ =
doProjectPathAction _ _ _ _ world =
help "cpm project <projectname> path <action>"
[ "Where <action> is one of the following"
, " add <path> : add a path to the project"
......@@ -217,33 +220,33 @@ rmStrictListIdx 0 (_ :! t) = t
rmStrictListIdx n (h :! t) | n > 0 = h :! (rmStrictListIdx (n - 1) t)
rmStrictListIdx n _ = abort ("Index " +++ toString n +++ " out of bounds")
doModuleAction :: *World .String .String .ModuleAction -> .World
doModuleAction world cleanhome mn (CreateModule mt)
doModuleAction :: .String .String .ModuleAction *World -> .World
doModuleAction cleanhome mn (CreateModule mt) world
# (dclexists, world) = fileExists dclnm world
| dclexists = dexerr world
# (iclexists, world) = fileExists iclnm world
| iclexists = iexerr world
= writeMods world mt
= writeMods mt world
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
writeMods ApplicationModule world = writeicl ApplicationModule world
writeMods LibraryModule world
# world = writeicl ApplicationModule world
= writedcl world
writeicl world ApplicationModule = writeicl` world "implementation "
writeicl ApplicationModule world = writeicl` "implementation " world
writeicl world LibraryModule = writeicl` world ""
writeicl LibraryModule world = writeicl` "" world
writeicl` world pref = writemod world iclnm pref ("Failed to write implementation module '" +++ basenm +++ "'")
writeicl` pref world = writemod iclnm pref ("Failed to write implementation module '" +++ basenm +++ "'") world
writedcl world = writemod world dclnm "definition " ("Failed to write definition module '" +++ basenm +++ "'")
writedcl world = writemod dclnm "definition " ("Failed to write definition module '" +++ basenm +++ "'") world
writemod world nm pref errmsg
writemod nm pref errmsg world
# (me, world) = writeFile nm (mkmod pref) world
| isError me = error errmsg world
= world
......@@ -251,7 +254,7 @@ doModuleAction world cleanhome mn (CreateModule mt)
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>"
[ "Where <action> is one of the following"
, " create [application|library] : create a new module. Optionally specify module type (default: 'library')"] world
......
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