Skip to content

GitLab

Commit c1e52876 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim
Browse files

Fix CPM parsers

parent f2c409b5
Hide whitespace changes
Inline Side-by-side
Showing with 25 additions and 16 deletions
cpm/Cpm.icl
View file @ c1e52876
......@@ -23,7 +23,7 @@ import UtilStrictLists
:: CpmAction
= Project FilePath ProjectAction
| Module String ModuleAction
| Help
| CpmHelp
:: 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 CpmHelp)
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
_ -> CpmHelp
doCpmAction :: *World String String .CpmAction -> .World
doCpmAction world cleanhome pwd (Project pn pa) = doProjectAction world cleanhome pwd pn pa
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment