Skip to content

GitLab

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

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

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