mirror of
https://github.com/simonmichael/hledger.git
synced 2024-11-14 02:14:14 +03:00
128 lines
4.4 KiB
Haskell
128 lines
4.4 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable #-}
|
|
|
|
{-|
|
|
|
|
hledger's cmdargs modes parse command-line arguments to an
|
|
intermediate format, RawOpts (an association list), rather than a
|
|
fixed ADT like CliOpts. This allows the modes and flags to be reused
|
|
more easily by hledger commands/scripts in this and other packages.
|
|
|
|
-}
|
|
|
|
module Hledger.Data.RawOptions (
|
|
RawOpts,
|
|
setopt,
|
|
setboolopt,
|
|
inRawOpts,
|
|
boolopt,
|
|
choiceopt,
|
|
collectopts,
|
|
stringopt,
|
|
maybestringopt,
|
|
listofstringopt,
|
|
intopt,
|
|
posintopt,
|
|
maybeintopt,
|
|
maybeposintopt,
|
|
maybecharopt
|
|
)
|
|
where
|
|
|
|
import Data.Maybe
|
|
import Data.Data
|
|
import Data.Default
|
|
import Safe
|
|
|
|
import Hledger.Utils
|
|
|
|
|
|
-- | The result of running cmdargs: an association list of option names to string values.
|
|
newtype RawOpts = RawOpts { unRawOpts :: [(String,String)] }
|
|
deriving (Show, Data, Typeable)
|
|
|
|
instance Default RawOpts where def = RawOpts []
|
|
|
|
overRawOpts f = RawOpts . f . unRawOpts
|
|
|
|
setopt :: String -> String -> RawOpts -> RawOpts
|
|
setopt name val = overRawOpts (++ [(name, val)])
|
|
|
|
setboolopt :: String -> RawOpts -> RawOpts
|
|
setboolopt name = overRawOpts (++ [(name,"")])
|
|
|
|
-- | Is the named option present ?
|
|
inRawOpts :: String -> RawOpts -> Bool
|
|
inRawOpts name = isJust . lookup name . unRawOpts
|
|
|
|
boolopt :: String -> RawOpts -> Bool
|
|
boolopt = inRawOpts
|
|
|
|
-- | From a list of RawOpts, get the last one (ie the right-most on the command line)
|
|
-- for which the given predicate returns a Just value.
|
|
-- Useful for exclusive choice flags like --daily|--weekly|--quarterly...
|
|
--
|
|
-- >>> choiceopt Just (RawOpts [("a",""), ("b",""), ("c","")])
|
|
-- Just "c"
|
|
-- >>> choiceopt (const Nothing) (RawOpts [("a","")])
|
|
-- Nothing
|
|
-- >>> choiceopt readMay (RawOpts [("LT",""),("EQ",""),("Neither","")]) :: Maybe Ordering
|
|
-- Just EQ
|
|
choiceopt :: (String -> Maybe a) -- ^ "parser" that returns 'Just' value for valid choice
|
|
-> RawOpts -- ^ actual options where to look for flag
|
|
-> Maybe a -- ^ exclusive choice among those returned as 'Just' from "parser"
|
|
choiceopt f = lastMay . collectopts (f . fst)
|
|
|
|
-- | Collects processed and filtered list of options preserving their order
|
|
--
|
|
-- >>> collectopts (const Nothing) (RawOpts [("x","")])
|
|
-- []
|
|
-- >>> collectopts Just (RawOpts [("a",""),("b","")])
|
|
-- [("a",""),("b","")]
|
|
collectopts :: ((String, String) -> Maybe a) -> RawOpts -> [a]
|
|
collectopts f = mapMaybe f . unRawOpts
|
|
|
|
maybestringopt :: String -> RawOpts -> Maybe String
|
|
maybestringopt name = lookup name . reverse . unRawOpts
|
|
|
|
stringopt :: String -> RawOpts -> String
|
|
stringopt name = fromMaybe "" . maybestringopt name
|
|
|
|
maybecharopt :: String -> RawOpts -> Maybe Char
|
|
maybecharopt name (RawOpts rawopts) = lookup name rawopts >>= headMay
|
|
|
|
listofstringopt :: String -> RawOpts -> [String]
|
|
listofstringopt name (RawOpts rawopts) = [v | (k,v) <- rawopts, k==name]
|
|
|
|
-- | Reads the named option's Int argument, if it is present.
|
|
-- An argument that is too small or too large will raise an error.
|
|
maybeintopt :: String -> RawOpts -> Maybe Int
|
|
maybeintopt = maybeclippedintopt minBound maxBound
|
|
|
|
-- | Reads the named option's natural-number argument, if it is present.
|
|
-- An argument that is negative or too large will raise an error.
|
|
maybeposintopt :: String -> RawOpts -> Maybe Int
|
|
maybeposintopt = maybeclippedintopt 0 maxBound
|
|
|
|
-- | Reads the named option's Int argument. If not present it will
|
|
-- return 0. An argument that is too small or too large will raise an error.
|
|
intopt :: String -> RawOpts -> Int
|
|
intopt name = fromMaybe 0 . maybeintopt name
|
|
|
|
-- | Reads the named option's natural-number argument. If not present it will
|
|
-- return 0. An argument that is negative or too large will raise an error.
|
|
posintopt :: String -> RawOpts -> Int
|
|
posintopt name = fromMaybe 0 . maybeposintopt name
|
|
|
|
-- | Reads the named option's Int argument, if it is present. An argument
|
|
-- that does not fit within the given bounds will raise an error.
|
|
maybeclippedintopt :: Int -> Int -> String -> RawOpts -> Maybe Int
|
|
maybeclippedintopt minVal maxVal name =
|
|
fmap (intOrError . readOrError) . maybestringopt name
|
|
where
|
|
readOrError s = readDef (usageError $ "could not parse " ++ name ++ " number: " ++ s) s
|
|
intOrError n | n >= toInteger minVal && n <= toInteger maxVal = fromInteger n
|
|
| otherwise = usageError $ "argument to " ++ name
|
|
++ " must lie in the range "
|
|
++ show minVal ++ " to " ++ show maxVal
|
|
++ ", but is " ++ show n
|