module CmdLine.Flag(
CmdFlag(..), flagsHelp,
flagsWebArgs, flagsWebQuery, flagsCmdLine
) where
import General.Code
import General.Glob
data CmdFlag = Version
| Web
| Help
| Test
| Color Bool
| Start Int
| Count Int
| Convert FilePath
| Output FilePath
| Dump String
| DataFile FilePath
| Verbose
| Info
| Debug
| Include FilePath
| TestFile FilePath
| Rank FilePath
| Combine FilePath
| Mode String
deriving (Show,Eq )
data Permission = PWebArgs | PWebQuery | PCmdLine | PMultiple
deriving (Show,Eq)
data Argument = ArgNone CmdFlag
| ArgBool (Bool -> CmdFlag)
| ArgInt (Int -> CmdFlag)
| ArgNat (Int -> CmdFlag)
| ArgPos (Int -> CmdFlag)
| ArgFileIn (FilePath -> CmdFlag) [String]
| ArgFileOut (FilePath -> CmdFlag)
| ArgDir (FilePath -> CmdFlag)
| ArgStr (String -> CmdFlag)
instance Show Argument where
show (ArgNone _) = ""
show (ArgInt _) = "INT"
show (ArgNat _) = "NAT"
show (ArgPos _) = "POS"
show (ArgBool _) = "BOOL"
show (ArgFileIn _ _) = "FILE"
show (ArgFileOut _) = "FILE"
show (ArgDir _) = "DIR"
show (ArgStr _) = "STR"
data FlagInfo = FlagInfo {
argument :: Argument,
names :: [String],
permissions :: [Permission],
description :: String
}
flagInfo =
[f (ArgNone Version) ["version","ver"] [PCmdLine] "Print out version information"
,f (ArgNone Help) ["?","help","h"] [PCmdLine] "Show help message"
,f (ArgNone Web) ["w","web"] [PCmdLine] "Run as though it was a CGI script"
,f (ArgBool Color) ["c","color","col","colour"] [PCmdLine] "Show color output (default=false)"
,f (ArgPos Start) ["s","start"] [PCmdLine,PWebArgs] "First result to show (default=1)"
,f (ArgPos Count) ["n","count","length","len"] [PCmdLine,PWebArgs] "Number of results to show (default=all)"
,f (ArgNone Test) ["test"] [PCmdLine] "Run the regression tests"
,f (ArgFileIn Convert ["txt"]) ["convert"] [PCmdLine,PMultiple] "Convert a database"
,f (ArgFileOut Output) ["output"] [PCmdLine] "Output file for convert"
,f (ArgStr Dump) ["dump"] [PCmdLine] "Dump a database for debugging"
,f (ArgFileIn DataFile ["hoo"]) ["d","data"] [PCmdLine,PMultiple] "Database file"
,f (ArgNone Verbose) ["v","verbose"] [PCmdLine] "Display verbose information"
,f (ArgNone Info) ["info"] [PCmdLine] "Display full information on an entry"
,f (ArgNone Debug) ["debug"] [PCmdLine] "Debugging only"
,f (ArgDir Include) ["i","include"] [PCmdLine,PMultiple] "Include directories"
,f (ArgFileIn TestFile ["txt"]) ["testfile"] [PCmdLine,PMultiple] "Run tests from a file"
,f (ArgFileIn Rank ["txt"]) ["rank"] [PCmdLine,PMultiple] "Generate ranking scores"
,f (ArgFileIn Combine ["hoo"]) ["combine"] [PCmdLine,PMultiple] "Combine multiple databases"
,f (ArgStr Mode) ["mode"] [PCmdLine,PWebArgs] "Web mode"
]
where f = FlagInfo
cmdFlagBadArg flag typ "" = "Missing argument to flag " ++ flag ++ ", expected argument of type " ++ typ
cmdFlagBadArg flag "" x = "Unexpected argument to flag " ++ flag ++ ", got \"" ++ x ++ "\""
cmdFlagBadArg flag typ x = "Bad argument to flag " ++ flag ++ ", expected argument of type " ++ typ ++ ", got \"" ++ x ++ "\""
cmdFlagPermission flag = "Flag not allowed when running in this mode, flag " ++ flag
cmdFlagUnknown flag = "Unknown flag " ++ flag
cmdFlagDuplicate flag = "The flag " ++ flag ++ " may only occur once, but occured multiple times"
flagsWebArgs :: [(String,String)] -> IO ([CmdFlag],[String])
flagsWebArgs = parseFlags PWebArgs
flagsWebQuery :: [(String,String)] -> IO ([CmdFlag],[String])
flagsWebQuery = parseFlags PWebQuery
flagsCmdLine :: [(String,String)] -> IO ([CmdFlag],[String])
flagsCmdLine = parseFlags PCmdLine
flagsHelp :: String
flagsHelp = unlines . map concat . tabulate $ map f res
where
f (a,b,c) = [" ", "--" <+ a, " --" ++ b, " " ++ c]
res = [ (shortOpt (names i) +> typ (argument i), longOpt (names i) ++ typ (argument i), description i)
| i <- flagInfo, PCmdLine `elem` permissions i]
shortOpt ([x]:_) = [x]
shortOpt _ = ""
longOpt ([_]:x:_) = x
longOpt (x:_) = x
typ x = ['='|s/=""] ++ s
where s = show x
x +> y = if null x then "" else x ++ y
x <+ y = if null y then "" else x ++ y
tabulate :: [[String]]
-> [[String]]
tabulate = transpose . map sameLen . transpose
where sameLen xs = flushLeft ((maximum . map length) xs) xs
flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]
parseFlags :: Permission -> [(String,String)] -> IO ([CmdFlag],[String])
parseFlags perm xs = do
let args = concatMap (parseFlag perm) xs
inc = [x | Right (_,_,_,Include x) <- args]
incs <- mapM globDir $ ["."|null inc] ++ inc
(a,b) <- mapAndUnzipM (f incs) args
return ([Include "."|null inc] ++ concat a, concat b)
where
f inc (Right (_,val,FlagInfo{argument=ArgFileIn gen exts},_)) = do
let vals = parseFile val
files <- concatMapM (globFile inc exts) vals
return (map gen files, [])
f inc (Left v) = return ([],[v])
f inc (Right (_,_,_,v)) = return ([v],[])
parseFlag :: Permission -> (String, String) -> [Either String (String,String,FlagInfo,CmdFlag)]
parseFlag perm (key,val)
| isNothing m = [Left $ cmdFlagUnknown key]
| perm `notElem` permissions flg = [Left $ cmdFlagPermission key]
| null arg = [Left $ cmdFlagBadArg key (show $ argument flg) val]
| otherwise = [Right (key,val,flg,a) | a <- arg]
where
key2 = lower key
m@ ~(Just flg) = listToMaybe [i | i <- flagInfo, key2 `elem` names i]
arg = parseArg (argument flg) val
parseArg :: Argument -> String -> [CmdFlag]
parseArg (ArgNone v) xs = [v | null xs]
parseArg (ArgStr v) xs = [v xs]
parseArg (ArgBool v) xs = map v $ parseBool xs
parseArg (ArgNat v) xs = map v $ parseNat xs
parseArg (ArgInt v) xs = map v $ parseInt xs
parseArg (ArgPos v) xs = map v $ parsePos xs
parseArg (ArgFileIn v _) xs = map v $ parseFile xs
parseArg (ArgFileOut v) xs = map v $ parseFile xs
parseArg (ArgDir v) xs = map v $ parseFile xs
parseNat, parsePos, parseInt :: String -> [Int]
parseNat = filter (>= 0) . parseInt
parsePos = filter (> 0) . parseInt
parseInt x = [a | (a,"") <- reads x]
parseFile :: String -> [String]
parseFile = splitSearchPath
parseBool :: String -> [Bool]
parseBool v | v2 `elem` ["","on","yes","1","true","meep"] = [True]
| v2 `elem` ["off","no","0","false","moop"] = [False]
| otherwise = []
where v2 = lower v
instance Enum CmdFlag
where toEnum 0 = Version{}
toEnum 1 = Web{}
toEnum 2 = Help{}
toEnum 3 = Test{}
toEnum 4 = Color{}
toEnum 5 = Start{}
toEnum 6 = Count{}
toEnum 7 = Convert{}
toEnum 8 = Output{}
toEnum 9 = Dump{}
toEnum 10 = DataFile{}
toEnum 11 = Verbose{}
toEnum 12 = Info{}
toEnum 13 = Debug{}
toEnum 14 = Include{}
toEnum 15 = TestFile{}
toEnum 16 = Rank{}
toEnum 17 = Combine{}
toEnum n = error ((++) "toEnum " ((++) (show n) ", not defined for CmdFlag"))
fromEnum (Version {}) = 0
fromEnum (Web {}) = 1
fromEnum (Help {}) = 2
fromEnum (Test {}) = 3
fromEnum (Color {}) = 4
fromEnum (Start {}) = 5
fromEnum (Count {}) = 6
fromEnum (Convert {}) = 7
fromEnum (Output {}) = 8
fromEnum (Dump {}) = 9
fromEnum (DataFile {}) = 10
fromEnum (Verbose {}) = 11
fromEnum (Info {}) = 12
fromEnum (Debug {}) = 13
fromEnum (Include {}) = 14
fromEnum (TestFile {}) = 15
fromEnum (Rank {}) = 16
fromEnum (Combine {}) = 17