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

Add more flexible command line parser

parent ca6bd016
module BatchBuild
import StdEnv
import StdListExtensions
import ArgEnv
import GenEq
import IdeState
import ParserCombinators
from Platform import application_path
import PmDriver
import PmEnvironment, logfile, set_return_code
import PmProject
import IdeState
import StdEnv
import StdListExtensions
from UtilIO import GetFullApplicationPath,GetLongPathName
import PmEnvironment, logfile, set_return_code
from Platform import application_path
import ParserCombinators
:: BBArgs =
{ force_rebuild :: Bool
, proj_path :: Maybe String
, envsdir :: Maybe String }
, args :: [BBArg] }
:: BBArg = BBBool String | BBString String String | BBInt String Int
derive gEq BBArg
Start :: *World -> *World
Start world
# commandline = getCommandLine
cl = intersperse " " (tl [arg \\ arg <-: commandline])
args = concat [fromString c \\ c <- cl]
{force_rebuild=force_rebuild, proj_path=proj_path, envsdir=envsdir} = startPBB args
| isNothing proj_path = wAbort ("BatchBuild\nUse as: 'BatchBuild [--force] projectname.prj [envsdir]'\n") world
{force_rebuild=force_rebuild, proj_path=proj_path, args=args} = startPBB args
| isNothing proj_path = wAbort ("BatchBuild\nUse as: 'BatchBuild [--force] projectname.prj [--envsdir=ARG] [--action=ARG]'\n") world
# (startup,world) = accFiles GetFullApplicationPath world
# envsdir = case envsdir of
# envsdir = case getStringArg "envsdir" args of
Nothing -> application_path EnvsFileName
(Just p) -> application_path p
# (envs,world) = openEnvironments startup envsdir world // TODO: This is where we need to insert the .env file
# (envs,world) = openEnvironments startup envsdir world
# ((proj,ok,err),world) = accFiles (ReadProjectFile (fromJust proj_path) startup) world
| not ok || err <> "" = wAbort ("BatchBuild failed while opening project: "+++.err+++."\n") world
# (ok,logfile,world) = openLogfile (fromJust proj_path) world
......@@ -36,7 +40,7 @@ Start world
# default_compiler_options = DefaultCompilerOptions
# iniGeneral = initGeneral True default_compiler_options startup (fromJust proj_path) proj envs logfile
# ps = {ls=iniGeneral,gst_world=world,gst_continue_or_stop=False}
# {ls,gst_world} = pinit force_rebuild ps
# {ls,gst_world} = pinit (force_rebuild || hasFlag "force" args) ps
= finish gst_world
concat :: [[.a]] -> [.a]
......@@ -44,17 +48,62 @@ concat xss = foldr (++) [] xss
startPBB :: [.Char] -> BBArgs
startPBB args = case filter (\(xs, _) -> xs == []) (begin pBB args) of
[] -> {force_rebuild = False, proj_path = Nothing, envsdir = Nothing }
[(_, as)] -> as
[] -> {force_rebuild = False, proj_path = Nothing, args = [] }
[(_, as):_] -> as
pBB :: CParser Char BBArgs BBArgs
pBB = pForce <&> \f -> pFilename <&> \p -> pFilename <@ \e -> {force_rebuild = f, proj_path = p, envsdir = e}
pBB = pForce <&> \f -> pFilename <&> \p -> <*> (sp pArgs) <@ \fs -> {force_rebuild = f, proj_path = p, args = fs}
pForce :: CParser Char Bool BBArgs
pForce = (sptoken (fromString "--force") <@ const True) <!> yield False
pForce = pBoolLongOpt "force" <@ const True <|> yield False
pFilename :: CParser Char (Maybe String) BBArgs
pFilename = (sp (<+> (satisfy (not o isWhite))) <@ Just o toString) <!> yield Nothing
pFilename = (pNotSpace <@ Just o toString) <!> yield Nothing
pArgs :: CParser Char BBArg BBArgs
pArgs = pStringLongOpt "envsdir" <|> pBoolLongOpt "force" <|> pStringLongOpt "action"
hasFlag :: String [BBArg] -> Bool
hasFlag _ [] = False
hasFlag flag [(BBBool x):xs] = flag === x || hasFlag flag xs
getStringArg :: String [BBArg] -> Maybe String
getStringArg _ [] = Nothing
getStringArg arg [(BBString x v):xs]
| arg === x = Just v
| otherwise = getStringArg arg xs
getIntArg :: String [BBArg] -> Maybe Int
getIntArg _ [] = Nothing
getIntArg arg [(BBInt x v):xs]
| arg === x = Just v
| otherwise = getIntArg arg xs
pNotSpace :: CParser Char [Char] a
pNotSpace = sp (<+> (satisfy (not o isWhite)))
pBoolLongOpt long = pLongOpt long <@ const (BBBool long)
pBoolShortOpt short = pShortOpt short <@ const (BBBool short)
pIntOpt long short = pIntLongOpt long <|> pIntShortOpt short
pIntLongOpt long = pLongOpt long &> sp int <@ BBInt long
pIntShortOpt short = pShortOpt short &> sp int <@ BBInt short
pStringLongOpt long = pLongOpt long &> sp pNotSpace <@ \s -> BBString long (toString s)
pStringShortOpt short = pShortOpt short &> sp pNotSpace <@ BBString short o toString
pLongOpt long = sptoken (fromString "--") &> token (fromString long) <& (<?> (spsymbol '='))
pShortOpt short = spsymbol '-' &> token (fromString short) <& (<?> (spsymbol '='))
pinit :: .Bool *GeneralSt -> *GeneralSt
pinit force_rebuild ps
......
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