{-|
    Parse a list of flags supported in any of the front ends.

    Returns the flags in a data structure, along with any invalid flags.
    
    Deal with any files/include files in this stage.
-}

module CmdLine.Flag(
    CmdFlag(..), flagsHelp,
    flagsWebArgs, flagsWebQuery, flagsCmdLine
    ) where

import General.Code
import General.Glob

---------------------------------------------------------------------
-- The flags

data CmdFlag = Version           -- ^ Version information
             | Web               -- ^ Operate as a CGI process
             | Help              -- ^ Help text
             | Test              -- ^ Run the regression tests
             | Color Bool        -- ^ Colors on the console
             | Start Int         -- ^ First result to show
             | Count Int         -- ^ Number of results to show
             | Convert FilePath  -- ^ Convert a database
             | Output FilePath   -- ^ Output file
             | Dump String       -- ^ Dump a database to a file (optional section)
             | DataFile FilePath -- ^ Database location
             | Verbose           -- ^ Display verbose information
             | Info              -- ^ Display as much information as you can
             | Debug             -- ^ Do debugging activities
             | Include FilePath  -- ^ Include directory
             | TestFile FilePath -- ^ Run tests in a file
             | Rank FilePath     -- ^ Generate rankings
             | Combine FilePath  -- ^ Merge a set of databases
             | Mode String       -- ^ Web modes
               deriving (Show,Eq {-! Enum !-} )


-- | In which circumstances are you allowed to pass this command
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"


---------------------------------------------------------------------
-- Operations on Flags

-- | flags that are passed in through web arguments,
--   i.e. ?foo=bar&...
flagsWebArgs :: [(String,String)] -> IO ([CmdFlag],[String])
flagsWebArgs = parseFlags PWebArgs


-- | flags that are given in the web query string
flagsWebQuery :: [(String,String)] -> IO ([CmdFlag],[String])
flagsWebQuery = parseFlags PWebQuery


-- | flags that are given in a query on the command line
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]]                -- rectangular matrix per lines
         -> [[String]]                -- nicely padded
tabulate = transpose . map sameLen . transpose
   where sameLen xs     = flushLeft ((maximum . map length) xs) xs
         flushLeft n xs = [ take n (x ++ repeat ' ') | x <- xs ]


---------------------------------------------------------------------
-- Parsing Flags

-- TODO: check no flag is specified twice
-- TODO: Fix a bug, try /merge=t1;t2 and you get [t1,t1,t2,t2]
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],[])


-- does all validity checks apart from checking for duplicate flags
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



--------------------------------------------------------
-- DERIVES GENERATED CODE
-- DO NOT MODIFY BELOW THIS LINE
-- CHECKSUM: 1401092643

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