Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
C
clean-ide
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
6
Issues
6
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
clean-and-itasks
clean-ide
Commits
34910221
Commit
34910221
authored
Mar 13, 2013
by
Jurrien Stutterheim
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
CPM: Add target and exec project options. Add top/bottom path manipulation. Refactor.
parent
b0d93db6
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
92 additions
and
41 deletions
+92
-41
cpm/Cpm.icl
cpm/Cpm.icl
+92
-41
No files found.
cpm/Cpm.icl
View file @
34910221
...
...
@@ -70,6 +70,7 @@ import UtilStrictLists
::
CpmAction
=
Project
FilePath
ProjectAction
|
Module
String
ModuleAction
|
Environment
EnvironmentAction
|
CpmHelp
::
ProjectAction
...
...
@@ -77,6 +78,9 @@ import UtilStrictLists
|
ShowProject
|
BuildProject
Bool
FilePath
|
ProjectPath
PathAction
//| SetProjectRoot String TODO: Not yet supported by PmProject
|
SetTarget
String
|
SetExec
String
|
ProjectHelp
::
PathAction
...
...
@@ -89,6 +93,8 @@ import UtilStrictLists
::
PathDirection
=
PathUp
|
PathDown
|
PathTop
|
PathBottom
::
ModuleAction
=
CreateModule
ModuleType
...
...
@@ -98,6 +104,9 @@ import UtilStrictLists
=
ApplicationModule
|
LibraryModule
::
EnvironmentAction
=
ShowEnvironment
/**
* Parsers
*/
...
...
@@ -121,16 +130,25 @@ pCpm = pProject <|> pModule <!> (yield CpmHelp)
spstrtok
::
(
String
->
CParser
Char
[
Char
]
a
)
spstrtok
=
sptoken
o
fromString
/**
* Parser for boolean values
*/
// TODO: REmove?
//pBool :: CParser Char Bool a
//pBool = pConstCtr [("true", True), ("True", True), ("false", False), ("False", False)]
/**
* Parser for the project commands
*/
pProject
::
CParser
Char
CpmAction
a
pProject
=
spstrtok
"project"
&>
(
pProjectWithName
<!>
yield
(
Project
""
ProjectHelp
))
where
pProjectWithName
=
pNotSpace
<&>
\
pn
->
pProjectAction
<@
Project
(
toString
pn
)
pProjectAction
=
(
spstrtok
"create"
<@
const
CreateProject
)
<|>
(
spstrtok
"show"
<@
const
ShowProject
)
<|>
(
spstrtok
"build"
&>
pForce
<&>
\
f
->
pIDEEnvs
<@
BuildProject
f
)
<|>
(
spstrtok
"path"
&>
pPathAction
)
pProjectAction
=
(
spstrtok
"create"
<@
const
CreateProject
)
<|>
(
spstrtok
"show"
<@
const
ShowProject
)
<|>
(
spstrtok
"build"
&>
pForce
<&>
\
f
->
pIDEEnvs
<@
BuildProject
f
)
<|>
(
spstrtok
"path"
&>
pPathAction
)
//<|> (spstrtok "projectroot" &> pNotSpace <@ SetProjectRoot o toString)
<|>
(
spstrtok
"target"
&>
identifier
<@
SetTarget
o
toString
)
<|>
(
spstrtok
"exec"
&>
identifier
<@
SetExec
o
toString
)
<!>
(
pHelp
ProjectHelp
)
/**
...
...
@@ -138,12 +156,19 @@ pProject = spstrtok "project" &> (pProjectWithName <!> yield (Project "" Project
*/
pPathAction
::
CParser
Char
ProjectAction
a
pPathAction
=
pPathAction
<@
ProjectPath
where
pPathAction
=
(
spstrtok
"add"
&>
pNotSpace
<@
AddPathAction
o
toString
)
<|>
(
spstrtok
"remove"
&>
sp
nat
<@
RemovePathAction
)
<|>
(
spstrtok
"list"
<@
const
ListPathsAction
)
where
pPathAction
=
(
spstrtok
"add"
&>
pNotSpace
<@
AddPathAction
o
toString
)
<|>
(
spstrtok
"remove"
&>
sp
nat
<@
RemovePathAction
)
<|>
(
spstrtok
"list"
<@
const
ListPathsAction
)
<|>
(
spstrtok
"move"
&>
pPathDirection
)
<!>
(
pHelp
PathHelp
)
pPathDirection
=
sp
nat
<&>
\
i
->
((
spstrtok
"up"
<@
const
PathUp
)
<|>
(
spstrtok
"down"
<@
const
PathDown
))
<@
MovePathAction
i
pPathDirection
=
sp
nat
<&>
\
i
->
pConstCtr
dirOpts
<@
MovePathAction
i
dirOpts
=
[(
"up"
,
PathUp
),
(
"down"
,
PathDown
),
(
"top"
,
PathTop
),
(
"bottom"
,
PathBottom
)]
/**
* Parser for constant mappings between text and constructors
*/
pConstCtr
::
[(
String
,
c
)]
->
CParser
Char
c
a
pConstCtr
xs
=
choice
(
map
(\(
s
,
d
)
->
(
spstrtok
s
<@
const
d
))
xs
)
/**
* Parser to toggle the --force flag
...
...
@@ -241,16 +266,15 @@ doProjectAction cleanhome pwd pn CreateProject world
doProjectAction
cleanhome
pwd
pn
ShowProject
world
#
projectfile
=
addExtension
(
dropExtension
pn
)
"prj"
//Open the projectfile
#
(
mbProj
,
world
)
=
openProject
cleanhome
projectfile
world
=
case
mbProj
of
Error
e
->
error
e
world
Ok
project
->
showLines
[
"Content of "
+++
projectfile
,
"Target: "
+++
PR_GetTarget
project
,
"Executable: "
+++
PR_GetExecPath
project
,
"Paths:"
:
[
toString
p
\\
p
<-
StrictListToList
(
PR_GetPaths
project
)]
]
world
#
(
project
,
world
)
=
openProject
cleanhome
projectfile
world
=
showLines
[
"Content of "
+++
projectfile
+++
":"
,
"ProjectRoot..: "
+++
PR_GetRelativeRootDir
project
,
"Built........: "
+++
toString
(
PR_Built
project
)
,
"Target.......: "
+++
PR_GetTarget
project
,
"Executable...: "
+++
PR_GetExecPath
project
,
"Paths........:"
:
showPaths
project
]
world
doProjectAction
cleanhome
pwd
pn
(
BuildProject
force
ideenvs
)
world
#
(
envs
,
world
)
=
openEnvironments
cleanhome
envsfile
world
...
...
@@ -265,12 +289,16 @@ doProjectAction cleanhome pwd pn (BuildProject force ideenvs) world
proj_path
=
GetLongPathName
pn
doProjectAction
cleanhome
_
pn
(
ProjectPath
pa
)
world
#
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
cleanhome
projectfile
project
pa
world
#
projectfile
=
addExtension
(
dropExtension
pn
)
"prj"
//Open the projectfile
#
(
project
,
world
)
=
openProject
cleanhome
projectfile
world
=
doProjectPathAction
cleanhome
projectfile
project
pa
world
doProjectAction
cleanhome
pwd
pn
(
SetTarget
target
)
world
=
withProject
cleanhome
pn
(
PR_SetTarget
target
)
world
doProjectAction
cleanhome
pwd
pn
(
SetExec
exec
)
world
=
withProject
cleanhome
pn
(
PR_SetExecPath
exec
)
world
doProjectAction
_
_
_
_
world
=
help
"cpm project <projectname> <action>"
...
...
@@ -279,7 +307,19 @@ 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 : manage project paths"
]
world
,
" path : manage project paths"
,
" target <env> : set target environment to <env>"
,
" exec <execname> : set executable name to <execname>"
]
world
/**
* Modify a project
*/
withProject
::
String
String
.(
Project
->
Project
)
*
World
->
.
World
withProject
cleanhome
pn
f
world
#
projectfile
=
addExtension
(
dropExtension
pn
)
"prj"
#
(
project
,
world
)
=
openProject
cleanhome
projectfile
world
=
saveProject
cleanhome
(
f
project
)
projectfile
world
/**
* Execute path-related project actions
...
...
@@ -291,9 +331,7 @@ doProjectPathAction cleanhome pn project (AddPathAction path) world =
doProjectPathAction
cleanhome
pn
project
(
RemovePathAction
i
)
world
=
doModPaths
cleanhome
pn
project
(
rmStrictListIdx
i
)
world
doProjectPathAction
_
_
project
ListPathsAction
world
=
showLines
[
"Paths for project:"
:
paths
]
world
where
paths
=
map
f
(
zip2
[
0
..]
(
StrictListToList
(
PR_GetPaths
project
)))
f
(
n
,
p
)
=
" ["
+++
toString
n
+++
"] "
+++
p
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
...
...
@@ -306,6 +344,13 @@ doProjectPathAction _ _ _ _ world =
,
" remove <i> : remove path <i> from the list of projects"
,
" move <i> <up|down> : move path <i> up or down one position"
]
world
/**
* Collect all project paths in a list with an index prefixed
*/
showPaths
::
Project
->
.[
String
]
showPaths
project
=
map
f
(
zip2
[
0
..]
(
StrictListToList
(
PR_GetPaths
project
)))
where
f
(
n
,
p
)
=
" ["
+++
toString
n
+++
"] "
+++
p
/**
* 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
...
...
@@ -313,8 +358,7 @@ doProjectPathAction _ _ _ _ world =
*/
doModPaths
::
String
String
Project
.([!
String
!]
->
[!
String
!])
*
World
->
.
World
doModPaths
cleanhome
pn
project
f
world
#
(
ok
,
world
)
=
saveProject
cleanhome
prj
pn
world
|
not
ok
=
abort
"Failed to modify project paths"
#
world
=
saveProject
cleanhome
prj
pn
world
=
showLines
[
"Successfully modified project paths"
]
world
where
paths
=
PR_GetPaths
project
prj
=
PR_SetPaths
False
paths
(
f
paths
)
project
...
...
@@ -322,17 +366,20 @@ doModPaths cleanhome pn project f world
/**
* Open a project file
*/
openProject
::
!
FilePath
!
FilePath
!*
World
->
(!
MaybeErrorString
Project
,
!*
World
)
openProject
::
!
FilePath
!
FilePath
!*
World
->
(!
Project
,
!*
World
)
openProject
cleanhome
projectfile
world
#
((
prj
,
ok
,
err
),
world
)
=
accFiles
(
ReadProjectFile
projectfile
cleanhome
)
world
|
ok
=
(
Ok
prj
,
world
)
=
(
Error
err
,
world
)
|
ok
=
(
prj
,
world
)
=
abort
err
/**
* Save a project back to its project file
*/
saveProject
::
!
FilePath
!
Project
!
FilePath
!*
World
->
(
Bool
,
!*
World
)
saveProject
cleanhome
prj
projectfile
world
=
accFiles
(
SaveProjectFile
projectfile
prj
cleanhome
)
world
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
=
world
/**
* Remove an item from a strict list at a given index. Abort execution if the
...
...
@@ -351,12 +398,16 @@ moveStrictListIdx :: .Int .PathDirection .[!a!] -> .[!a!]
moveStrictListIdx
i
dir
xs
|
i
<
0
||
i
>
(
LLength
xs
-
1
)
=
abort
(
"Index "
+++
toString
i
+++
" out of bounds"
)
|
otherwise
=
ListToStrictList
(
msl
dir
(
splitAt
i
(
StrictListToList
xs
)))
where
msl
PathUp
([],
xs
)
=
xs
msl
PathUp
(
xs
,
[
x
:
ys
])
=
((
init
xs
)
++
[
x
:
(
last
xs
)
:
ys
])
msl
PathDown
([],
[
x
:
y
:
ys
])
=
[
y
:
x
:
ys
]
msl
PathDown
(
xs
,
[])
=
xs
msl
PathDown
(
xs
,
[
y
])
=
xs
++
[
y
]
msl
PathDown
(
xs
,
[
x
:
y
:
ys
])
=
(
xs
++
[
y
:
x
:
ys
])
where
msl
PathUp
([],
xs
)
=
xs
msl
PathUp
(
xs
,
[
x
:
ys
])
=
(
init
xs
)
++
[
x
:
(
last
xs
)
:
ys
]
msl
PathDown
([],
[
x
:
y
:
ys
])
=
[
y
:
x
:
ys
]
msl
PathDown
(
xs
,
[])
=
xs
msl
PathDown
(
xs
,
[
y
])
=
xs
++
[
y
]
msl
PathDown
(
xs
,
[
x
:
y
:
ys
])
=
xs
++
[
y
:
x
:
ys
]
msl
PathTop
(
xs
,
[])
=
xs
msl
PathTop
(
xs
,
[
y
:
ys
])
=
[
y
:
xs
]
++
ys
msl
PathBottom
(
xs
,
[])
=
xs
msl
PathBottom
(
xs
,
[
y
:
ys
])
=
xs
++
ys
++
[
y
]
/**
* Execute module-related actions
...
...
Write
Preview
Markdown
is supported
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