{-|

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
(Int -> RawOpts -> ShowS)
-> (RawOpts -> String) -> ([RawOpts] -> ShowS) -> Show RawOpts
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 ([(String, String)] -> RawOpts)
-> (RawOpts -> [(String, String)]) -> RawOpts -> RawOpts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> [(String, String)]
f ([(String, String)] -> [(String, String)])
-> (RawOpts -> [(String, String)]) -> RawOpts -> [(String, String)]
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 ([(String, String)] -> [(String, String)] -> [(String, String)]
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 ([(String, String)] -> [(String, String)] -> [(String, String)]
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 (([(String, String)] -> [(String, String)]) -> RawOpts -> RawOpts)
-> ([(String, String)] -> [(String, String)]) -> RawOpts -> RawOpts
forall a b. (a -> b) -> a -> b
$ \[(String, String)]
old -> [[(String, String)]] -> [(String, String)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(String, String)]
old,[(String, String)]
new]

-- | Is the named option present ?
inRawOpts :: String -> RawOpts -> Bool
inRawOpts :: String -> RawOpts -> Bool
inRawOpts String
name = Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> (RawOpts -> Maybe String) -> RawOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name ([(String, String)] -> Maybe String)
-> (RawOpts -> [(String, String)]) -> RawOpts -> Maybe String
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 :: (String -> Maybe a) -> RawOpts -> Maybe a
choiceopt String -> Maybe a
f = [a] -> Maybe a
forall a. [a] -> Maybe a
lastMay ([a] -> Maybe a) -> (RawOpts -> [a]) -> RawOpts -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Maybe a) -> RawOpts -> [a]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String -> Maybe a
f (String -> Maybe a)
-> ((String, String) -> String) -> (String, String) -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, String) -> String
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 :: ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String, String) -> Maybe a
f = ((String, String) -> Maybe a) -> [(String, String)] -> [a]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String, String) -> Maybe a
f ([(String, String)] -> [a])
-> (RawOpts -> [(String, String)]) -> RawOpts -> [a]
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 = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name ([(String, String)] -> Maybe String)
-> (RawOpts -> [(String, String)]) -> RawOpts -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> [(String, String)]
forall a. [a] -> [a]
reverse ([(String, String)] -> [(String, String)])
-> (RawOpts -> [(String, String)]) -> RawOpts -> [(String, String)]
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 = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (RawOpts -> Maybe String) -> RawOpts -> 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) = String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
name [(String, String)]
rawopts Maybe String -> (String -> Maybe Char) -> Maybe Char
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Maybe Char
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
kString -> String -> Bool
forall 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 Int
forall a. Bounded a => a
minBound Int
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 Int
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 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> (RawOpts -> Maybe Int) -> RawOpts -> Int
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 = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Maybe Int -> Int) -> (RawOpts -> Maybe Int) -> RawOpts -> Int
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 =
    (String -> Int) -> Maybe String -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Int
forall p. Num p => Integer -> p
intOrError (Integer -> Int) -> (String -> Integer) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Integer
forall a. Read a => String -> a
readOrError) (Maybe String -> Maybe Int)
-> (RawOpts -> Maybe String) -> RawOpts -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawOpts -> Maybe String
maybestringopt String
name
  where
    readOrError :: String -> a
readOrError String
s = a -> String -> a
forall a. Read a => a -> String -> a
readDef (String -> a
forall a. String -> a
usageError (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"could not parse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" number: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s) String
s
    intOrError :: Integer -> p
intOrError Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
minVal Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
maxVal = Integer -> p
forall p. Num p => Integer -> p
fromInteger Integer
n
                 | Bool
otherwise = String -> p
forall a. String -> a
usageError (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String
"argument to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
                                         String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" must lie in the range "
                                         String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
minVal String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" to " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
maxVal
                                         String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", but is " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n