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

Fix CPM parsers

parent f2c409b5
...@@ -23,7 +23,7 @@ import UtilStrictLists ...@@ -23,7 +23,7 @@ import UtilStrictLists
:: CpmAction :: CpmAction
= Project FilePath ProjectAction = Project FilePath ProjectAction
| Module String ModuleAction | Module String ModuleAction
| Help | CpmHelp
:: ProjectAction :: ProjectAction
= CreateProject = CreateProject
...@@ -50,31 +50,40 @@ pNotSpace :: CParser Char [Char] a ...@@ -50,31 +50,40 @@ pNotSpace :: CParser Char [Char] a
pNotSpace = sp (<+> (satisfy (not o isWhite))) pNotSpace = sp (<+> (satisfy (not o isWhite)))
pCpm :: CParser Char CpmAction a pCpm :: CParser Char CpmAction a
pCpm = pProject <|> pModule <!> yield Help pCpm = pProject <|> pModule <!> (yield CpmHelp)
spstrtok :: (String -> CParser Char [Char] a) spstrtok :: (String -> CParser Char [Char] a)
spstrtok = sptoken o fromString spstrtok = sptoken o fromString
pProject :: CParser Char CpmAction a pProject :: CParser Char CpmAction a
pProject = spstrtok "project" &> pNotSpace <&> \pn -> (pProjectAction <!> yield ProjectHelp) <@ Project (toString pn) pProject = spstrtok "project" &> pNotSpace <&> \pn -> pProjectAction <@ Project (toString pn)
where pProjectAction = spstrtok "create" <@ const CreateProject where pProjectAction = (spstrtok "create" <@ const CreateProject)
<|> spstrtok "show" <@ const ShowProject <|> (spstrtok "show" <@ const ShowProject)
<|> spstrtok "build" &> pForce <&> \ f-> pIDEEnvs <@ BuildProject f <|> (spstrtok "build" &> pForce <&> \ f-> pIDEEnvs <@ BuildProject f)
<|> spstrtok "path" &> (pPathAction <!> yield PathHelp) <@ ProjectPath <|> (spstrtok "path" &> pPathAction)
pPathAction = spstrtok "add" &> pNotSpace <@ AddPathAction o toString <!> (pHelp ProjectHelp)
<|> spstrtok "remove" &> nat <@ RemovePathAction
<|> spstrtok "list" <@ const ListPathsAction 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 :: CParser Char Bool a
pForce = spstrtok "--force" <@ const True <|> yield False pForce = (spstrtok "--force" <@ const True) <|> (yield False)
pIDEEnvs :: CParser Char String a 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 :: CParser Char CpmAction a
pModule = spstrtok "module" &> pNotSpace <&> \mn -> (pModuleAction <!> yield ModuleHelp) <@ Module (toString mn) pModule = spstrtok "module" &> pNotSpace <&> \mn -> pModuleAction <@ Module (toString mn)
where pModuleAction = spstrtok "create" &> pModuleType <@ CreateModule where pModuleAction = (spstrtok "create" &> pModuleType <@ CreateModule)
pModuleType = spstrtok "application" <@ const ApplicationModule <|> yield LibraryModule <!> (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 -> *World
Start world Start world
...@@ -90,7 +99,7 @@ Start world ...@@ -90,7 +99,7 @@ Start world
startParse :: [.Char] -> CpmAction startParse :: [.Char] -> CpmAction
startParse args = case filter (\(xs, _) -> xs == []) (begin pCpm args) of startParse args = case filter (\(xs, _) -> xs == []) (begin pCpm args) of
[(_, as):_] -> as [(_, as):_] -> as
_ -> Help _ -> CpmHelp
doCpmAction :: *World String String .CpmAction -> .World doCpmAction :: *World String String .CpmAction -> .World
doCpmAction world cleanhome pwd (Project pn pa) = doProjectAction world cleanhome pwd pn pa doCpmAction world cleanhome pwd (Project pn pa) = doProjectAction world cleanhome pwd pn pa
......
Supports Markdown
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