Implemented lots of command-line options in GF.Devel.GFC.Options.

src/GF/Devel/GFC/Options.hs

@@ -1,6 +1,11 @@
 module GF.Devel.Options where
 
+import Control.Monad
+import Data.Maybe
 import System.Console.GetOpt
+import System.FilePath
+
+
 
 {-
 
@@ -122,24 +127,142 @@ Set the speech language flag to LANG in the generated grammar.
 
 -}
 
+type ErrorMsg = String
+
+data Err a = Ok a | Errors [ErrorMsg]
+  deriving (Read, Show, Eq)
+
+instance Monad Err where
+  return      = Ok
+  fail e      = Errors [e]
+  Ok a  >>= f = f a
+  Errors s >>= f = Errors s
+
+errors :: [ErrorMsg] -> Err a
+errors = Errors
+
+
+data Mode = Version | Help | Compiler
+  deriving (Show)
+
 data Phase = Preproc | Convert | Compile | Link
+  deriving (Show)
+
+data OutputFormat = FmtGFCC | FmtJS
+  deriving (Show)
+
+data Optimization = None
+  deriving (Show)
 
 data Options = Options {
+                        optMode :: Mode,
                         optStopAfterPhase :: Phase,
                         optVerbosity :: Int,
-                        optShowCPUTime :: Bool
+                        optShowCPUTime :: Bool,
+                        optEmitGFC :: Bool,
+                        optGFCDir :: FilePath,
+                        optOutputFormat :: OutputFormat,
+                        optOutputFile :: Maybe FilePath,
+                        optLibraryPath :: [FilePath],
+                        optForceRecomp :: Bool,
+                        optPreprocessors :: [String],
+                        optOptimization :: Optimization,
+                        optProb :: Bool,
+                        optStartCategory :: Maybe String,
+                        optSpeechLanguage :: Maybe String
                        }
+  deriving (Show)
 
 defaultOptions :: Options
 defaultOptions = Options {
+                          optMode = Compiler,
                           optStopAfterPhase = Link,
                           optVerbosity = 1,
-                          optShowCPUTime = False
+                          optShowCPUTime = False,
+                          optEmitGFC = True,
+                          optGFCDir = ".",
+                          optOutputFormat = FmtGFCC,
+                          optOutputFile = Nothing,
+                          optLibraryPath = [],
+                          optForceRecomp = False,
+                          optPreprocessors = [],
+                          optOptimization = None,
+                          optProb = False,
+                          optStartCategory = Nothing,
+                          optSpeechLanguage = Nothing
                          }
 
