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
c1e52876
Commit
c1e52876
authored
Mar 06, 2013
by
Jurrien Stutterheim
Browse files
Fix CPM parsers
parent
f2c409b5
Changes
1
Hide whitespace changes
Inline
Side-by-side
cpm/Cpm.icl
View file @
c1e52876
...
...
@@ -23,7 +23,7 @@ import UtilStrictLists
::
CpmAction
=
Project
FilePath
ProjectAction
|
Module
String
ModuleAction
|
Help
|
Cpm
Help
::
ProjectAction
=
CreateProject
...
...
@@ -50,31 +50,40 @@ pNotSpace :: CParser Char [Char] a
pNotSpace
=
sp
(<+>
(
satisfy
(
not
o
isWhite
)))
pCpm
::
CParser
Char
CpmAction
a
pCpm
=
pProject
<|>
pModule
<!>
yield
Help
pCpm
=
pProject
<|>
pModule
<!>
(
yield
Cpm
Help
)
spstrtok
::
(
String
->
CParser
Char
[
Char
]
a
)
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
<!>
yield
PathHelp
)
<@
ProjectPath
pPathAction
=
spstrtok
"add"
&>
pNotSpace
<@
AddPathAction
o
toString
<|>
spstrtok
"remove"
&>
nat
<@
RemovePathAction
<|>
spstrtok
"list"
<@
const
ListPathsAction
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
)
<!>
(
pHelp
ProjectHelp
)
pPathAction
::
CParser
Char
ProjectAction
a
pPathAction
=
pPathAction
<@
ProjectPath
where
pPathAction
=
(
spstrtok
"add"
&>
pNotSpace
<@
AddPathAction
o
toString
)
<|>
(
spstrtok
"remove"
&>
nat
<@
RemovePathAction
)
<|>
(
spstrtok
"list"
<@
const
ListPathsAction
)
<!>
(
pHelp
PathHelp
)
pForce
::
CParser
Char
Bool
a
pForce
=
spstrtok
"--force"
<@
const
True
<|>
yield
False
pForce
=
(
spstrtok
"--force"
<@
const
True
)
<|>
(
yield
False
)
pIDEEnvs
::
CParser
Char
String
a
pIDEEnvs
=
spstrtok
"--envs"
&>
(<?>
(
spsymbol
'='
))
&>
pNotSpace
<@
toString
<!>
yield
EnvsFileName
pIDEEnvs
=
(
spstrtok
"--envs"
&>
(<?>
(
spsymbol
'='
))
&>
pNotSpace
<@
toString
)
<!>
(
yield
EnvsFileName
)
pModule
::
CParser
Char
CpmAction
a
pModule
=
spstrtok
"module"
&>
pNotSpace
<&>
\
mn
->
(
pModuleAction
<!>
yield
ModuleHelp
)
<@
Module
(
toString
mn
)
where
pModuleAction
=
spstrtok
"create"
&>
pModuleType
<@
CreateModule
pModuleType
=
spstrtok
"application"
<@
const
ApplicationModule
<|>
yield
LibraryModule
pModule
=
spstrtok
"module"
&>
pNotSpace
<&>
\
mn
->
pModuleAction
<@
Module
(
toString
mn
)
where
pModuleAction
=
(
spstrtok
"create"
&>
pModuleType
<@
CreateModule
)
<!>
(
yield
ModuleHelp
)
pModuleType
=
(
spstrtok
"application"
<@
const
ApplicationModule
)
<|>
(
yield
LibraryModule
)
pHelp
::
c
->
CParser
Char
c
a
pHelp
c
=
(
spstrtok
"help"
<@
const
c
)
<|>
(
yield
c
)
Start
::
*
World
->
*
World
Start
world
...
...
@@ -90,7 +99,7 @@ Start world
startParse
::
[.
Char
]
->
CpmAction
startParse
args
=
case
filter
(\(
xs
,
_)
->
xs
==
[])
(
begin
pCpm
args
)
of
[(_,
as
):_]
->
as
_
->
Help
_
->
Cpm
Help
doCpmAction
::
*
World
String
String
.
CpmAction
->
.
World
doCpmAction
world
cleanhome
pwd
(
Project
pn
pa
)
=
doProjectAction
world
cleanhome
pwd
pn
pa
...
...
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