{-|

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,
  appendopts,
  inRawOpts,
  boolopt,
  choiceopt,
  collectopts,
  stringopt,
  maybestringopt,
  listofstringopt,
  intopt,
  posintopt,
  maybeintopt,
  maybeposintopt,
  maybecharopt,
  overRawOpts
)
where

import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Default (Default(..))
import Safe (headMay, lastMay, readDef)

import Hledger.Utils


-- | The result of running cmdargs: an association list of option names to string values.
newtype RawOpts = RawOpts { RawOpts -> [(String, String)]
unRawOpts :: [(String,String)] }
  deriving (Int -> RawOpts -> ShowS
[RawOpts] -> ShowS
RawOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawOpts] -> ShowS
$cshowList :: [RawOpts] -> ShowS
show :: RawOpts -> String
$cshow :: RawOpts -> String
showsPrec :: Int -> RawOpts -> ShowS
$cshowsPrec :: Int -> RawOpts -> ShowS
Show)

instance Default RawOpts where def :: RawOpts
def = [(String, String)] -> RawOpts
RawOpts []

overRawOpts :: ([(String, String)] -> [(String, String)]) -> RawOpts -> RawOpts
overRawOpts [(String, String)] -> [(String, String)]
f = [(String, String)] -> RawOpts
RawOpts forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> [(String, String)]
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawOpts -> [(String, String)]
unRawOpts

setopt :: String -> String -> RawOpts -> RawOpts
setopt :: String -> String -> RawOpts -> RawOpts
setopt String
name String
val = ([(String, String)] -> [(String, String)]) -> RawOpts -> RawOpts
overRawOpts (forall a. [a] -> [a] -> [a]
++ [(String
name, String
val)])

setboolopt :: String -> RawOpts -> RawOpts
setboolopt :: String -> RawOpts -> RawOpts
setboolopt String
name = ([(String, String)] -> [(String, String)]) -> RawOpts -> RawOpts
overRawOpts (forall a. [a] -> [a] -> [a]
++ [(String
name,String
"")])

appendopts :: [(String,String)] -> RawOpts -> RawOpts
appendopts :: [(String, String)] -> RawOpts -> RawOpts
appendopts [(String, String)]
new = ([(String, String)] -> [(String, String)]) -> RawOpts -> RawOpts
overRawOpts (forall a. [a] -> [a] -> [a]
++[(String, String)]
new)

-- | Is the named option present ?
inRawOpts :: String -> RawOpts -> Bool
inRawOpts :: String -> RawOpts -> Bool
inRawOpts String
name = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawOpts -> [(String, String)]
unRawOpts

boolopt :: String -> RawOpts -> Bool
boolopt :: String -> RawOpts -> Bool
boolopt = String -> RawOpts -> Bool
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...
--
-- >>> import Safe (readMay)
-- >>> 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 :: forall a. (String -> Maybe a) -> RawOpts -> Maybe a
choiceopt String -> Maybe a
f = forall a. [a] -> Maybe a
lastMay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String -> Maybe a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
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 :: forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String, String) -> Maybe a
f = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, String) -> Maybe a
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawOpts -> [(String, String)]
unRawOpts

maybestringopt :: String -> RawOpts -> Maybe String
maybestringopt :: String -> RawOpts -> Maybe String
maybestringopt String
name = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawOpts -> [(String, String)]
unRawOpts

stringopt :: String -> RawOpts -> String
stringopt :: String -> RawOpts -> String
stringopt String
name = forall a. a -> Maybe a -> a
fromMaybe String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawOpts -> Maybe String
maybestringopt String
name

maybecharopt :: String -> RawOpts -> Maybe Char
maybecharopt :: String -> RawOpts -> Maybe Char
maybecharopt String
name (RawOpts [(String, String)]
rawopts) = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, String)]
rawopts forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. [a] -> Maybe a
headMay

listofstringopt :: String -> RawOpts -> [String]
listofstringopt :: String -> RawOpts -> [String]
listofstringopt String
name (RawOpts [(String, String)]
rawopts) = [String
v | (String
k,String
v) <- [(String, String)]
rawopts, String
kforall a. Eq a => a -> a -> Bool
==String
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 :: String -> RawOpts -> Maybe Int
maybeintopt = Int -> Int -> String -> RawOpts -> Maybe Int
maybeclippedintopt forall a. Bounded a => a
minBound forall a. Bounded a => a
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 :: String -> RawOpts -> Maybe Int
maybeposintopt = Int -> Int -> String -> RawOpts -> Maybe Int
maybeclippedintopt Int
0 forall a. Bounded a => a
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 :: String -> RawOpts -> Int
intopt String
name = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawOpts -> Maybe Int
maybeintopt String
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 :: String -> RawOpts -> Int
posintopt String
name = forall a. a -> Maybe a -> a
fromMaybe Int
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawOpts -> Maybe Int
maybeposintopt String
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 :: Int -> Int -> String -> RawOpts -> Maybe Int
maybeclippedintopt Int
minVal Int
maxVal String
name =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {a}. Num a => Integer -> a
intOrError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Read a => String -> a
readOrError) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawOpts -> Maybe String
maybestringopt String
name
  where
    readOrError :: String -> a
readOrError String
s = forall a. Read a => a -> String -> a
readDef (forall a. String -> a
usageError forall a b. (a -> b) -> a -> b
$ String
"could not parse " forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
" number: " forall a. [a] -> [a] -> [a]
++ String
s) String
s
    intOrError :: Integer -> a
intOrError Integer
n | Integer
n forall a. Ord a => a -> a -> Bool
>= forall a. Integral a => a -> Integer
toInteger Int
minVal Bool -> Bool -> Bool
&& Integer
n forall a. Ord a => a -> a -> Bool
<= forall a. Integral a => a -> Integer
toInteger Int
maxVal = forall {a}. Num a => Integer -> a
fromInteger Integer
n
                 | Bool
otherwise = forall a. String -> a
usageError forall a b. (a -> b) -> a -> b
$ String
"argument to " forall a. [a] -> [a] -> [a]
++ String
name
                                         forall a. [a] -> [a] -> [a]
++ String
" must lie in the range "
                                         forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
minVal forall a. [a] -> [a] -> [a]
++ String
" to " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
maxVal
                                         forall a. [a] -> [a] -> [a]
++ String
", but is " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
n