Commit 99ff9626 authored by John van Groningen's avatar John van Groningen

convert relative file paths to full file paths using function GetLongPathName,

(written by Mart Lubbers)
parent 891b7c4d
definition module CpmLogic definition module CpmLogic
/** // CPM imports
* CPM imports
*/
import AbsSyn import AbsSyn
/** // CleanIDE imports
* CleanIDE imports
*/
from PmProject import :: Project from PmProject import :: Project
/** // Execute a general CPM action
* Execute a general CPM action
*/
doCpmAction :: String String !CpmAction !*World -> *World doCpmAction :: String String !CpmAction !*World -> *World
/** // Find all project files in the current working directory and build them
* Find all project files in the current working directory and build them
*/
doMake :: String !String !*World -> *World doMake :: String !String !*World -> *World
/** // Execute project-specific actions
* Execute project-specific actions
*/
doProjectAction :: String String String ProjectAction *World -> *World doProjectAction :: String String String ProjectAction *World -> *World
/** // Execute path-related project actions
* Execute path-related project actions doProjectPathAction :: String String String Project PathAction *World -> *World
*/
doProjectPathAction :: String String Project PathAction *World -> *World
/** // Execute module-related actions
* Execute module-related actions
*/
doModuleAction :: String !String !ModuleAction !*World -> *World doModuleAction :: String !String !ModuleAction !*World -> *World
/** // Modify a project
* Turn a project name into a project filename withProject :: !String !String !String (Project -> Project) *World -> *World
*/
mkProjectFile :: !String -> String
/** // Collect all project paths in a list with an index prefixed
* Modify a project
*/
withProject :: !String !String (Project -> Project) *World -> *World
/**
* Collect all project paths in a list with an index prefixed
*/
showPaths :: !Project -> [String] showPaths :: !Project -> [String]
/** /*
* Modify the list of paths in a project given a modification function which Modify the list of paths in a project given a modification function which
* takes a strict list of project paths and returns a strict list of project takes a strict list of project paths and returns a strict list of project
* paths. paths.
*/ */
doModPaths :: !String !String !Project ([!String!] -> [!String!]) *World -> *World doModPaths :: !String !String !String !Project ([!String!] -> [!String!]) *World -> *World
/** // Open a project file
* Open a project file openProject :: !FilePath !FilePath !FilePath !*World -> (!FilePath, !Project, Bool, !*World)
*/
openProject :: !FilePath !FilePath !*World -> (!Project, !*World) // Save a project back to its project file
saveProject :: !FilePath !FilePath !Project !FilePath !*World -> *World
/**
* Save a project back to its project file /*
*/ Remove an item from a strict list at a given index. Abort execution if the
saveProject :: !FilePath !Project !FilePath !*World -> *World index is out of bounds.
*/
/**
* Remove an item from a strict list at a given index. Abort execution if the
* index is out of bounds.
*/
rmStrictListIdx :: !Int [!a!] -> [!a!] rmStrictListIdx :: !Int [!a!] -> [!a!]
/** /*
* Move a path at a given index up or down the list of paths. Abort execution Move a path at a given index up or down the list of paths. Abort execution
* if the index is out of bounds. if the index is out of bounds.
*/ */
moveStrictListIdx :: !Int PathDirection [!a!] -> [!a!] moveStrictListIdx :: !Int PathDirection [!a!] -> [!a!]
/** // Show an error message
* Show an error message
*/
error :: !String !*World -> *World error :: !String !*World -> *World
/** // Show a help message
* Show a help message
*/
help :: !String ![String] !*World -> *World help :: !String ![String] !*World -> *World
/** /*
* Given a list of strings, concatenate them to a single string with newlines Given a list of strings, concatenate them to a single string with newlines
* in between, then print that new string to console. in between, then print that new string to console.
*/ */
showLines :: ![String] !*World -> *World showLines :: ![String] !*World -> *World
...@@ -95,15 +95,14 @@ doProjectAction cleanhome pwd pn CreateProject world ...@@ -95,15 +95,14 @@ doProjectAction cleanhome pwd pn CreateProject world
# prj = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions # prj = PR_NewProject mainmodule edit_options compilerOptions DefCodeGenOptions
DefApplicationOptions [!!] DefaultLinkOptions DefApplicationOptions [!!] DefaultLinkOptions
# project = PR_SetRoot mainmodule edit_options compilerOptions prj # project = PR_SetRoot mainmodule edit_options compilerOptions prj
# projectfile = mkProjectFile basefilename //addExtension basefilename "prj" # projectfile = addExtension basefilename "prj"
# (prjok, world) = accFiles (SaveProjectFile projectfile project cleanhome) world = saveProject cleanhome pwd project projectfile world
| not prjok = error ("Could not create project file " +++ projectfile) world
= world
doProjectAction cleanhome pwd pn ShowProject world doProjectAction cleanhome pwd pn ShowProject world
# projectfile = mkProjectFile pn # (proj_path, project, ok, world) = openProject pwd pn cleanhome world
# (project, world) = openProject cleanhome projectfile world | not ok
= showLines [ "Content of " +++ projectfile +++ ":" = world
= showLines [ "Content of " +++ proj_path +++ ":"
, "ProjectRoot..: " +++ PR_GetRelativeRootDir project , "ProjectRoot..: " +++ PR_GetRelativeRootDir project
, "Target.......: " +++ PR_GetTarget project , "Target.......: " +++ PR_GetTarget project
, "Executable...: " +++ PR_GetExecPath project , "Executable...: " +++ PR_GetExecPath project
...@@ -113,9 +112,9 @@ doProjectAction cleanhome pwd pn ShowProject world ...@@ -113,9 +112,9 @@ doProjectAction cleanhome pwd pn ShowProject world
doProjectAction cleanhome pwd pn (BuildProject force ideenvs) world doProjectAction cleanhome pwd pn (BuildProject force ideenvs) world
# (envs, world) = readIDEEnvs cleanhome ideenvs world # (envs, world) = readIDEEnvs cleanhome ideenvs world
# proj_path = GetLongPathName (pwd </> pn) # (proj_path, proj, ok, world) = openProject pwd pn cleanhome world
# ((proj, ok, err), world) = accFiles (ReadProjectFile proj_path cleanhome) world | not ok
| not ok || err <> "" = error ("CPM failed while opening project: " +++ err +++ "\n") world = world
# (console, world) = stdio world # (console, world) = stdio world
# iniGeneral = initGeneral True compilerOptions cleanhome proj_path proj envs console # iniGeneral = initGeneral True compilerOptions cleanhome proj_path proj envs console
# {ls, gst_world} = pinit force {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False} # {ls, gst_world} = pinit force {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
...@@ -124,22 +123,23 @@ doProjectAction cleanhome pwd pn (BuildProject force ideenvs) world ...@@ -124,22 +123,23 @@ doProjectAction cleanhome pwd pn (BuildProject force ideenvs) world
pinit force_rebuild gst = BringProjectUptoDate force_rebuild cleanup gst pinit force_rebuild gst = BringProjectUptoDate force_rebuild cleanup gst
cleanup exepath bool1 bool2 ps = abortLog False "" ps cleanup exepath bool1 bool2 ps = abortLog False "" ps
doProjectAction cleanhome _ pn (ProjectPath pa) world doProjectAction cleanhome pwd pn (ProjectPath pa) world
# projectfile = mkProjectFile pn # (proj_path, project, ok, world) = openProject pwd pn cleanhome world
# (project, world) = openProject cleanhome projectfile world | not ok
= doProjectPathAction cleanhome projectfile project pa world = world
= doProjectPathAction cleanhome pwd pn project pa world
doProjectAction cleanhome pwd pn (SetRelativeRoot target) world = doProjectAction cleanhome pwd pn (SetRelativeRoot target) world
withProject cleanhome pn (PR_SetRelativeRootDir target) world = withProject pwd pn cleanhome (PR_SetRelativeRootDir target) world
doProjectAction cleanhome pwd pn (SetTarget target) world = doProjectAction cleanhome pwd pn (SetTarget target) world
withProject cleanhome pn (PR_SetTarget target) world = withProject pwd pn cleanhome (PR_SetTarget target) world
doProjectAction cleanhome pwd pn (SetExec exec) world = doProjectAction cleanhome pwd pn (SetExec exec) world
withProject cleanhome pn (PR_SetExecPath exec) world = withProject pwd pn cleanhome (PR_SetExecPath exec) world
doProjectAction cleanhome pwd pn (SetProjectOptions project_options) world doProjectAction cleanhome pwd pn (SetProjectOptions project_options) world
= withProject cleanhome pn (set_project_options project_options) world = withProject pwd pn cleanhome (set_project_options project_options) world
where where
set_project_options [project_option:project_options] project set_project_options [project_option:project_options] project
# project = set_project_option project_option project # project = set_project_option project_option project
...@@ -211,38 +211,34 @@ doEnvironmentAction _ _ _ world = ...@@ -211,38 +211,34 @@ doEnvironmentAction _ _ _ world =
, " setcodegen <envname> <codegenname> : set codegen for <envname> to <codegenname>" , " setcodegen <envname> <codegenname> : set codegen for <envname> to <codegenname>"
] world ] world
/**
* Turn a project name into a project filename
*/
mkProjectFile :: !String -> String
mkProjectFile pn = addExtension (dropExtension pn) "prj"
/** /**
* Modify a project * Modify a project
*/ */
withProject :: !String !String (Project -> Project) *World -> *World withProject :: !String !String !String (Project -> Project) *World -> *World
withProject cleanhome pn f world withProject pwd pn cleanhome f world
# projectfile = mkProjectFile pn # (project_path, project, ok, world) = openProject pwd pn cleanhome world
# (project, world) = openProject cleanhome projectfile world | not ok
= saveProject cleanhome (f project) projectfile world = world
= saveProject cleanhome pwd (f project) project_path world
/** /**
* Execute path-related project actions * Execute path-related project actions
*/ */
doProjectPathAction :: String String Project PathAction *World -> *World doProjectPathAction :: String String String Project PathAction *World -> *World
doProjectPathAction cleanhome pn project (AddPathAction path) world = doProjectPathAction cleanhome pwd pn project (AddPathAction path) world
doModPaths cleanhome pn project ((:!) path) world = doModPaths cleanhome pwd pn project ((:!) (GetLongPathName path)) world
doProjectPathAction cleanhome pn project (RemovePathAction i) world = doProjectPathAction cleanhome pwd pn project (RemovePathAction i) world
doModPaths cleanhome pn project (rmStrictListIdx i) world = doModPaths cleanhome pwd pn project (rmStrictListIdx i) world
doProjectPathAction _ _ project ListPathsAction world = showLines ["Paths for project:" : showPaths project] world doProjectPathAction _ _ _ project ListPathsAction world
= showLines ["Paths for project:" : showPaths project] world
doProjectPathAction cleanhome pn project (MovePathAction i pdir) world = doProjectPathAction cleanhome pwd pn project (MovePathAction i pdir) world
doModPaths cleanhome pn project (moveStrictListIdx i pdir) world = doModPaths cleanhome pwd pn project (moveStrictListIdx i pdir) world
doProjectPathAction _ _ _ _ world = doProjectPathAction _ _ _ _ _ world
help "cpm project <projectname.prj> path <action>" = help "cpm project <projectname.prj> path <action>"
[ "Where <action> is one of the following" [ "Where <action> is one of the following"
, " add <path> : add a path to the project" , " add <path> : add a path to the project"
, " list : list all project paths and their index" , " list : list all project paths and their index"
...@@ -261,30 +257,34 @@ showPaths project = map f (zip2 [0..] (StrictListToList (PR_GetPaths project))) ...@@ -261,30 +257,34 @@ showPaths project = map f (zip2 [0..] (StrictListToList (PR_GetPaths project)))
* takes a strict list of project paths and returns a strict list of project * takes a strict list of project paths and returns a strict list of project
* paths. * paths.
*/ */
doModPaths :: !String !String !Project ([!String!] -> [!String!]) *World -> *World doModPaths :: !String !String !String !Project ([!String!] -> [!String!]) *World -> *World
doModPaths cleanhome pn project f world doModPaths cleanhome pwd pn project f world
# paths = PR_GetPaths project # paths = PR_GetPaths project
# prj = PR_SetPaths False paths (f paths) project # prj = PR_SetPaths False paths (f paths) project
# world = saveProject cleanhome prj pn world # world = saveProject cleanhome pwd prj pn world
= showLines ["Successfully modified project paths"] world = showLines ["Successfully modified project paths"] world
/** /**
* Open a project file * Open a project file
*/ */
openProject :: !FilePath !FilePath !*World -> (!Project, !*World) openProject :: !FilePath !FilePath !FilePath !*World -> (!FilePath, !Project, Bool, !*World)
openProject cleanhome projectfile world openProject pwd pn cleanhome world
# ((prj, ok, err), world) = accFiles (ReadProjectFile projectfile cleanhome) world # proj_path = GetLongPathName (pwd </> pn)
| ok = (prj, world) # ((prj, ok, err), world) = accFiles (ReadProjectFile proj_path cleanhome) world
| otherwise = (prj, error err world) | not ok || err <> ""
= (proj_path, prj, ok, error err world)
= (proj_path, prj, ok, world)
/** /**
* Save a project back to its project file * Save a project back to its project file
*/ */
saveProject :: !FilePath !Project !FilePath !*World -> *World saveProject :: !FilePath !FilePath !Project !FilePath !*World -> *World
saveProject cleanhome prj projectfile world saveProject cleanhome pwd prj projectfile world
# (ok, world) = accFiles (SaveProjectFile projectfile prj cleanhome) world # proj_path = GetLongPathName projectfile
| not ok = error "Error saving project" world # (ok, world) = accFiles (SaveProjectFile proj_path prj cleanhome) world
| otherwise = world | not ok
= error "Error saving project" world
= world
/** /**
* Remove an item from a strict list at a given index. Abort execution if the * Remove an item from a strict list at a given index. Abort execution if the
......
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