mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-05-20 00:22:51 -06:00
321 lines
9.2 KiB
Haskell
321 lines
9.2 KiB
Haskell
----------------------------------------------------------------------
|
|
-- |
|
|
-- Module : Option
|
|
-- Maintainer : AR
|
|
-- Stability : (stable)
|
|
-- Portability : (portable)
|
|
--
|
|
-- > CVS $Date: 2005/02/18 19:21:15 $
|
|
-- > CVS $Author: peb $
|
|
-- > CVS $Revision: 1.19 $
|
|
--
|
|
-- 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 Option (-- * all kinds of options, should be kept abstract
|
|
Option(..), Options(..), OptFun, OptFunId,
|
|
noOptions, iOpt, aOpt, iOpts, oArg, oElem, eqOpt,
|
|
getOptVal, getOptInt, optIntOrAll, optIntOrN, optIntOrOne,
|
|
changeOptVal, addOption, addOptions, concatOptions,
|
|
removeOption, removeOptions, options, unionOptions,
|
|
|
|
-- * parsing options, with prefix pre (e.g. \"-\")
|
|
getOptions, pOption, isOption,
|
|
|
|
-- * printing options, without prefix
|
|
prOpt, prOpts,
|
|
|
|
-- * a suggestion for option names
|
|
-- ** parsing
|
|
strictParse, forgiveParse, ignoreParse, literalParse,
|
|
rawParse, firstParse, dontParse,
|
|
-- ** grammar formats
|
|
showAbstr, showXML, showOld, showLatex, showFullForm,
|
|
showEBNF, showCF, showWords, showOpts,
|
|
isCompiled, isHaskell, noCompOpers, retainOpers, defaultGrOpts,
|
|
newParser, noCF, checkCirc, noCheckCirc, lexerByNeed,
|
|
-- ** linearization
|
|
allLin, firstLin, distinctLin, dontLin, showRecord, showStruct,
|
|
xmlLin, latexLin, tableLin, defaultLinOpts, useUTF8, showLang, withMetas,
|
|
-- ** 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,
|
|
-- ** mainly for stand-alone
|
|
useUnicode, optCompute, optCheck, optParaphrase, forJava,
|
|
-- ** for edit session
|
|
allLangs, absView,
|
|
-- ** options that take arguments
|
|
useTokenizer, useUntokenizer, useParser, withFun, firstCat, gStartCat,
|
|
useLanguage, useResource, speechLanguage, useFont,
|
|
grammarFormat, grammarPrinter, filterString, termCommand, transferFun,
|
|
forForms, menuDisplay, sizeDisplay, typeDisplay,
|
|
noDepTypes, extractGr, pathList, uniCoding,
|
|
useName, useAbsName, useCncName, useResName, useFile, useOptimizer,
|
|
markLin, markOptXML, markOptJava, markOptStruct, markOptFocus,
|
|
-- ** refinement order
|
|
nextRefine, firstRefine, lastRefine,
|
|
-- ** Boolean flags
|
|
flagYes, flagNo, caseYesNo,
|
|
-- ** integer flags
|
|
flagDepth, flagAlts, flagLength, flagNumber, flagRawtrees
|
|
) where
|
|
|
|
import List (partition)
|
|
import 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 []
|
|
|
|
iOpt :: String -> Option
|
|
iOpt o = Opt (o,[])
|
|
-- ^ simple option -o
|
|
|
|
aOpt :: String -> String -> Option
|
|
aOpt o a = Opt (o,[a])
|
|
-- ^ option with argument -o=a
|
|
|
|
iOpts :: [Option] -> Options
|
|
iOpts = Opts
|
|
|
|
oArg :: String -> String
|
|
oArg s = s
|
|
-- ^ value of option argument
|
|
|
|
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
|
|
|
|
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 (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 (Opts os) os0 = foldr removeOption os0 os
|
|
|
|
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 (Opt (s,[])) = s
|
|
prOpt (Opt (s,xs)) = s ++ "=" ++ concat xs
|
|
prOpts (Opts os) = unwords $ map prOpt os
|
|
|
|
-- a suggestion for option names
|
|
|
|
-- parsing
|
|
strictParse = iOpt "strict"
|
|
forgiveParse = iOpt "n"
|
|
ignoreParse = iOpt "ign"
|
|
literalParse = iOpt "lit"
|
|
rawParse = iOpt "raw"
|
|
firstParse = iOpt "1"
|
|
dontParse = iOpt "read" -- parse as term instead of string
|
|
|
|
-- grammar formats
|
|
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 = []
|
|
newParser = iOpt "new"
|
|
noCF = iOpt "nocf"
|
|
checkCirc = iOpt "nocirc"
|
|
noCheckCirc = iOpt "nocheckcirc"
|
|
lexerByNeed = iOpt "cflexer"
|
|
|
|
-- linearization
|
|
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"
|
|
withMetas = iOpt "metas"
|
|
|
|
-- other
|
|
beVerbose = iOpt "v"
|
|
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"
|
|
fromSource = iOpt "src"
|
|
|
|
-- mainly for stand-alone
|
|
useUnicode = iOpt "unicode"
|
|
optCompute = iOpt "compute"
|
|
optCheck = iOpt "typecheck"
|
|
optParaphrase = iOpt "paraphrase"
|
|
forJava = iOpt "java"
|
|
|
|
-- for edit session
|
|
allLangs = iOpt "All"
|
|
absView = iOpt "Abs"
|
|
|
|
-- options that take arguments
|
|
useTokenizer = aOpt "lexer"
|
|
useUntokenizer = aOpt "unlexer"
|
|
useParser = aOpt "parser"
|
|
withFun = aOpt "fun"
|
|
firstCat = aOpt "cat" -- used on command line
|
|
gStartCat = aOpt "startcat" -- used in grammar, to avoid clash w res word
|
|
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"
|
|
|
|
useName = aOpt "name"
|
|
useAbsName = aOpt "abs"
|
|
useCncName = aOpt "cnc"
|
|
useResName = aOpt "res"
|
|
useFile = aOpt "file"
|
|
useOptimizer = aOpt "optimize"
|
|
|
|
markLin = aOpt "mark"
|
|
markOptXML = oArg "xml"
|
|
markOptJava = oArg "java"
|
|
markOptStruct = oArg "struct"
|
|
markOptFocus = oArg "focus"
|
|
|
|
|
|
-- refinement order
|
|
nextRefine = aOpt "nextrefine"
|
|
firstRefine = oArg "first"
|
|
lastRefine = oArg "last"
|
|
|
|
-- Boolean flags
|
|
flagYes = oArg "yes"
|
|
flagNo = oArg "no"
|
|
|
|
-- integer flags
|
|
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
|