Skip to content
GitLab
Menu
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
f2c409b5
Commit
f2c409b5
authored
Mar 06, 2013
by
Jurrien Stutterheim
Browse files
Add experimental path support for CPM
parent
973fce28
Changes
1
Hide whitespace changes
Inline
Side-by-side
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
=
show
Lines
lines`
world
where
lines`
=
[
"CPM: Clean Project Management"
:
""
:
"Usage: "
+++
cmd
:
lines
]
show
::
![
String
]
!*
World
->
*
World
show
lines
world
show
Lines
::
![
String
]
!*
World
->
*
World
show
Lines
lines
world
#
(
console
,
world
)
=
stdio
world
#
console
=
seqSt
(\
s
c
->
fwrites
(
s
+++
"
\n
"
)
c
)
lines
console
#
(_,
world
)
=
fclose
console
world
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a 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