Skip to content

GitLab

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

Add experimental path support for CPM

parent 973fce28
Hide whitespace changes
Inline Side-by-side
Showing with 62 additions and 28 deletions
cpm/Cpm.icl
View file @ f2c409b5
......@@ -34,7 +34,9 @@ import UtilStrictLists
:: PathAction
= AddPathAction String
| RemovePathAction String
| RemovePathAction Int
| ListPathsAction
| PathHelp
:: ModuleAction
= CreateModule ModuleType
......@@ -55,12 +57,13 @@ spstrtok = sptoken o fromString
pProject :: CParser Char CpmAction a
pProject = spstrtok "project" &> pNotSpace <&> \pn -> (pProjectAction <!> yield ProjectHelp) <@ Project (toString pn)
where pProjectAction = spstrtok "create" <@ const CreateProject
<|> spstrtok "show" <@ const ShowProject
<|> spstrtok "build" &> pForce <&> \ f-> pIDEEnvs <@ BuildProject f
<|> spstrtok "path" &> pPathAction <@ ProjectPath
where pProjectAction = spstrtok "create" <@ const CreateProject
<|> spstrtok "show" <@ const ShowProject
<|> spstrtok "build" &> pForce <&> \ f-> pIDEEnvs <@ BuildProject f
<|> spstrtok "path" &> (pPathAction <!> yield PathHelp) <@ ProjectPath
pPathAction = spstrtok "add" &> pNotSpace <@ AddPathAction o toString
<|> spstrtok "remove" &> pNotSpace <@ RemovePathAction o toString
<|> spstrtok "remove" &> nat <@ RemovePathAction
<|> spstrtok "list" <@ const ListPathsAction
pForce :: CParser Char Bool a
pForce = spstrtok "--force" <@ const True <|> yield False
......@@ -124,12 +127,13 @@ doProjectAction world cleanhome pwd pn ShowProject
# (mbProj ,world) = openProject cleanhome projectfile world
= case mbProj of
Error e -> error e world
Ok project -> show [ "Content of " +++ projectfile
, "Target: " +++ PR_GetTarget project
, "Executable: " +++ PR_GetExecPath project
, "Paths:"
: [toString p \\ p <- StrictListToList (PR_GetPaths project)]
] world
Ok project -> showLines
[ "Content of " +++ projectfile
, "Target: " +++ PR_GetTarget project
, "Executable: " +++ PR_GetExecPath project
, "Paths:"
: [toString p \\ p <- StrictListToList (PR_GetPaths project)]
] world
doProjectAction world cleanhome pwd pn (BuildProject force ideenvs)
# envsfile = cleanhome </> ideenvs
......@@ -145,7 +149,14 @@ doProjectAction world cleanhome pwd pn (BuildProject force ideenvs)
# {ls, gst_world} = pinit force ps
= gst_world
doProjectAction world cleanhome _ pn (ProjectPath pa) = doProjectPathAction world cleanhome pn pa
doProjectAction world cleanhome _ pn (ProjectPath pa)
# 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
doProjectAction world _ _ _ _ =
help "cpm project <projectname> <action>"
[ "Where <action> is one of the following"
......@@ -153,20 +164,34 @@ doProjectAction world _ _ _ _ =
, " show : show project information"
, " build [--force] [--envs=filename] : build the project. Optionally force build (default: 'false')"
, " Optionally specify the environments file (default: 'IDEEnvs')"
, " path <add|remove> : add or remove a path from the project"] world
, " 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
# (ok, world) = saveProject cleanhome prj pn world
| not ok = abort "Failed to add path to project" // TODO: Improve
= world
doProjectPathAction :: *World .String .String .PathAction -> .World
doProjectPathAction world cleanhome pn (AddPathAction path)
# projectfile = addExtension (dropExtension pn) "prj"
//Open the projectfile
# (mbProj, world) = openProject cleanhome projectfile world
= case mbProj of
Error e = error e world
Ok project
# paths = StrictListToList (PR_GetPaths project)
= show ["Paths" +++ toString (length paths)] world
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
# (ok, world) = saveProject cleanhome prj pn world
| not ok = abort "Failed to remove path from project" // TODO: Improve
= world
doProjectPathAction world _ _ project ListPathsAction = showLines ["Paths for project:" : paths] world
where paths = map f (zip2 [0..] (StrictListToList (PR_GetPaths project)))
f (n, p) = " [" +++ toString n +++ "] " +++ p
doProjectPathAction world cleanhome pn (RemovePathAction path) = undef
doProjectPathAction world _ _ _ _ =
help "cpm project <projectname> path <action>"
[ "Where <action> is one of the following"
, " add <path> : add a path to the project"
, " list : list all project paths"
, " remove <n> : remove path <n> from the list of projects"] world
openProject :: !FilePath !FilePath !*World -> (!MaybeErrorString Project,!*World)
openProject cleanhome projectfile world
......@@ -174,6 +199,15 @@ openProject cleanhome projectfile world
| ok = (Ok prj, world)
= (Error err, world)
saveProject :: !FilePath !Project !FilePath !*World -> (Bool, !*World)
saveProject cleanhome prj projectfile world = accFiles (SaveProjectFile projectfile prj cleanhome) world
rmStrictListIdx :: !Int !(List String) -> List String
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)
# (dclexists, world) = fileExists dclnm world
......@@ -221,14 +255,14 @@ error message world
= world
help :: !String ![String] !*World -> *World
help cmd lines world = show lines` world
help cmd lines world = showLines lines` world
where lines` = [ "CPM: Clean Project Management"
: ""
: "Usage: " +++ cmd
: lines]
show :: ![String] !*World -> *World
show lines world
showLines :: ![String] !*World -> *World
showLines lines world
# (console,world) = stdio world
# console = seqSt (\s c -> fwrites (s +++ "\n") c) lines console
# (_,world) = fclose console 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