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
41163dd6
Commit
41163dd6
authored
Mar 01, 2013
by
Jurrien Stutterheim
Browse files
Add cpm: Clean Project Management
parent
a0049718
Changes
1
Hide whitespace changes
Inline
Side-by-side
cpm/Cpm.icl
0 → 100644
View file @
41163dd6
module
Cpm
import
CommandLine
import
Environment
import
Error
import
File
import
FilePath
import
Func
import
IdeState
import
List
import
logfile
import
ParserCombinators
import
Platform
import
PmDriver
import
PmEnvironment
import
PmProject
import
set_return_code
import
StdEnv
import
Text
import
UtilIO
import
UtilStrictLists
::
CloptAction
=
Project
FilePath
ProjectAction
|
Module
String
ModuleAction
|
Help
::
ProjectAction
=
CreateProject
|
ShowProject
|
BuildProject
Bool
FilePath
|
ProjectPath
PathAction
|
ProjectHelp
::
PathAction
=
AddPathAction
String
|
RemovePathAction
String
::
ModuleAction
=
CreateModule
|
ModuleHelp
pNotSpace
::
CParser
Char
[
Char
]
a
pNotSpace
=
sp
(<+>
(
satisfy
(
not
o
isWhite
)))
pClopt
::
CParser
Char
CloptAction
a
pClopt
=
pProject
<|>
pModule
<!>
yield
Help
spstrtok
::
(
String
->
CParser
Char
[
Char
]
a
)
spstrtok
=
sptoken
o
fromString
pProject
::
CParser
Char
CloptAction
a
pProject
=
spstrtok
"project"
&>
pNotSpace
<&>
\
pn
->
pProjectAction
<@
Project
(
toString
pn
)
where
pProjectAction
=
spstrtok
"create"
<@
const
CreateProject
<|>
spstrtok
"show"
<@
const
ShowProject
<|>
spstrtok
"build"
&>
pForce
<&>
\
f
->
pIDEEnvs
<@
BuildProject
f
<|>
spstrtok
"path"
&>
pPathAction
<@
ProjectPath
<!>
yield
ProjectHelp
pPathAction
=
spstrtok
"add"
&>
pNotSpace
<@
AddPathAction
o
toString
<|>
spstrtok
"remove"
&>
pNotSpace
<@
RemovePathAction
o
toString
pForce
::
CParser
Char
Bool
a
pForce
=
spstrtok
"--force"
<@
const
True
<|>
yield
False
pIDEEnvs
::
CParser
Char
String
a
pIDEEnvs
=
spstrtok
"--envs"
&>
(<?>
(
spsymbol
'='
))
&>
pNotSpace
<@
toString
<!>
yield
EnvsFileName
pModule
::
CParser
Char
CloptAction
a
pModule
=
spstrtok
"module"
&>
pNotSpace
<&>
\
mn
->
pModuleAction
<@
Module
(
toString
mn
)
where
pModuleAction
=
spstrtok
"create"
<@
const
CreateModule
<!>
yield
ModuleHelp
Start
::
*
World
->
*
World
Start
world
#
(
cmd
,
world
)
=
getCommandLine
world
cl
=
concat
(
intersperse
" "
(
tl
[
fromString
arg
\\
arg
<-
cmd
]))
cpm
=
startParse
(
fromString
cl
)
(
pwd
,
world
)
=
accFiles
GetFullApplicationPath
world
(
ch
,
world
)
=
case
getEnvironmentVariable
"CLEAN_HOME"
world
of
(
Just
ch
,
world
)
->
(
ch
,
world
)
(_,
world
)
->
(
pwd
,
world
)
=
doCloptAction
world
ch
pwd
cpm
startParse
::
[.
Char
]
->
CloptAction
startParse
args
=
case
filter
(\(
xs
,
_)
->
xs
==
[])
(
begin
pClopt
args
)
of
[(_,
as
):_]
->
as
_
->
Help
doCloptAction
::
*
World
String
String
.
CloptAction
->
.
World
doCloptAction
world
cleanhome
pwd
(
Project
pn
pa
)
=
doProjectAction
world
cleanhome
pwd
pn
pa
doCloptAction
world
cleanhome
pwd
(
Module
mn
ma
)
=
doModuleAction
world
cleanhome
mn
ma
doCloptAction
world
_
_
_
=
help
[
"CPM: Clean Project Management"
,
""
,
"Usage: cpm <action>"
,
"Where <action> is one of the following:"
,
" project : project actions"
,
" module : module action"
,
""
,
"Execute `cpm <action> help` to get help for specific actions."
]
world
doProjectAction
::
*
World
.
String
.
String
.
String
.
ProjectAction
->
.
World
doProjectAction
world
cleanhome
pwd
pn
CreateProject
#
basefilename
=
dropExtension
pn
#
mainmodule
=
addExtension
basefilename
"icl"
#
projectfile
=
addExtension
basefilename
"prj"
//Check if main module exists
#
(
exists
,
world
)
=
fileExists
mainmodule
world
|
not
exists
=
error
(
"Main module "
+++
mainmodule
+++
" does not exist."
)
world
//Create project file using the Clean IDE libraries
#
edit_options
=
{
eo
={
newlines
=
NewlineConventionUnix
},
pos_size
=
NoWindowPosAndSize
}
#
compiler_options
=
DefaultCompilerOptions
;
#
project
=
PR_NewProject
mainmodule
edit_options
compiler_options
DefCodeGenOptions
DefApplicationOptions
[!!]
DefaultLinkOptions
#
project
=
PR_SetRoot
mainmodule
edit_options
compiler_options
project
#
(
err
,
world
)
=
accFiles
(
SaveProjectFile
projectfile
project
cleanhome
)
world
|
err
=
error
(
"Could not create project file "
+++
projectfile
)
world
=
world
doProjectAction
world
cleanhome
pwd
pn
ShowProject
#
projectfile
=
addExtension
(
dropExtension
pn
)
"prj"
//Open the projectfile
#
(
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
doProjectAction
world
cleanhome
pwd
pn
(
BuildProject
force
ideenvs
)
#
envsfile
=
application_path
ideenvs
#
(
envs
,
world
)
=
openEnvironments
cleanhome
envsfile
world
#
((
proj
,
ok
,
err
),
world
)
=
accFiles
(
ReadProjectFile
pn
cleanhome
)
world
|
not
ok
||
err
<>
""
=
error
(
"BatchBuild failed while opening project: "
+++.
err
+++.
"
\n
"
)
world
#
(
ok
,
logfile
,
world
)
=
openLogfile
pn
world
|
not
ok
=
error
(
"BatchBuild failed while opening logfile.
\n
"
)
world
#
default_compiler_options
=
DefaultCompilerOptions
#
iniGeneral
=
initGeneral
True
default_compiler_options
cleanhome
pn
proj
envs
logfile
#
ps
=
{
ls
=
iniGeneral
,
gst_world
=
world
,
gst_continue_or_stop
=
False
}
#
{
ls
,
gst_world
}
=
pinit
force
ps
=
gst_world
doProjectAction
world
cleanhome
_
pn
(
ProjectPath
pa
)
=
doProjectPathAction
world
cleanhome
pn
pa
doProjectAction
world
_
_
_
_
=
help
[
"create : create a new project"
,
"show : show project information"
,
"build [--force] : build the project. Optionally force build (default: 'false')"
,
"path <add|remove> : add or remove a path from the project"
,
"help : show this help message"
]
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
)
=
help
[
"Paths"
+++
toString
(
length
paths
)]
world
doProjectPathAction
world
cleanhome
pn
(
RemovePathAction
path
)
=
undef
openProject
::
!
FilePath
!
FilePath
!*
World
->
(!
MaybeErrorString
Project
,!*
World
)
openProject
cleanhome
projectfile
world
#
((
prj
,
ok
,
err
),
world
)
=
accFiles
(
ReadProjectFile
projectfile
cleanhome
)
world
|
ok
=
(
Ok
prj
,
world
)
=
(
Error
err
,
world
)
doModuleAction
::
*
World
.
String
.
String
.
ModuleAction
->
.
World
doModuleAction
world
cleanhome
mn
CreateModule
#
basenm
=
dropExtension
mn
#
dclnm
=
addExtension
basenm
"dcl"
#
iclnm
=
addExtension
basenm
"icl"
#
(
dclexists
,
world
)
=
fileExists
dclnm
world
|
dclexists
=
error
(
"Definition module '"
+++
dclnm
+++
"' already exists."
)
world
#
(
iclexists
,
world
)
=
fileExists
iclnm
world
|
dclexists
=
error
(
"Implementation module '"
+++
iclnm
+++
"' already exists."
)
world
=
undef
doModuleAction
world
_
_
_
=
help
[
"create [application|library] : create a new module. Optionally specify module type (default: 'library')"
,
"help : show this help message"
]
world
error
::
{#.
Char
}
*
World
->
.
World
error
message
world
#
stderr
=
fwrites
message
stderr
#
(
ok
,
world
)
=
fclose
stderr
world
#
world
=
set_return_code_world
(
-1
)
world
=
world
help
::
![
String
]
!*
World
->
*
World
help
lines
world
#
(
console
,
world
)
=
stdio
world
#
console
=
seqSt
(\
s
c
->
fwrites
(
s
+++
"
\n
"
)
c
)
lines
console
#
(_,
world
)
=
fclose
console
world
=
world
show
::
![
String
]
!*
World
->
*
World
show
ls
w
=
help
ls
w
// TODO: Use the version from BatchBuild
pinit
::
.
Bool
*
GeneralSt
->
*
GeneralSt
pinit
force_rebuild
ps
=
BringProjectUptoDate
force_rebuild
cleanup
ps
where
cleanup
exepath
bool1
bool2
ps
=
abortLog
False
""
ps
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