-optDescr :: [OptDescr (Options -> Options)]
+
+
+parseOptions :: [String] -> Err (Options, [FilePath])
+parseOptions args = do case errs of
+                         [] -> do o <- foldM (\o f -> f o) defaultOptions opts
+                                  return (o, files)
+                         _  -> errors errs
+    where (opts, files, errs) = getOpt RequireOrder optDescr args
+
+optDescr :: [OptDescr (Options -> Err Options)]
 optDescr = 
     [
-     Option ['E'] [] (phase Preproc) "Stop after preprocessing (with --preproc)"
+     Option ['E'] [] (NoArg (phase Preproc)) "Stop after preprocessing (with --preproc).",
+     Option ['C'] [] (NoArg (phase Convert)) "Stop after conversion to .gf.",
+     Option ['c'] [] (NoArg (phase Compile)) "Stop after compiling to .gfc.",
+     Option ['V'] ["version"] (NoArg (mode Version)) "Display GF version number.",
+     Option ['?','h'] ["help"] (NoArg (mode Help)) "Show help message.",
+     Option ['v'] ["verbose"] (OptArg verbosity "N") "Set verbosity (default 1). -v alone is the same as -v 3.",
+     Option ['q'] ["quiet"] (NoArg (verbosity (Just "0"))) "Quiet, same as -v 0.",
+     Option [] ["cpu"] (NoArg (cpu True)) "Show compilation CPU time statistics.",
+     Option [] ["no-cpu"] (NoArg (cpu False)) "Don't show compilation CPU time statistics (default).",
+     Option [] ["emit-gfc"] (NoArg (emitGFC True)) "Create .gfc files (default).",
+     Option [] ["no-emit-gfc"] (NoArg (emitGFC False)) "Do not create .gfc files.",
+     Option [] ["gfc-dir"] (ReqArg gfcDir "DIR") "Directory to put .gfc files in (default = '.').",
+     Option ['f'] ["output-format"] (ReqArg outFmt "FMT") 
+        (unlines ["Output format. FMT can be one of:",
+                  "Multiple concrete: gfcc (default), gar, js, ...",
+                  "Single concrete only: cf, bnf, lbnf, gsl, srgs_xml, srgs_abnf, ...",
+                  "Abstract only: haskell, ..."]),
+     Option ['o'] ["output-file"] (ReqArg outFile "FILE") 
+           "Save output in FILE (default is out.X, where X depends on output format.",
+     Option ['i'] [] (ReqArg addLibDir "DIR") "Add DIR to the library search path.",
+     Option [] ["path"] (ReqArg setLibPath "DIR:DIR:...") "Set the library search path.",
+     Option [] ["src","force-recomp"] (NoArg (forceRecomp True)) 
+                 "Always recompile from source, i.e. disable recompilation checking.",
+     Option [] ["preproc"] (ReqArg preproc "CMD") 
+                 (unlines ["Use CMD to preprocess input files.",
+                           "Multiple preprocessors can be used by giving this option multiple times."]),
+     Option ['O'] [] (OptArg optimize "OPT") 
+                 "Perform the named optimization. Just -O means FIXME.",
+     Option [] ["prob"] (NoArg (prob True)) "Read probabilities from '--# prob' pragmas.",
+     Option [] ["startcat"] (ReqArg startcat "CAT") "Use CAT as the start category in the generated grammar.",
+     Option [] ["language"] (ReqArg language "LANG") "Set the speech language flag to LANG in the generated grammar."
     ]
- where phase p = NoArg (\o -> o { optStopAfterPhase = p })
+ where phase       x o = return $ o { optStopAfterPhase = x }
+       mode        x o = return $ o { optMode = x }
+       verbosity mv o  = case mv of
+                           Nothing -> return $ o { optVerbosity = 3 }
+                           Just v  -> case reads v of
+                                        [(i,"")] | i >= 0 -> return $ o { optVerbosity = i }
+                                        _        -> fail $ "Bad verbosity: " ++ show v
+       cpu         x o = return $ o { optShowCPUTime = x }
+       emitGFC     x o = return $ o { optEmitGFC = x }
+       gfcDir      x o = return $ o { optGFCDir = x }
+       outFmt      x o = readOutputFormat x >>= \f -> return $ o { optOutputFormat = f }
+       outFile     x o = return $ o { optOutputFile = Just x }
+       addLibDir   x o = return $ o { optLibraryPath = x:optLibraryPath o }
+       setLibPath  x o = return $ o { optLibraryPath = splitSearchPath x }
+       forceRecomp x o = return $ o { optForceRecomp = x }
+       preproc     x o = return $ o { optPreprocessors = optPreprocessors o ++ [x] }
+       optimize    x o = return $ o { optOptimization = None }
+       prob        x o = return $ o { optProb = x }
+       startcat    x o = return $ o { optStartCategory = Just x }
+       language    x o = return $ o { optSpeechLanguage = Just x }
+
+
+outputFormats :: [(String,OutputFormat)]
+outputFormats = 
+    [("gfcc", FmtGFCC),
+     ("js",   FmtJS)]
+
+readOutputFormat :: Monad m => String -> m OutputFormat
+readOutputFormat s = 
+    maybe (fail $ "Unknown output format: " ++ show s) return $ lookup s outputFormats