module Hledger.Data.RawOptions (
RawOpts,
setopt,
setboolopt,
inRawOpts,
boolopt,
choiceopt,
collectopts,
stringopt,
maybestringopt,
listofstringopt,
intopt,
posintopt,
maybeintopt,
maybeposintopt,
maybecharopt
)
where
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Default (Default(..))
import Safe (headMay, lastMay, readDef)
import Hledger.Utils
newtype RawOpts = RawOpts { unRawOpts :: [(String,String)] }
deriving (Show)
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,"")])
inRawOpts :: String -> RawOpts -> Bool
inRawOpts name = isJust . lookup name . unRawOpts
boolopt :: String -> RawOpts -> Bool
boolopt = inRawOpts
choiceopt :: (String -> Maybe a)
-> RawOpts
-> Maybe a
choiceopt f = lastMay . collectopts (f . fst)
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]
maybeintopt :: String -> RawOpts -> Maybe Int
maybeintopt = maybeclippedintopt minBound maxBound
maybeposintopt :: String -> RawOpts -> Maybe Int
maybeposintopt = maybeclippedintopt 0 maxBound
intopt :: String -> RawOpts -> Int
intopt name = fromMaybe 0 . maybeintopt name
posintopt :: String -> RawOpts -> Int
posintopt name = fromMaybe 0 . maybeposintopt name
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