Skip to content

GitLab

Commit 291ce7c6 authored by Jurrien Stutterheim's avatar Jurrien Stutterheim
Browse files

Update CPM to work with latest platform

parent 165ab7c0
Hide whitespace changes
Inline Side-by-side
Showing with 46 additions and 36 deletions
cpm/CpmLogic.icl
View file @ 291ce7c6
......@@ -186,7 +186,7 @@ doProjectPathAction cleanhome pn project (MovePathAction i pdir) world =
doModPaths cleanhome pn project (moveStrictListIdx i pdir) world
doProjectPathAction _ _ _ _ world =
help "cpm project <projectname> path <action>"
help "cpm project <projectname.prj> path <action>"
[ "Where <action> is one of the following"
, " add <path> : add a path to the project"
, " list : list all project paths and their index"
......@@ -295,7 +295,10 @@ doModuleAction _ mn (CreateModule mt) world
doModuleAction _ _ _ world =
help "cpm module <modulename> <action>"
[ "Where <action> is one of the following"
, " create [application|library] : create a new module. Optionally specify module type (default: 'library')"] world
, " create [application|library] : create a new module. Optionally specify module type (default: 'library')"
//, " check <projectname.prj> : type-check module in the context of project <projectname.prj>"
//, " compile <projectname.prj> : compile module in the context of project <projectname.prj>"
] world
/**
* Show an error message
......
cpm/Parser.dcl
View file @ 291ce7c6
......@@ -8,7 +8,7 @@ import AbsSyn
/**
* Clean Platform imports
*/
from Text.ParserCombinators import :: Parser, :: CParser, :: ParsResult, :: AltCont, :: XorCont, :: SucCont
import Text.Parsers.ParsersKernel, Text.Parsers.ParsersDerived
/**
......@@ -20,50 +20,50 @@ startParse :: [.Char] -> CpmAction
/**
* Parse one or more non-whitespace characters
*/
pNotSpace :: CParser Char [Char] a
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 -> CParser Char [Char] a)
spstrtok :: (String -> Parser Char a [Char])
/**
* Top-level parser for CPM commands
*/
pCpm :: CParser Char CpmAction a
pCpm :: Parser Char a CpmAction
/**
* Parser for the project commands
*/
pProject :: CParser Char CpmAction a
pProject :: Parser Char a CpmAction
/**
* Parser for all path-related actions
*/
pPathAction :: CParser Char ProjectAction a
pPathAction :: Parser Char a ProjectAction
/**
* Parser for constant mappings between text and constructors
*/
pConstCtr :: [(String, c)] -> CParser Char c a
pConstCtr :: [(String, c)] -> Parser Char a c
/**
* Parser to toggle the --force flag
*/
pForce :: CParser Char Bool a
pForce :: Parser Char a Bool
/**
* Parser for the argument to specify where the IDEEnvs file is
*/
pIDEEnvs :: CParser Char String a
pIDEEnvs :: Parser Char a String
/**
* Parser for module-related actions
*/
pModule :: CParser Char CpmAction a
pModule :: Parser Char a CpmAction
/**
* Parser for the help command
*/
pHelp :: c -> CParser Char c a
pHelp :: c -> Parser Char a c
cpm/Parser.icl
View file @ 291ce7c6
......@@ -13,48 +13,51 @@ import PmEnvironment
/**
* Clean Platform imports
*/
import Data.List, Data.Maybe
import Text.ParserCombinators
import Control.Applicative
import Data.List, Data.Maybe, Data.Functor
import Text.Parsers.ParsersKernel, Text.Parsers.ParsersDerived, Text.Parsers.ParsersAccessories
/**
* Clean libraries imports
*/
import StdFunc, StdTuple
/**
* Parse one or more non-whitespace characters
*/
pNotSpace :: CParser Char [Char] a
pNotSpace = sp (<+> (satisfy (not o isWhite)))
pNotSpace :: Parser Char a [Char]
pNotSpace = ds (<+> (satisfy (not o space)))
/**
* Top-level parser for CPM commands
*/
pCpm :: CParser Char CpmAction a
pCpm = pMake <|> pProject <|> pModule <!> (yield CpmHelp)
pCpm :: Parser Char a CpmAction
pCpm = //mkP ((\_ f -> Project "foo" (BuildProject f "foo")) <$> mkG (spstrtok "build") <||> mkG pForce)
pMake <|> pProject <|> pModule <!> (yield CpmHelp)
/**
* Parse the make command
*/
pMake :: CParser Char CpmAction a
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 -> CParser Char [Char] a)
spstrtok = sptoken o fromString
spstrtok :: (String -> Parser Char a [Char])
spstrtok = ds o tokenH o fromString
/**
* Parser for the project commands
*/
pProject :: CParser Char CpmAction a
pProject :: Parser Char a CpmAction
pProject = spstrtok "project" &> (pProjectWithName <!> yield (Project "" ProjectHelp))
where pProjectWithName = pNotSpace <&> \pn -> pProjectAction <@ Project (toString pn)
where pProjectWithName = mkP (Project o toString <$> mkG pNotSpace <||> mkG pProjectAction) //<&> \pn -> pProjectAction <@ Project (toString pn)
pProjectAction = (spstrtok "create" <@ const CreateProject)
<|> (spstrtok "show" <@ const ShowProject)
<|> (spstrtok "build" &> pForce <&> \f -> pIDEEnvs <@ BuildProject f)
<|> mkP ((\_ -> BuildProject) <$> mkG (spstrtok "build") <||> mkG pForce <||> mkG pIDEEnvs) // (spstrtok "build" &> pForce <&> \f -> pIDEEnvs <@ BuildProject f)
<|> (spstrtok "path" &> pPathAction)
<|> (spstrtok "root" &> pNotSpace <@ SetRelativeRoot o toString)
<|> (spstrtok "target" &> identifier <@ SetTarget o toString)
......@@ -64,7 +67,7 @@ pProject = spstrtok "project" &> (pProjectWithName <!> yield (Project "" Project
/**
* Parser for the environment commands
*/
pEnvironment :: CParser Char CpmAction a
pEnvironment :: Parser Char a CpmAction
pEnvironment = spstrtok "environment" &> pEnvironmentAction <@ Environment
where pEnvironmentAction = (spstrtok "list" <@ const ListEnvironments)
<|> (spstrtok "import" &> pNotSpace <@ ImportEnvironment o toString)
......@@ -80,40 +83,40 @@ pEnvironment = spstrtok "environment" &> pEnvironmentAction <@ Environment
/**
* Parser for all path-related actions
*/
pPathAction :: CParser Char ProjectAction a
pPathAction :: Parser Char a ProjectAction
pPathAction = pPathAction <@ ProjectPath
where pPathAction = (spstrtok "add" &> pNotSpace <@ AddPathAction o toString)
<|> (spstrtok "remove" &> sp nat <@ RemovePathAction)
<|> (spstrtok "remove" &> ds number <@ RemovePathAction)
<|> (spstrtok "list" <@ const ListPathsAction)
<|> (spstrtok "move" &> pPathDirection)
<!> (pHelp PathHelp)
pPathDirection = sp nat <&> \i -> pConstCtr dirOpts <@ MovePathAction i
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)] -> CParser Char c a
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 :: CParser Char Bool a
pForce :: Parser Char a Bool
pForce = (spstrtok "--force" <@ const True) <!> (yield False)
/**
* Parser for the argument to specify where the IDEEnvs file is
*/
pIDEEnvs :: CParser Char String a
pIDEEnvs = (spstrtok "--envs" &> (<?> (spsymbol '=')) &> pNotSpace <@ toString)
pIDEEnvs :: Parser Char a String
pIDEEnvs = spstrtok "--envs" &> (<?> (ds (symbol '=')) id '=') &> pNotSpace <@ toString
<!> (yield EnvsFileName)
/**
* Parser for module-related actions
*/
pModule :: CParser Char CpmAction a
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)
......@@ -124,7 +127,7 @@ pModule = spstrtok "module" &> (pModuleWithName <!> yield (Module "" ModuleHelp)
/**
* Parser for the help command
*/
pHelp :: c -> CParser Char c a
pHelp :: c -> Parser Char a c
pHelp c = (spstrtok "help" <@ const c) <|> (yield c)
/**
......@@ -132,5 +135,9 @@ pHelp c = (spstrtok "help" <@ const c) <|> (yield c)
* fails, CpmHelp is returned as default action so help may be displayed.
*/
startParse :: [.Char] -> CpmAction
startParse args = maybe CpmHelp snd (find (isnull o fst) (begin pCpm args))
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))
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