Add more flexible command line parser

BatchBuild/BatchBuild.icl

 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