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
a0049718
Commit
a0049718
authored
Mar 01, 2013
by
Jurrien Stutterheim
Browse files
Revert changes to BatchBuild.icl in favour of a separate tool (to be committed)
parent
96b18ae0
Changes
1
Hide whitespace changes
Inline
Side-by-side
BatchBuild/BatchBuild.icl
View file @
a0049718
module
BatchBuild
import
StdEnv
import
ArgEnv
from
File
import
fileExists
import
FilePath
import
Func
import
GenEq
import
IdeState
import
ParserCombinators
from
Platform
import
application_path
import
PmDriver
import
PmEnvironment
,
logfile
,
set_return_code
import
PmProject
import
StdEnv
import
StdListExtensions
import
Tuple
import
IdeState
from
UtilIO
import
GetFullApplicationPath
,
GetLongPathName
import
PmEnvironment
,
logfile
,
set_return_code
from
Platform
import
application_path
// TODO: Remove MaybeError(String) and import from platform
::
MaybeError
a
b
=
Error
a
|
Ok
b
::
MaybeErrorString
a
:==
MaybeError
String
a
// END TODO
::
BBArgs
=
{
force_rebuild
::
Bool
,
filename
::
Maybe
String
,
args
::
[
BBArg
]
}
::
BBArg
=
BBBool
String
|
BBString
String
String
|
BBInt
String
Int
derive
gEq
BBArg
Start
::
*
World
->
*
World
Start
world
#
commandline
=
getCommandLine
cl
=
intersperse
" "
(
tl
[
arg
\\
arg
<-:
commandline
])
argsrec
=
startPBB
(
concat
[
fromString
c
\\
c
<-
cl
])
#
(
pwd
,
world
)
=
accFiles
GetFullApplicationPath
world
#
cleanhome
=
case
getStringArg
"cleanhome"
argsrec
.
args
of
(
Just
nm
)
->
nm
Nothing
->
case
getEnvironmentVariable
"CLEAN_HOME"
of
(
EnvironmentVariable
ch
)
->
ch
_
->
pwd
|
isNothing
argsrec
.
filename
=
showUsage
world
=
case
getStringArg
"action"
argsrec
.
args
of
(
Just
"create"
)
->
createProject
world
argsrec
.
filename
cleanhome
(
Just
"show"
)
->
showProject
world
argsrec
.
filename
cleanhome
//(Just "addpath") -> addPath world argsrec.filename cleanhome
//(Just "removepath") -> removePath world argsrec cleanhome
_
->
buildProject
world
argsrec
cleanhome
showUsage
::
!*
World
->
*
World
showUsage
world
=
show
[
"BatchBuild"
,
"Usage: BatchBuild [--force] filename [--action=ARG] [--envsfile=ARG] [--cleanhome=ARG]"
,
" --action : Execute a specific action. Possible actions:"
,
" build : Build a project (default)."
,
" create : Create a basic project file for a module."
,
" show : Summarize the contents of a project file."
,
" --envsfile : Specify an environments file (defaults to 'IDEEnvs')"
,
" --cleanhome : Specify the Clean directory (defaults to '.')."
,
" Alternatively, specify $CLEAN_HOME in your environment."
]
world
buildProject
::
*
World
BBArgs
String
->
*
World
buildProject
world
{
force_rebuild
=
force_rebuild
,
filename
=
filename
,
args
=
args
}
cleanhome
#
envsfile
=
case
getStringArg
"envsfile"
args
of
(
Just
p
)
->
application_path
p
_
->
application_path
EnvsFileName
#
(
envs
,
world
)
=
openEnvironments
cleanhome
envsfile
world
#
((
proj
,
ok
,
err
),
world
)
=
accFiles
(
ReadProjectFile
(
fromJust
filename
)
cleanhome
)
world
|
not
ok
||
err
<>
""
=
wAbort
(
"BatchBuild failed while opening project: "
+++.
err
+++.
"
\n
"
)
world
#
(
ok
,
logfile
,
world
)
=
openLogfile
(
fromJust
filename
)
world
|
not
ok
=
wAbort
(
"BatchBuild failed while opening logfile.
\n
"
)
world
#
default_compiler_options
=
DefaultCompilerOptions
#
iniGeneral
=
initGeneral
True
default_compiler_options
cleanhome
(
fromJust
filename
)
proj
envs
logfile
#
ps
=
{
ls
=
iniGeneral
,
gst_world
=
world
,
gst_continue_or_stop
=
False
}
#
{
ls
,
gst_world
}
=
pinit
(
force_rebuild
||
hasFlag
"force"
args
)
ps
=
finish
gst_world
createProject
::
*
World
(
Maybe
String
)
String
->
*
World
createProject
world
Nothing
_
=
wAbort
(
"No file specified"
)
world
createProject
world
(
Just
filename
)
cleanhome
//Figure out the file names
#
basefilename
=
dropExtension
filename
#
mainmodule
=
addExtension
basefilename
"icl"
#
projectfile
=
addExtension
basefilename
"prj"
//Check if main module exists
#
(
exists
,
world
)
=
fileExists
mainmodule
world
|
not
exists
=
wAbort
(
"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
=
wAbort
(
"Could not create project file "
+++
projectfile
)
world
=
world
showProject
::
*
World
(
Maybe
String
)
String
->
*
World
showProject
world
Nothing
_
=
wAbort
(
"No file specified"
)
world
showProject
world
(
Just
filename
)
cleanhome
#
projectfile
=
addExtension
(
dropExtension
filename
)
"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
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
)
show
::
![
String
]
!*
World
->
*
World
show
lines
world
#
(
console
,
world
)
=
stdio
world
#
console
=
seqSt
(\
s
c
->
fwrites
(
s
+++
"
\n
"
)
c
)
lines
console
#
(_,
world
)
=
fclose
console
world
=
world
error
::
!
String
!*
World
->
*
World
error
msg
world
=
show
[
"Error: "
+++
msg
]
world
//addPath :: *World (Maybe String) String -> *World
//addPath world Nothing _ = wAbort "No filename" world
//addPath world (Just filename) cleanhome
//# projectfile = addExtension (dropExtension filename) "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
//removePath :: *World BBArgs String -> *World
//removePath world {filename=filename, args=args} cleanhome = error "Not implemented" world
concat
::
[[.
a
]]
->
[.
a
]
concat
xss
=
foldr
(++)
[]
xss
#
commandline
=
getCommandLine
args
=
[
arg
\\
arg
<-:
commandline
]
(
path_ok
,
force_rebuild
,
proj_path
)
=
case
args
of
[_,
prj
]
->
(
True
,
False
,
GetLongPathName
prj
)
[_,
"--force"
,
prj
]
->
(
True
,
True
,
GetLongPathName
prj
)
_
->
(
False
,
False
,
""
)
#
(
startup
,
world
)
=
accFiles
GetFullApplicationPath
world
#
envspath
=
application_path
EnvsFileName
#
(
envs
,
world
)
=
openEnvironments
startup
envspath
world
// | not ok = wAbort ("Unable to read environments\n") world
|
not
path_ok
=
wAbort
(
"BatchBuild
\n
Use as: 'BatchBuild [--force] projectname.prj'
\n
"
)
world
#
((
proj
,
ok
,
err
),
world
)
=
accFiles
(
ReadProjectFile
proj_path
startup
)
world
|
not
ok
||
err
<>
""
=
wAbort
(
"BatchBuild failed while opening project: "
+++.
err
+++.
"
\n
"
)
world
#
(
ok
,
logfile
,
world
)
=
openLogfile
proj_path
world
|
not
ok
=
wAbort
(
"BatchBuild failed while opening logfile.
\n
"
)
world
#
default_compiler_options
=
DefaultCompilerOptions
#
iniGeneral
=
initGeneral
True
default_compiler_options
startup
proj_path
proj
envs
logfile
#
ps
=
{
ls
=
iniGeneral
,
gst_world
=
world
,
gst_continue_or_stop
=
False
}
#
{
ls
,
gst_world
}
=
pinit
force_rebuild
ps
=
finish
gst_world
startPBB
::
[.
Char
]
->
BBArgs
startPBB
args
=
case
filter
(\(
xs
,
_)
->
xs
==
[])
(
begin
pBB
args
)
of
[(_,
as
):_]
->
as
_
->
{
force_rebuild
=
False
,
filename
=
Nothing
,
args
=
[]
}
pBB
::
CParser
Char
BBArgs
BBArgs
pBB
=
pForce
<&>
\
f
->
pFilename
<&>
\
p
->
<*>
(
sp
pArgs
)
<@
\
fs
->
{
force_rebuild
=
f
,
filename
=
p
,
args
=
fs
}
pForce
::
CParser
Char
Bool
BBArgs
pForce
=
pBoolLongOpt
"force"
<@
const
True
<|>
yield
False
pFilename
::
CParser
Char
(
Maybe
String
)
BBArgs
pFilename
=
(
pNotSpace
<@
Just
o
toString
)
<!>
yield
Nothing
pArgs
::
CParser
Char
BBArg
BBArgs
pArgs
=
pStringLongOpt
"envsfile"
<|>
pBoolLongOpt
"force"
<|>
pStringLongOpt
"action"
<|>
pStringLongOpt
"cleanhome"
hasFlag
::
String
[
BBArg
]
->
Bool
hasFlag
_
[]
=
False
hasFlag
flag
[(
BBBool
x
):
xs
]
=
flag
===
x
||
hasFlag
flag
xs
hasFlag
flag
[_:
xs
]
=
hasFlag
flag
xs
getStringArg
::
String
[
BBArg
]
->
Maybe
String
getStringArg
_
[]
=
Nothing
getStringArg
arg
[
BBString
x
v
:
xs
]
|
arg
===
x
=
Just
v
getStringArg
arg
[_:
xs
]
=
getStringArg
arg
xs
getIntArg
::
String
[
BBArg
]
->
Maybe
Int
getIntArg
_
[]
=
Nothing
getIntArg
arg
[
BBInt
x
v
:
xs
]
|
arg
===
x
=
Just
v
getIntArg
arg
[_:
xs
]
=
getIntArg
arg
xs
pNotSpace
::
CParser
Char
[
Char
]
a
pNotSpace
=
sp
(<+>
(
satisfy
(
not
o
isWhite
)))
pBoolLongOpt
::
String
->
CParser
Char
BBArg
a
pBoolLongOpt
long
=
pLongOpt
long
<@
const
(
BBBool
long
)
pBoolShortOpt
::
String
->
CParser
Char
BBArg
a
pBoolShortOpt
short
=
pShortOpt
short
<@
const
(
BBBool
short
)
pIntLongOpt
::
String
->
CParser
Char
BBArg
a
pIntLongOpt
long
=
pLongOpt
long
&>
sp
int
<@
BBInt
long
pIntShortOpt
::
String
->
CParser
Char
BBArg
a
pIntShortOpt
short
=
pShortOpt
short
&>
sp
int
<@
BBInt
short
pStringLongOpt
::
String
->
CParser
Char
BBArg
a
pStringLongOpt
long
=
pLongOpt
long
&>
sp
pNotSpace
<@
BBString
long
o
toString
pStringShortOpt
::
String
->
CParser
Char
BBArg
a
pStringShortOpt
short
=
pShortOpt
short
&>
sp
pNotSpace
<@
BBString
short
o
toString
pLongOpt
::
String
->
CParser
Char
[
Char
]
a
pLongOpt
long
=
sptoken
(
fromString
"--"
)
&>
token
(
fromString
long
)
<&
(<?>
(
spsymbol
'='
))
pShortOpt
::
String
->
CParser
Char
[
Char
]
a
pShortOpt
short
=
spsymbol
'-'
&>
token
(
fromString
short
)
<&
(<?>
(
spsymbol
'='
))
pinit
::
.
Bool
*
GeneralSt
->
*
GeneralSt
pinit
force_rebuild
ps
=
BringProjectUptoDate
force_rebuild
cleanup
ps
=
BringProjectUptoDate
force_rebuild
cleanup
ps
where
cleanup
exepath
bool1
bool2
ps
=
abortLog
False
""
ps
cleanup
exepath
bool1
bool2
ps
=
abortLog
False
""
ps
wAbort
::
{#.
Char
}
*
World
->
.
World
wAbort
message
world
//
# (console,world) = stdio world
//
# console = console <<< message
//
# (_,world) = fclose console world
#
stderr
=
fwrites
message
stderr
#
(
ok
,
world
)
=
fclose
stderr
world
#
world
=
set_return_code_world
(
-1
)
world
=
finish
world
//
# (console,world) = stdio world
//
# console = console <<< message
//
# (_,world) = fclose console world
#
stderr
=
fwrites
message
stderr
#
(
ok
,
world
)
=
fclose
stderr
world
#
world
=
set_return_code_world
(
-1
)
world
=
finish
world
//finish :: !*World -> String
//finish _ = ""
finish
::
.
a
->
.
a
finish
w
=
w
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