Skip to content
GitLab
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
847b7a48
Commit
847b7a48
authored
Feb 06, 2018
by
John van Groningen
Browse files
use a simple parser without parser combinators to parse the command line arguments,
allow spaces in arguments
parent
c3944bfd
Changes
3
Hide whitespace changes
Inline
Side-by-side
cpm/Cpm.icl
View file @
847b7a48
...
...
@@ -43,6 +43,5 @@ Start world
(
Just
ch
,
world
)
->
(
ch
,
world
)
(_,
world
)
->
(
cleandir
,
world
)
=
case
mpwd
of
Ok
pwd
->
doCpmAction
ch
pwd
(
startParse
(
fromString
$
mkCl
cmd
))
world
Error
e
->
abort
"Failed to read current directory"
where
mkCl
cmd
=
concat
(
intersperse
" "
(
tl
[
fromString
arg
\\
arg
<-
cmd
]))
Ok
pwd
->
doCpmAction
cleandir
pwd
(
parseCpmLogic
cmd
)
world
Error
e
->
abort
"Failed to read current directory"
cpm/Parser.dcl
View file @
847b7a48
definition
module
Parser
/**
* CPM imports
*/
import
AbsSyn
/**
* Clean Platform imports
*/
import
Text
.
Parsers
.
ZParsers
.
ParsersKernel
,
Text
.
Parsers
.
ZParsers
.
ParsersDerived
/**
* Parse the a list of characters to get the action to be executed. If parsing
* fails, CpmHelp is returned as default action so help may be displayed.
*/
startParse
::
[.
Char
]
->
CpmAction
/**
* Parse one or more non-whitespace characters
*/
pNotSpace
::
Parser
Char
a
[
Char
]
/**
* Wrapper around the token parser that converts a Clean string to a list of
* charactersm for easier parsing
*/
spstrtok
::
(
String
->
Parser
Char
a
[
Char
])
/**
* Top-level parser for CPM commands
*/
pCpm
::
Parser
Char
a
CpmAction
/**
* Parser for the project commands
*/
pProject
::
Parser
Char
a
CpmAction
/**
* Parser for all path-related actions
*/
pPathAction
::
Parser
Char
a
ProjectAction
/**
* Parser for constant mappings between text and constructors
*/
pConstCtr
::
[(
String
,
c
)]
->
Parser
Char
a
c
/**
* Parser to toggle the --force flag
*/
pForce
::
Parser
Char
a
Bool
/**
* Parser for the argument to specify where the IDEEnvs file is
*/
pIDEEnvs
::
Parser
Char
a
String
/**
* Parser for module-related actions
*/
pModule
::
Parser
Char
a
CpmAction
/**
* Parser for the help command
*/
pHelp
::
c
->
Parser
Char
a
c
parseCpmLogic
::
![
String
]
->
CpmAction
cpm/Parser.icl
View file @
847b7a48
implementation
module
Parser
/**
* CPM imports
*/
import
AbsSyn
/**
* CleanIDE imports
*/
import
PmEnvironment
/**
* Clean Platform imports
*/
import
Control
.
Applicative
import
Data
.
List
,
Data
.
Maybe
,
Data
.
Functor
import
Text
.
Parsers
.
ZParsers
.
ParsersKernel
,
Text
.
Parsers
.
ZParsers
.
ParsersDerived
,
Text
.
Parsers
.
ZParsers
.
ParsersAccessories
/**
* Clean libraries imports
*/
import
StdFunc
,
StdTuple
/**
* Parse one or more non-whitespace characters
*/
pNotSpace
::
Parser
Char
a
[
Char
]
pNotSpace
=
ds
(<+>
(
satisfy
(
not
o
space
)))
/**
* Top-level parser for CPM commands
*/
pCpm
::
Parser
Char
a
CpmAction
pCpm
=
//mkP ((\_ f -> Project "foo" (BuildProject f "foo")) <$> mkG (spstrtok "build") <||> mkG pForce)
pMake
<|>
pProject
<|>
pModule
<|>
pQuickBuild
<|>
(
yield
CpmHelp
)
where
pQuickBuild
=
pNotSpace
<&>
\
pn
->
pBuildOpts
<@
Project
(
toString
pn
)
/**
* Parse the make command
*/
pMake
::
Parser
Char
a
CpmAction
pMake
=
spstrtok
"make"
<@
const
CpmMake
/**
* Wrapper around the token parser that converts a Clean string to a list of
* charactersm for easier parsing
*/
spstrtok
::
(
String
->
Parser
Char
a
[
Char
])
spstrtok
=
ds
o
tokenH
o
fromString
/**
* Parser for the project commands
*/
pProject
::
Parser
Char
a
CpmAction
pProject
=
spstrtok
"project"
&>
(
pProjectWithName
<!>
yield
(
Project
""
ProjectHelp
))
//where pProjectWithName = mkP (Project o toString <$> mkG pNotSpace <||> mkG pProjectAction) //<&> \pn -> pProjectAction <@ Project (toString pn)
where
pProjectWithName
=
pNotSpace
<&>
\
pn
->
pProjectAction
<@
Project
(
toString
pn
)
pProjectAction
=
(
spstrtok
"create"
<@
const
CreateProject
)
<|>
(
spstrtok
"show"
<@
const
ShowProject
)
//<|> mkP ((\_ -> BuildProject) <$> mkG (spstrtok "build") <||> mkG pForce <||> mkG pIDEEnvs) // (spstrtok "build" &> pForce <&> \f -> pIDEEnvs <@ BuildProject f)
<|>
(
spstrtok
"build"
&>
pBuildOpts
)
<|>
(
spstrtok
"path"
&>
pPathAction
)
<|>
(
spstrtok
"root"
&>
pNotSpace
<@
SetRelativeRoot
o
toString
)
<|>
(
spstrtok
"target"
&>
identifier
<@
SetTarget
o
toString
)
<|>
(
spstrtok
"exec"
&>
identifier
<@
SetExec
o
toString
)
<!>
(
pHelpYield
ProjectHelp
)
/**
* Parse options for the build command
*/
pBuildOpts
::
Parser
Char
a
ProjectAction
pBuildOpts
=
pForce
<&>
\
f
->
pIDEEnvs
<@
BuildProject
f
/**
* Parser for the environment commands
*/
pEnvironment
::
Parser
Char
a
CpmAction
pEnvironment
=
spstrtok
"environment"
&>
pEnvironmentAction
<@
Environment
where
pEnvironmentAction
=
(
spstrtok
"list"
<@
const
ListEnvironments
)
<|>
(
spstrtok
"import"
&>
pNotSpace
<@
ImportEnvironment
o
toString
)
<|>
(
spstrtok
"create"
&>
identifier
<@
CreateEnvironment
o
toString
)
<|>
(
spstrtok
"remove"
&>
identifier
<@
RemoveEnvironment
o
toString
)
<|>
(
spstrtok
"show"
&>
identifier
<@
ShowEnvironment
o
toString
)
<|>
(
spstrtok
"export"
&>
identifier
<@
ExportEnvironment
o
toString
)
<|>
(
spstrtok
"rename"
&>
identifier
<&>
\
en
->
identifier
<@
RenameEnvironment
(
toString
en
)
o
toString
)
<|>
(
spstrtok
"setcompiler"
&>
identifier
<&>
\
en
->
identifier
<@
SetEnvironmentCompiler
(
toString
en
)
o
toString
)
<|>
(
spstrtok
"setcodegen"
&>
identifier
<&>
\
en
->
identifier
<@
SetEnvironmentCodeGen
(
toString
en
)
o
toString
)
<!>
(
pHelpYield
EnvironmentHelp
)
/**
* Parser for all path-related actions
*/
pPathAction
::
Parser
Char
a
ProjectAction
pPathAction
=
pPathAction
<@
ProjectPath
where
pPathAction
=
(
spstrtok
"add"
&>
pNotSpace
<@
AddPathAction
o
toString
)
<|>
(
spstrtok
"remove"
&>
ds
number
<@
RemovePathAction
)
<|>
(
spstrtok
"list"
<@
const
ListPathsAction
)
<|>
(
spstrtok
"move"
&>
pPathDirection
)
<!>
(
pHelpYield
PathHelp
)
pPathDirection
=
ds
number
<&>
\
i
->
pConstCtr
dirOpts
<@
MovePathAction
i
dirOpts
=
[
(
"up"
,
MovePathUp
),
(
"down"
,
MovePathDown
)
,
(
"top"
,
MovePathTop
),
(
"bottom"
,
MovePathBottom
)]
/**
* Parser for constant mappings between text and constructors
*/
pConstCtr
::
[(
String
,
c
)]
->
Parser
Char
a
c
pConstCtr
xs
=
choice
(
map
(\(
s
,
d
)
->
(
spstrtok
s
<@
const
d
))
xs
)
/**
* Parser to toggle the --force flag
*/
pForce
::
Parser
Char
a
Bool
pForce
=
(
spstrtok
"--force"
<@
const
True
)
<!>
(
yield
False
)
/**
* Parser for the argument to specify where the IDEEnvs file is
*/
pIDEEnvs
::
Parser
Char
a
String
pIDEEnvs
=
spstrtok
"--envs"
&>
(<?>
(
ds
(
symbol
'='
))
id
'='
)
&>
pNotSpace
<@
toString
<!>
(
yield
EnvsFileName
)
/**
* Parser for module-related actions
*/
pModule
::
Parser
Char
a
CpmAction
pModule
=
spstrtok
"module"
&>
(
pModuleWithName
<!>
yield
(
Module
""
ModuleHelp
))
where
pModuleWithName
=
pNotSpace
<&>
\
mn
->
pModuleAction
<@
Module
(
toString
mn
)
pModuleAction
=
(
spstrtok
"create"
&>
pModuleType
<@
CreateModule
)
<!>
(
pHelpYield
ModuleHelp
)
pModuleType
=
(
spstrtok
"application"
<@
const
ApplicationModule
)
<!>
(
yield
LibraryModule
)
/**
* Parser for the help command
*/
pHelp
::
c
->
Parser
Char
a
c
pHelp
c
=
spstrtok
"help"
<@
const
c
pHelpYield
::
c
->
Parser
Char
a
c
pHelpYield
c
=
(
spstrtok
"help"
<@
const
c
)
<|>
(
yield
c
)
/**
* Parse the a list of characters to get the action to be executed. If parsing
* fails, CpmHelp is returned as default action so help may be displayed.
*/
startParse
::
[.
Char
]
->
CpmAction
startParse
input
=
case
parse
pCpm
input
"line"
"character"
of
Succ
[
x
:_]
->
x
_
->
CpmHelp
//startParse args = maybe CpmHelp snd (find (isnull o fst) (begin pCpm args))
implementation
module
Parser
;
import
StdEnv
;
import
AbsSyn
;
from
PmEnvironment
import
EnvsFileName
;
parseCpmLogic
::
![
String
]
->
CpmAction
;
parseCpmLogic
[_:
args
]
=
parse_CpmLogic
args
;
parseCpmLogic
_
=
CpmHelp
;
parse_CpmLogic
::
![
String
]
->
CpmAction
;
parse_CpmLogic
[
"make"
]
=
CpmMake
;
parse_CpmLogic
[
"project"
,
project_name
:
project_args
]
=
parse_Project
project_args
project_name
;
parse_CpmLogic
[
"module"
,
module_name
:
module_args
]
=
parse_Module
module_args
module_name
;
parse_CpmLogic
[
"environment"
:
environment_args
]
=
parse_Environment
environment_args
;
parse_CpmLogic
[
project_name
:
project_build_args
]
=
parse_Project_build_args
project_build_args
False
EnvsFileName
project_name
CpmHelp
;
parse_CpmLogic
_
=
CpmHelp
;
parse_Project
::
![
String
]
!
String
->
CpmAction
;
parse_Project
[
"create"
]
project_name
=
Project
project_name
CreateProject
;
parse_Project
[
"show"
]
project_name
=
Project
project_name
ShowProject
;
parse_Project
[
"build"
:
project_build_args
]
project_name
=
parse_Project_build_args
project_build_args
False
EnvsFileName
project_name
(
Project
""
ProjectHelp
);
parse_Project
[
"path"
:
project_path_args
]
project_name
=
parse_Project_path_args
project_path_args
project_name
;
parse_Project
[
"root"
,
s
]
project_name
=
Project
project_name
(
SetRelativeRoot
s
);
parse_Project
[
"target"
,
s
]
project_name
=
Project
project_name
(
SetTarget
s
);
parse_Project
[
"exec"
,
s
]
project_name
=
Project
project_name
(
SetExec
s
);
parse_Project
_
project_name
=
Project
""
ProjectHelp
;
parse_Project_build_args
::
![
String
]
!
Bool
!
String
!
String
!
CpmAction
->
CpmAction
;
parse_Project_build_args
[
"--force"
:
project_build_args
]
force
environment
project_name
error_cpm_action
=
parse_Project_build_args
project_build_args
True
environment
project_name
error_cpm_action
;
parse_Project_build_args
[
project_build_arg
:
project_build_args
]
force
environment
project_name
error_cpm_action
|
size
project_build_arg
>
6
&&
project_build_arg
%
(
0
,
5
)==
"--env="
#
environment
=
project_build_arg
%
(
6
,
size
project_build_arg
-1
);
=
parse_Project_build_args
project_build_args
force
environment
project_name
error_cpm_action
;
parse_Project_build_args
[]
force
environment
project_name
error_cpm_action
=
Project
project_name
(
BuildProject
force
environment
);
parse_Project_build_args
_
_
_
_
error_cpm_action
=
error_cpm_action
;
parse_Project_path_args
::
![
String
]
!
String
->
CpmAction
;
parse_Project_path_args
[
"add"
,
path
]
project_name
=
Project
project_name
(
ProjectPath
(
AddPathAction
path
));
parse_Project_path_args
[
"remove"
,
i
]
project_name
|
size
i
>
0
&&
only_digits_in_string
0
i
=
Project
project_name
(
ProjectPath
(
RemovePathAction
(
toInt
i
)));
parse_Project_path_args
[
"list"
]
project_name
=
Project
project_name
(
ProjectPath
ListPathsAction
);
parse_Project_path_args
[
"move"
,
i
,
direction_name
]
project_name
#
(
is_direction
,
direction
)
=
parse_PathDirection
direction_name
;
|
size
i
>
0
&&
only_digits_in_string
0
i
&&
is_direction
=
Project
project_name
(
ProjectPath
(
MovePathAction
(
toInt
i
)
direction
));
parse_Project_path_args
_
_
=
Project
""
(
ProjectPath
PathHelp
);
parse_PathDirection
::
!
String
->
(!
Bool
,
PathDirection
);
parse_PathDirection
"up"
=
(
True
,
MovePathUp
);
parse_PathDirection
"down"
=
(
True
,
MovePathDown
);
parse_PathDirection
"top"
=
(
True
,
MovePathTop
);
parse_PathDirection
"bottom"
=
(
True
,
MovePathBottom
);
parse_PathDirection
_
=
(
False
,
abort
"parse_PathDirection"
);
only_digits_in_string
::
!
Int
!
String
->
Bool
;
only_digits_in_string
i
s
|
i
<
size
s
=
isDigit
s
.[
i
]
&&
only_digits_in_string
(
i
+1
)
s
;
=
True
;
parse_Module
::
![
String
]
!
String
->
CpmAction
;
parse_Module
[
"create"
]
module_name
=
Module
module_name
(
CreateModule
LibraryModule
);
parse_Module
[
"create"
,
"application"
]
module_name
=
Module
module_name
(
CreateModule
ApplicationModule
);
parse_Module
_
module_name
=
Module
""
ModuleHelp
;
parse_Environment
::
![
String
]
->
CpmAction
;
parse_Environment
[
"list"
]
=
Environment
ListEnvironments
;
parse_Environment
[
"import"
,
s
]
=
Environment
(
ImportEnvironment
s
);
parse_Environment
[
"create"
,
s
]
=
Environment
(
CreateEnvironment
s
);
parse_Environment
[
"remove"
,
s
]
=
Environment
(
RemoveEnvironment
s
);
parse_Environment
[
"show"
,
s
]
=
Environment
(
ShowEnvironment
s
);
parse_Environment
[
"export"
,
s
]
=
Environment
(
ExportEnvironment
s
);
parse_Environment
[
"rename"
,
s1
,
s2
]
=
Environment
(
RenameEnvironment
s1
s2
);
parse_Environment
[
"setcompiler"
,
s1
,
s2
]
=
Environment
(
SetEnvironmentCompiler
s1
s2
);
parse_Environment
[
"setcodegen"
,
s1
,
s2
]
=
Environment
(
SetEnvironmentCodeGen
s1
s2
);
parse_Environment
_
=
Environment
EnvironmentHelp
;
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new 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