summaryrefslogtreecommitdiff
path: root/src/GF/Infra/Option.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/GF/Infra/Option.hs')
-rw-r--r--src/GF/Infra/Option.hs375
1 files changed, 0 insertions, 375 deletions
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
deleted file mode 100644
index a44cd9db8..000000000
--- a/src/GF/Infra/Option.hs
+++ /dev/null
@@ -1,375 +0,0 @@
-----------------------------------------------------------------------
--- |
--- Module : Option
--- Maintainer : AR
--- Stability : (stable)
--- Portability : (portable)
---
--- > CVS $Date: 2005/11/14 16:03:41 $
--- > CVS $Author: aarne $
--- > CVS $Revision: 1.34 $
---
--- Options and flags used in GF shell commands and files.
---
--- The types 'Option' and 'Options' should be kept abstract, but:
---
--- - The constructor 'Opt' is used in "ShellCommands" and "GrammarToSource"
---
--- - The constructor 'Opts' us udes in "API", "Shell" and "ShellCommands"
------------------------------------------------------------------------------
-
-module GF.Infra.Option where
-
-import Data.List (partition)
-import Data.Char (isDigit)
-
--- * all kinds of options, to be kept abstract
-
-newtype Option = Opt (String,[String]) deriving (Eq,Show,Read)
-newtype Options = Opts [Option] deriving (Eq,Show,Read)
-
-noOptions :: Options
-noOptions = Opts []
-
--- | simple option -o
-iOpt :: String -> Option
-iOpt o = Opt (o,[])
-
--- | option with argument -o=a
-aOpt :: String -> String -> Option
-aOpt o a = Opt (o,[a])
-
-iOpts :: [Option] -> Options
-iOpts = Opts
-
--- | value of option argument
-oArg :: String -> String
-oArg s = s
-
-oElem :: Option -> Options -> Bool
-oElem o (Opts os) = elem o os
-
-eqOpt :: String -> Option -> Bool
-eqOpt s (Opt (o, [])) = s == o
-eqOpt s _ = False
-
-type OptFun = String -> Option
-type OptFunId = String
-
-getOptVal :: Options -> OptFun -> Maybe String
-getOptVal (Opts os) fopt =
- case [a | opt@(Opt (o,[a])) <- os, opt == fopt a] of
- a:_ -> Just a
- _ -> Nothing
-
-isSetFlag :: Options -> OptFun -> Bool
-isSetFlag (Opts os) fopt =
- case [a | opt@(Opt (o,[a])) <- os, opt == fopt a] of
- a:_ -> True
- _ -> False
-
-getOptInt :: Options -> OptFun -> Maybe Int
-getOptInt opts f = do
- s <- getOptVal opts f
- if (not (null s) && all isDigit s) then return (read s) else Nothing
-
-optIntOrAll :: Options -> OptFun -> [a] -> [a]
-optIntOrAll opts f = case getOptInt opts f of
- Just i -> take i
- _ -> id
-
-optIntOrN :: Options -> OptFun -> Int -> Int
-optIntOrN opts f n = case getOptInt opts f of
- Just i -> i
- _ -> n
-
-optIntOrOne :: Options -> OptFun -> Int
-optIntOrOne opts f = optIntOrN opts f 1
-
-changeOptVal :: Options -> OptFun -> String -> Options
-changeOptVal os f x =
- addOption (f x) $ maybe os (\y -> removeOption (f y) os) $ getOptVal os f
-
-addOption :: Option -> Options -> Options
-addOption o (Opts os) = iOpts (o:os)
-
-addOptions :: Options -> Options -> Options
-addOptions (Opts os) os0 = foldr addOption os0 os
-
-concatOptions :: [Options] -> Options
-concatOptions = foldr addOptions noOptions
-
-removeOption :: Option -> Options -> Options
-removeOption o (Opts os) = iOpts (filter (/=o) os)
-
-removeOptions :: Options -> Options -> Options
-removeOptions (Opts os) os0 = foldr removeOption os0 os
-
-options :: [Option] -> Options
-options = foldr addOption noOptions
-
-unionOptions :: Options -> Options -> Options
-unionOptions (Opts os) (Opts os') = Opts (os ++ os')
-
--- * parsing options, with prefix pre (e.g. \"-\")
-
-getOptions :: String -> [String] -> (Options, [String])
-getOptions pre inp = let
- (os,rest) = span (isOption pre) inp -- options before args
- in
- (Opts (map (pOption pre) os), rest)
-
-pOption :: String -> String -> Option
-pOption pre s = case span (/= '=') (drop (length pre) s) of
- (f,_:a) -> aOpt f a
- (o,[]) -> iOpt o
-
-isOption :: String -> String -> Bool
-isOption pre = (==pre) . take (length pre)
-
--- * printing options, without prefix
-
-prOpt :: Option -> String
-prOpt (Opt (s,[])) = s
-prOpt (Opt (s,xs)) = s ++ "=" ++ concat xs
-
-prOpts :: Options -> String
-prOpts (Opts os) = unwords $ map prOpt os
-
--- * a suggestion for option names
-
--- ** parsing
-
-strictParse, forgiveParse, ignoreParse, literalParse, rawParse, firstParse :: Option
--- | parse as term instead of string
-dontParse :: Option
-
-strictParse = iOpt "strict"
-forgiveParse = iOpt "n"
-ignoreParse = iOpt "ign"
-literalParse = iOpt "lit"
-rawParse = iOpt "raw"
-firstParse = iOpt "1"
-dontParse = iOpt "read"
-
-newParser, newerParser, newCParser, newMParser :: Option
-newParser = iOpt "new"
-newerParser = iOpt "newer"
-newCParser = iOpt "cfg"
-newMParser = iOpt "mcfg"
-newFParser = iOpt "fcfg"
-
-{-
-useParserMCFG, useParserMCFGviaCFG, useParserCFG, useParserCF :: Option
-
-useParserMCFG = iOpt "mcfg"
-useParserMCFGviaCFG = iOpt "mcfg-via-cfg"
-useParserCFG = iOpt "cfg"
-useParserCF = iOpt "cf"
--}
-
--- ** grammar formats
-
-showAbstr, showXML, showOld, showLatex, showFullForm,
- showEBNF, showCF, showWords, showOpts,
- isCompiled, isHaskell, noCompOpers, retainOpers,
- noCF, checkCirc, noCheckCirc, lexerByNeed, useUTF8id :: Option
-defaultGrOpts :: [Option]
-
-showAbstr = iOpt "abs"
-showXML = iOpt "xml"
-showOld = iOpt "old"
-showLatex = iOpt "latex"
-showFullForm = iOpt "fullform"
-showEBNF = iOpt "ebnf"
-showCF = iOpt "cf"
-showWords = iOpt "ws"
-showOpts = iOpt "opts"
--- showOptim = iOpt "opt"
-isCompiled = iOpt "gfc"
-isHaskell = iOpt "gfhs"
-noCompOpers = iOpt "nocomp"
-retainOpers = iOpt "retain"
-defaultGrOpts = []
-noCF = iOpt "nocf"
-checkCirc = iOpt "nocirc"
-noCheckCirc = iOpt "nocheckcirc"
-lexerByNeed = iOpt "cflexer"
-useUTF8id = iOpt "utf8id"
-elimSubs = iOpt "subs"
-
--- ** linearization
-
-allLin, firstLin, distinctLin, dontLin,
- showRecord, showStruct, xmlLin, latexLin,
- tableLin, useUTF8, showLang, withMetas :: Option
-defaultLinOpts :: [Option]
-
-allLin = iOpt "all"
-firstLin = iOpt "one"
-distinctLin = iOpt "nub"
-dontLin = iOpt "show"
-showRecord = iOpt "record"
-showStruct = iOpt "structured"
-xmlLin = showXML
-latexLin = showLatex
-tableLin = iOpt "table"
-defaultLinOpts = [firstLin]
-useUTF8 = iOpt "utf8"
-showLang = iOpt "lang"
-showDefs = iOpt "defs"
-withMetas = iOpt "metas"
-
--- ** other
-
-beVerbose, showInfo, beSilent, emitCode, getHelp,
- doMake, doBatch, notEmitCode, makeMulti, beShort,
- wholeGrammar, makeFudget, byLines, byWords, analMorpho,
- doTrace, noCPU, doCompute, optimizeCanon, optimizeValues,
- stripQualif, nostripQualif, showAll, fromSource :: Option
-
-beVerbose = iOpt "v"
-invertGrep = iOpt "v" --- same letter in unix
-showInfo = iOpt "i"
-beSilent = iOpt "s"
-emitCode = iOpt "o"
-getHelp = iOpt "help"
-doMake = iOpt "make"
-doBatch = iOpt "batch"
-notEmitCode = iOpt "noemit"
-makeMulti = iOpt "multi"
-beShort = iOpt "short"
-wholeGrammar = iOpt "w"
-makeFudget = iOpt "f"
-byLines = iOpt "lines"
-byWords = iOpt "words"
-analMorpho = iOpt "morpho"
-doTrace = iOpt "tr"
-noCPU = iOpt "nocpu"
-doCompute = iOpt "c"
-optimizeCanon = iOpt "opt"
-optimizeValues = iOpt "val"
-stripQualif = iOpt "strip"
-nostripQualif = iOpt "nostrip"
-showAll = iOpt "all"
-showFields = iOpt "fields"
-showMulti = iOpt "multi"
-fromSource = iOpt "src"
-makeConcrete = iOpt "examples"
-fromExamples = iOpt "ex"
-openEditor = iOpt "edit"
-getTrees = iOpt "trees"
-
--- ** mainly for stand-alone
-
-useUnicode, optCompute, optCheck, optParaphrase, forJava :: Option
-
-useUnicode = iOpt "unicode"
-optCompute = iOpt "compute"
-optCheck = iOpt "typecheck"
-optParaphrase = iOpt "paraphrase"
-forJava = iOpt "java"
-
--- ** for edit session
-
-allLangs, absView :: Option
-
-allLangs = iOpt "All"
-absView = iOpt "Abs"
-
--- ** options that take arguments
-
-useTokenizer, useUntokenizer, useParser, withFun,
- useLanguage, useResource, speechLanguage, useFont,
- grammarFormat, grammarPrinter, filterString, termCommand,
- transferFun, forForms, menuDisplay, sizeDisplay, typeDisplay,
- noDepTypes, extractGr, pathList, uniCoding :: String -> Option
--- | used on command line
-firstCat :: String -> Option
--- | used in grammar, to avoid clash w res word
-gStartCat :: String -> Option
-
-useTokenizer = aOpt "lexer"
-useUntokenizer = aOpt "unlexer"
-useParser = aOpt "parser"
--- useStrategy = aOpt "strategy" -- parsing strategy
-withFun = aOpt "fun"
-firstCat = aOpt "cat"
-gStartCat = aOpt "startcat"
-useLanguage = aOpt "lang"
-useResource = aOpt "res"
-speechLanguage = aOpt "language"
-useFont = aOpt "font"
-grammarFormat = aOpt "format"
-grammarPrinter = aOpt "printer"
-filterString = aOpt "filter"
-termCommand = aOpt "transform"
-transferFun = aOpt "transfer"
-forForms = aOpt "forms"
-menuDisplay = aOpt "menu"
-sizeDisplay = aOpt "size"
-typeDisplay = aOpt "types"
-noDepTypes = aOpt "nodeptypes"
-extractGr = aOpt "extract"
-pathList = aOpt "path"
-uniCoding = aOpt "coding"
-probFile = aOpt "probs"
-noparseFile = aOpt "noparse"
-usePreprocessor = aOpt "preproc"
-
--- peb 16/3-05:
-gfcConversion :: String -> Option
-gfcConversion = aOpt "conversion"
-
-useName, useAbsName, useCncName, useResName,
- useFile, useOptimizer :: String -> Option
-
-useName = aOpt "name"
-useAbsName = aOpt "abs"
-useCncName = aOpt "cnc"
-useResName = aOpt "res"
-useFile = aOpt "file"
-useOptimizer = aOpt "optimize"
-
-markLin :: String -> Option
-markOptXML, markOptJava, markOptStruct, markOptFocus :: String
-
-markLin = aOpt "mark"
-markOptXML = oArg "xml"
-markOptJava = oArg "java"
-markOptStruct = oArg "struct"
-markOptFocus = oArg "focus"
-
-
--- ** refinement order
-
-nextRefine :: String -> Option
-firstRefine, lastRefine :: String
-
-nextRefine = aOpt "nextrefine"
-firstRefine = oArg "first"
-lastRefine = oArg "last"
-
--- ** Boolean flags
-
-flagYes, flagNo :: String
-
-flagYes = oArg "yes"
-flagNo = oArg "no"
-
--- ** integer flags
-
-flagDepth, flagAlts, flagLength, flagNumber, flagRawtrees :: String -> Option
-
-flagDepth = aOpt "depth"
-flagAlts = aOpt "alts"
-flagLength = aOpt "length"
-flagNumber = aOpt "number"
-flagRawtrees = aOpt "rawtrees"
-
-caseYesNo :: Options -> OptFun -> Maybe Bool
-caseYesNo opts f = do
- v <- getOptVal opts f
- if v == flagYes then return True
- else if v == flagNo then return False
- else Nothing
generated by cgit v1.2.3 (git 2.39.1) at 2026-05-20 06:07:45 +0000