Skip to content

GitLab

Commit 847b7a48 authored by John van Groningen's avatar John van Groningen
Browse files
Options

use a simple parser without parser combinators to parse the command line arguments, 

allow spaces in arguments
parent c3944bfd
Hide whitespace changes
Inline Side-by-side
Showing with 88 additions and 223 deletions
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;
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