----------------------------------------------------------------------------- -- | -- Module : Lentil.Query -- Copyright : © 2015 Francesco Ariis -- License : GPLv3 (see the LICENSE file) -- -- Command line parsing ----------------------------------------------------------------------------- module Lentil.Args where import Lentil.Types import Lentil.Query import Options.Applicative import qualified Data.Char as C ----------- -- TYPES -- ----------- -- TODO: show help option in lentil short help [feature:intermediate] -- TODO: disambiguation optparse-applicative [feature:intermediate] -- TODO: help as lentil PATH [ PATH... ] [ OPTIONS ] [feature:intermediate] data LOptions = LOptions { loInExcl :: ([FilePath], [FilePath]), loFormat :: Format, loFilters :: [LFilter], loSort :: [LSort], loOutFile :: Maybe FilePath } deriving (Show) type LFilter = [Issue] -> [Issue] type ChType = [LFilter] -> [Issue] -> [Issue] -- AND or OR chain type LSort = [Issue] -> [Issue] lOpts :: Parser LOptions lOpts = LOptions <$> inexcls <*> format <*> filters <*> issort <*> outfile where inexcls = (,) <$> includes <*> many exclude filters = many $ foldl1 (<|>) [tag, notag, path, nopath, desc, nodesc] ------------- -- PARSERS -- ------------- -- argument "." gets replaced to "" (all files) includes :: Parser [FilePath] includes = map repf <$> some (argument str (metavar "PATH...")) where repf "." = "" repf cs = cs exclude :: Parser FilePath exclude = strOption ( short 'x' <> metavar "PATH" <> help "file/directory to exclude" ) format :: Parser Format format = option (str >>= parseFormat) ( short 'f' <> metavar "TYPE" <> value Pretty <> help "output format (pretty, tagpop, csv)" ) where parseFormat :: String -> ReadM Format parseFormat s = let asl = map forTup (enumFrom minBound) in maybe (rerr s "unrecognised format") return (lookup s asl) forTup f = (map C.toLower $ show f, f) outfile :: Parser (Maybe FilePath) outfile = optional $ strOption ( long "output" <> metavar "FILE" <> help "output file (if not present, prints to stdout)" ) issort :: Parser [LSort] issort = pure [] {- TODO: uncomment and implement sorting [feature:intermediate] issort :: Parser [LSort] issort = option (str >>= parseSorts) ( long "sort" <> short 's' <> metavar "[!]ORDER[,[!]ORDER ...]" <> value [] <> help "sort order, comma separated (path, desc, label). \ \'!' orders in descending fashion. Check manual for \ \examples" ) -- TODO: sort parsing? [feature:intermediate] where parseSorts :: String -> ReadM [LSort] parseSorts cs = mapM parSort . words . replace ',' ' ' $ cs -- this parsort is broken [bug] [duct] parSort :: String -> ReadM LSort parSort "path" = return (sortIssues iFile Asc) parSort "desc" = return (sortIssues iDesc Asc) parSort "!path" = return (sortIssues iFile Desc) parSort "!desc" = return (sortIssues iDesc Desc) parSort _ = error "lol" replace :: Char -> Char -> String -> String replace a b cs = map (\c -> if c == a then b else c) cs -} ------------------- -- FILTER PARAMS -- ------------------- path :: Parser LFilter path = option (filterFilepath <$> str) ( short 'p' <> metavar "EXPR" <> help "filters for filepath matching EXPR" ) nopath :: Parser LFilter nopath = option (negFilter . filterFilepath <$> str) ( short 'P' <> metavar "EXPR" <> help "filters for filepath NOT matching EXPR" ) desc :: Parser LFilter desc = option (filterDescription <$> str) ( short 'd' <> metavar "EXPR" <> help "filters for description matching EXPR" ) nodesc :: Parser LFilter nodesc = option (negFilter . filterDescription <$> str) ( short 'D' <> metavar "EXPR" <> help "filters for description NOT matching EXPR" ) tag :: Parser LFilter tag = option optTxt ( short 't' <> metavar "EXPR" <> help "filter for tag matching EXPR" ) notag :: Parser LFilter notag = option (negFilter <$> optTxt) ( short 'T' <> metavar "EXPR" <> help "filter for tag NOT matching EXPR" ) optTxt :: ReadM LFilter optTxt = str >>= \oStr -> if oStr == "^" then return filterTagless else return (filterTags oStr) ----------------- -- ANCILLARIES -- ----------------- rerr :: String -> String -> ReadM a rerr var msg = readerError $ msg ++ " \"" ++ var ++ "\""