Add experimental path support for CPM

cpm/Cpm.icl

@@ -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