Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
clean-and-itasks
clean-ide
Commits
99ff9626
Commit
99ff9626
authored
Mar 16, 2018
by
John van Groningen
Browse files
convert relative file paths to full file paths using function GetLongPathName,
(written by Mart Lubbers)
parent
891b7c4d
Changes
2
Hide whitespace changes
Inline
Side-by-side
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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment