{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Hledger.Reports.ReportOptions (
ReportOpts(..),
BalanceType(..),
AccountListMode(..),
ValuationType(..),
FormatStr,
defreportopts,
rawOptsToReportOpts,
checkReportOpts,
flat_,
tree_,
reportOptsToggleStatus,
simplifyStatuses,
whichDateFromOpts,
journalSelectingAmountFromOpts,
intervalFromRawOpts,
forecastPeriodFromRawOpts,
queryFromOpts,
queryFromOptsOnly,
queryOptsFromOpts,
transactionDateFn,
postingDateFn,
reportSpan,
reportStartDate,
reportEndDate,
specifiedStartEndDates,
specifiedStartDate,
specifiedEndDate,
reportPeriodStart,
reportPeriodOrJournalStart,
reportPeriodLastDay,
reportPeriodOrJournalLastDay,
valuationTypeIsCost,
valuationTypeIsDefaultValue,
tests_ReportOptions
)
where
import Control.Applicative ((<|>))
import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Text as T
import Data.Time.Calendar (Day, addDays, fromGregorian)
import Data.Default (Default(..))
import Safe (lastDef, lastMay)
import System.Console.ANSI (hSupportsANSIColor)
import System.Environment (lookupEnv)
import System.IO (stdout)
import Text.Megaparsec.Custom
import Hledger.Data
import Hledger.Query
import Hledger.Utils
type FormatStr = String
data BalanceType = PeriodChange
| CumulativeChange
| HistoricalBalance
deriving (BalanceType -> BalanceType -> Bool
(BalanceType -> BalanceType -> Bool)
-> (BalanceType -> BalanceType -> Bool) -> Eq BalanceType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BalanceType -> BalanceType -> Bool
$c/= :: BalanceType -> BalanceType -> Bool
== :: BalanceType -> BalanceType -> Bool
$c== :: BalanceType -> BalanceType -> Bool
Eq,Int -> BalanceType -> ShowS
[BalanceType] -> ShowS
BalanceType -> String
(Int -> BalanceType -> ShowS)
-> (BalanceType -> String)
-> ([BalanceType] -> ShowS)
-> Show BalanceType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BalanceType] -> ShowS
$cshowList :: [BalanceType] -> ShowS
show :: BalanceType -> String
$cshow :: BalanceType -> String
showsPrec :: Int -> BalanceType -> ShowS
$cshowsPrec :: Int -> BalanceType -> ShowS
Show)
instance Default BalanceType where def :: BalanceType
def = BalanceType
PeriodChange
data AccountListMode = ALFlat | ALTree deriving (AccountListMode -> AccountListMode -> Bool
(AccountListMode -> AccountListMode -> Bool)
-> (AccountListMode -> AccountListMode -> Bool)
-> Eq AccountListMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountListMode -> AccountListMode -> Bool
$c/= :: AccountListMode -> AccountListMode -> Bool
== :: AccountListMode -> AccountListMode -> Bool
$c== :: AccountListMode -> AccountListMode -> Bool
Eq, Int -> AccountListMode -> ShowS
[AccountListMode] -> ShowS
AccountListMode -> String
(Int -> AccountListMode -> ShowS)
-> (AccountListMode -> String)
-> ([AccountListMode] -> ShowS)
-> Show AccountListMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountListMode] -> ShowS
$cshowList :: [AccountListMode] -> ShowS
show :: AccountListMode -> String
$cshow :: AccountListMode -> String
showsPrec :: Int -> AccountListMode -> ShowS
$cshowsPrec :: Int -> AccountListMode -> ShowS
Show)
instance Default AccountListMode where def :: AccountListMode
def = AccountListMode
ALFlat
data ReportOpts = ReportOpts {
ReportOpts -> Maybe Day
today_ :: Maybe Day
,ReportOpts -> Period
period_ :: Period
,ReportOpts -> Interval
interval_ :: Interval
,ReportOpts -> [Status]
statuses_ :: [Status]
,ReportOpts -> Maybe ValuationType
value_ :: Maybe ValuationType
,ReportOpts -> Bool
infer_value_ :: Bool
,ReportOpts -> Maybe Int
depth_ :: Maybe Int
,ReportOpts -> Bool
date2_ :: Bool
,ReportOpts -> Bool
empty_ :: Bool
,ReportOpts -> Bool
no_elide_ :: Bool
,ReportOpts -> Bool
real_ :: Bool
,ReportOpts -> Maybe String
format_ :: Maybe FormatStr
,ReportOpts -> String
query_ :: String
,ReportOpts -> Bool
average_ :: Bool
,ReportOpts -> Bool
related_ :: Bool
,ReportOpts -> Bool
txn_dates_ :: Bool
,ReportOpts -> BalanceType
balancetype_ :: BalanceType
,ReportOpts -> AccountListMode
accountlistmode_ :: AccountListMode
,ReportOpts -> Int
drop_ :: Int
,ReportOpts -> Bool
row_total_ :: Bool
,ReportOpts -> Bool
no_total_ :: Bool
,ReportOpts -> Bool
pretty_tables_ :: Bool
,ReportOpts -> Bool
sort_amount_ :: Bool
,ReportOpts -> Bool
percent_ :: Bool
,ReportOpts -> Bool
invert_ :: Bool
,ReportOpts -> Maybe NormalSign
normalbalance_ :: Maybe NormalSign
,ReportOpts -> Bool
color_ :: Bool
,ReportOpts -> Maybe DateSpan
forecast_ :: Maybe DateSpan
,ReportOpts -> Bool
transpose_ :: Bool
} deriving (Int -> ReportOpts -> ShowS
[ReportOpts] -> ShowS
ReportOpts -> String
(Int -> ReportOpts -> ShowS)
-> (ReportOpts -> String)
-> ([ReportOpts] -> ShowS)
-> Show ReportOpts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportOpts] -> ShowS
$cshowList :: [ReportOpts] -> ShowS
show :: ReportOpts -> String
$cshow :: ReportOpts -> String
showsPrec :: Int -> ReportOpts -> ShowS
$cshowsPrec :: Int -> ReportOpts -> ShowS
Show)
instance Default ReportOpts where def :: ReportOpts
def = ReportOpts
defreportopts
defreportopts :: ReportOpts
defreportopts :: ReportOpts
defreportopts = Maybe Day
-> Period
-> Interval
-> [Status]
-> Maybe ValuationType
-> Bool
-> Maybe Int
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe String
-> String
-> Bool
-> Bool
-> Bool
-> BalanceType
-> AccountListMode
-> Int
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Maybe NormalSign
-> Bool
-> Maybe DateSpan
-> Bool
-> ReportOpts
ReportOpts
Maybe Day
forall a. Default a => a
def
Period
forall a. Default a => a
def
Interval
forall a. Default a => a
def
[Status]
forall a. Default a => a
def
Maybe ValuationType
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Maybe Int
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Maybe String
forall a. Default a => a
def
String
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Bool
forall a. Default a => a
def
BalanceType
forall a. Default a => a
def
AccountListMode
forall a. Default a => a
def
Int
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Maybe NormalSign
forall a. Default a => a
def
Bool
forall a. Default a => a
def
Maybe DateSpan
forall a. Default a => a
def
Bool
forall a. Default a => a
def
rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts :: RawOpts -> IO ReportOpts
rawOptsToReportOpts rawopts :: RawOpts
rawopts = ReportOpts -> ReportOpts
checkReportOpts (ReportOpts -> ReportOpts) -> IO ReportOpts -> IO ReportOpts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
let rawopts' :: RawOpts
rawopts' = RawOpts -> RawOpts
checkRawOpts RawOpts
rawopts
Day
d <- IO Day
getCurrentDay
Bool
no_color <- Maybe String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv "NO_COLOR"
Bool
supports_color <- Handle -> IO Bool
hSupportsANSIColor Handle
stdout
let colorflag :: String
colorflag = String -> RawOpts -> String
stringopt "color" RawOpts
rawopts
ReportOpts -> IO ReportOpts
forall (m :: * -> *) a. Monad m => a -> m a
return ReportOpts
defreportopts{
today_ :: Maybe Day
today_ = Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d
,period_ :: Period
period_ = Day -> RawOpts -> Period
periodFromRawOpts Day
d RawOpts
rawopts'
,interval_ :: Interval
interval_ = RawOpts -> Interval
intervalFromRawOpts RawOpts
rawopts'
,statuses_ :: [Status]
statuses_ = RawOpts -> [Status]
statusesFromRawOpts RawOpts
rawopts'
,value_ :: Maybe ValuationType
value_ = RawOpts -> Maybe ValuationType
valuationTypeFromRawOpts RawOpts
rawopts'
,infer_value_ :: Bool
infer_value_ = String -> RawOpts -> Bool
boolopt "infer-value" RawOpts
rawopts'
,depth_ :: Maybe Int
depth_ = String -> RawOpts -> Maybe Int
maybeposintopt "depth" RawOpts
rawopts'
,date2_ :: Bool
date2_ = String -> RawOpts -> Bool
boolopt "date2" RawOpts
rawopts'
,empty_ :: Bool
empty_ = String -> RawOpts -> Bool
boolopt "empty" RawOpts
rawopts'
,no_elide_ :: Bool
no_elide_ = String -> RawOpts -> Bool
boolopt "no-elide" RawOpts
rawopts'
,real_ :: Bool
real_ = String -> RawOpts -> Bool
boolopt "real" RawOpts
rawopts'
,format_ :: Maybe String
format_ = String -> RawOpts -> Maybe String
maybestringopt "format" RawOpts
rawopts'
,query_ :: String
query_ = [String] -> String
unwords ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ShowS
quoteIfNeeded ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String -> RawOpts -> [String]
listofstringopt "args" RawOpts
rawopts'
,average_ :: Bool
average_ = String -> RawOpts -> Bool
boolopt "average" RawOpts
rawopts'
,related_ :: Bool
related_ = String -> RawOpts -> Bool
boolopt "related" RawOpts
rawopts'
,txn_dates_ :: Bool
txn_dates_ = String -> RawOpts -> Bool
boolopt "txn-dates" RawOpts
rawopts'
,balancetype_ :: BalanceType
balancetype_ = RawOpts -> BalanceType
balancetypeopt RawOpts
rawopts'
,accountlistmode_ :: AccountListMode
accountlistmode_ = RawOpts -> AccountListMode
accountlistmodeopt RawOpts
rawopts'
,drop_ :: Int
drop_ = String -> RawOpts -> Int
posintopt "drop" RawOpts
rawopts'
,row_total_ :: Bool
row_total_ = String -> RawOpts -> Bool
boolopt "row-total" RawOpts
rawopts'
,no_total_ :: Bool
no_total_ = String -> RawOpts -> Bool
boolopt "no-total" RawOpts
rawopts'
,sort_amount_ :: Bool
sort_amount_ = String -> RawOpts -> Bool
boolopt "sort-amount" RawOpts
rawopts'
,percent_ :: Bool
percent_ = String -> RawOpts -> Bool
boolopt "percent" RawOpts
rawopts'
,invert_ :: Bool
invert_ = String -> RawOpts -> Bool
boolopt "invert" RawOpts
rawopts'
,pretty_tables_ :: Bool
pretty_tables_ = String -> RawOpts -> Bool
boolopt "pretty-tables" RawOpts
rawopts'
,color_ :: Bool
color_ = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [Bool -> Bool
not Bool
no_color
,Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String
colorflag String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["never","no"]
,String
colorflag String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["always","yes"] Bool -> Bool -> Bool
|| Bool
supports_color
]
,forecast_ :: Maybe DateSpan
forecast_ = Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts Day
d RawOpts
rawopts'
,transpose_ :: Bool
transpose_ = String -> RawOpts -> Bool
boolopt "transpose" RawOpts
rawopts'
}
checkRawOpts :: RawOpts -> RawOpts
checkRawOpts :: RawOpts -> RawOpts
checkRawOpts rawopts :: RawOpts
rawopts
| Bool
otherwise = RawOpts
rawopts
checkReportOpts :: ReportOpts -> ReportOpts
checkReportOpts :: ReportOpts -> ReportOpts
checkReportOpts ropts :: ReportOpts
ropts@ReportOpts{..} =
(String -> ReportOpts)
-> (() -> ReportOpts) -> Either String () -> ReportOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ReportOpts
forall a. String -> a
usageError (ReportOpts -> () -> ReportOpts
forall a b. a -> b -> a
const ReportOpts
ropts) (Either String () -> ReportOpts) -> Either String () -> ReportOpts
forall a b. (a -> b) -> a -> b
$ do
case Maybe Int
depth_ of
Just d :: Int
d | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 -> String -> Either String ()
forall a b. a -> Either a b
Left "--depth should have a positive number"
_ -> () -> Either String ()
forall a b. b -> Either a b
Right ()
accountlistmodeopt :: RawOpts -> AccountListMode
accountlistmodeopt :: RawOpts -> AccountListMode
accountlistmodeopt =
AccountListMode -> Maybe AccountListMode -> AccountListMode
forall a. a -> Maybe a -> a
fromMaybe AccountListMode
ALFlat (Maybe AccountListMode -> AccountListMode)
-> (RawOpts -> Maybe AccountListMode) -> RawOpts -> AccountListMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe AccountListMode)
-> RawOpts -> Maybe AccountListMode
forall a. (String -> Maybe a) -> RawOpts -> Maybe a
choiceopt String -> Maybe AccountListMode
parse where
parse :: String -> Maybe AccountListMode
parse = \case
"tree" -> AccountListMode -> Maybe AccountListMode
forall a. a -> Maybe a
Just AccountListMode
ALTree
"flat" -> AccountListMode -> Maybe AccountListMode
forall a. a -> Maybe a
Just AccountListMode
ALFlat
_ -> Maybe AccountListMode
forall a. Maybe a
Nothing
balancetypeopt :: RawOpts -> BalanceType
balancetypeopt :: RawOpts -> BalanceType
balancetypeopt =
BalanceType -> Maybe BalanceType -> BalanceType
forall a. a -> Maybe a -> a
fromMaybe BalanceType
PeriodChange (Maybe BalanceType -> BalanceType)
-> (RawOpts -> Maybe BalanceType) -> RawOpts -> BalanceType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe BalanceType) -> RawOpts -> Maybe BalanceType
forall a. (String -> Maybe a) -> RawOpts -> Maybe a
choiceopt String -> Maybe BalanceType
parse where
parse :: String -> Maybe BalanceType
parse = \case
"historical" -> BalanceType -> Maybe BalanceType
forall a. a -> Maybe a
Just BalanceType
HistoricalBalance
"cumulative" -> BalanceType -> Maybe BalanceType
forall a. a -> Maybe a
Just BalanceType
CumulativeChange
_ -> Maybe BalanceType
forall a. Maybe a
Nothing
periodFromRawOpts :: Day -> RawOpts -> Period
periodFromRawOpts :: Day -> RawOpts -> Period
periodFromRawOpts d :: Day
d rawopts :: RawOpts
rawopts =
case (Maybe Day
mlastb, Maybe Day
mlaste) of
(Nothing, Nothing) -> Period
PeriodAll
(Just b :: Day
b, Nothing) -> Day -> Period
PeriodFrom Day
b
(Nothing, Just e :: Day
e) -> Day -> Period
PeriodTo Day
e
(Just b :: Day
b, Just e :: Day
e) -> Period -> Period
simplifyPeriod (Period -> Period) -> Period -> Period
forall a b. (a -> b) -> a -> b
$
Day -> Day -> Period
PeriodBetween Day
b Day
e
where
mlastb :: Maybe Day
mlastb = case Day -> RawOpts -> [Day]
beginDatesFromRawOpts Day
d RawOpts
rawopts of
[] -> Maybe Day
forall a. Maybe a
Nothing
bs :: [Day]
bs -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ [Day] -> Day
forall a. [a] -> a
last [Day]
bs
mlaste :: Maybe Day
mlaste = case Day -> RawOpts -> [Day]
endDatesFromRawOpts Day
d RawOpts
rawopts of
[] -> Maybe Day
forall a. Maybe a
Nothing
es :: [Day]
es -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ [Day] -> Day
forall a. [a] -> a
last [Day]
es
beginDatesFromRawOpts :: Day -> RawOpts -> [Day]
beginDatesFromRawOpts :: Day -> RawOpts -> [Day]
beginDatesFromRawOpts d :: Day
d = ((String, String) -> Maybe Day) -> RawOpts -> [Day]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (Day -> (String, String) -> Maybe Day
begindatefromrawopt Day
d)
where
begindatefromrawopt :: Day -> (String, String) -> Maybe Day
begindatefromrawopt d :: Day
d (n :: String
n,v :: String
v)
| String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "begin" =
(ParseErrorBundle Text CustomErr -> Maybe Day)
-> (Day -> Maybe Day)
-> Either (ParseErrorBundle Text CustomErr) Day
-> Maybe Day
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: ParseErrorBundle Text CustomErr
e -> String -> Maybe Day
forall a. String -> a
usageError (String -> Maybe Day) -> String -> Maybe Day
forall a b. (a -> b) -> a -> b
$ "could not parse "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nString -> ShowS
forall a. [a] -> [a] -> [a]
++" date: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e) Day -> Maybe Day
forall a. a -> Maybe a
Just (Either (ParseErrorBundle Text CustomErr) Day -> Maybe Day)
-> Either (ParseErrorBundle Text CustomErr) Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$
Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day
fixSmartDateStrEither' Day
d (String -> Text
T.pack String
v)
| String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "period" =
case
(ParseErrorBundle Text CustomErr -> (Interval, DateSpan))
-> ((Interval, DateSpan) -> (Interval, DateSpan))
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> (Interval, DateSpan)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: ParseErrorBundle Text CustomErr
e -> String -> (Interval, DateSpan)
forall a. String -> a
usageError (String -> (Interval, DateSpan)) -> String -> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ "could not parse period option: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e) (Interval, DateSpan) -> (Interval, DateSpan)
forall a. a -> a
id (Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> (Interval, DateSpan))
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$
Day
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
parsePeriodExpr Day
d (Text -> Text
stripquotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v)
of
(_, DateSpan (Just b :: Day
b) _) -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
b
_ -> Maybe Day
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe Day
forall a. Maybe a
Nothing
endDatesFromRawOpts :: Day -> RawOpts -> [Day]
endDatesFromRawOpts :: Day -> RawOpts -> [Day]
endDatesFromRawOpts d :: Day
d = ((String, String) -> Maybe Day) -> RawOpts -> [Day]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (Day -> (String, String) -> Maybe Day
enddatefromrawopt Day
d)
where
enddatefromrawopt :: Day -> (String, String) -> Maybe Day
enddatefromrawopt d :: Day
d (n :: String
n,v :: String
v)
| String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "end" =
(ParseErrorBundle Text CustomErr -> Maybe Day)
-> (Day -> Maybe Day)
-> Either (ParseErrorBundle Text CustomErr) Day
-> Maybe Day
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: ParseErrorBundle Text CustomErr
e -> String -> Maybe Day
forall a. String -> a
usageError (String -> Maybe Day) -> String -> Maybe Day
forall a b. (a -> b) -> a -> b
$ "could not parse "String -> ShowS
forall a. [a] -> [a] -> [a]
++String
nString -> ShowS
forall a. [a] -> [a] -> [a]
++" date: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e) Day -> Maybe Day
forall a. a -> Maybe a
Just (Either (ParseErrorBundle Text CustomErr) Day -> Maybe Day)
-> Either (ParseErrorBundle Text CustomErr) Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$
Day -> Text -> Either (ParseErrorBundle Text CustomErr) Day
fixSmartDateStrEither' Day
d (String -> Text
T.pack String
v)
| String
n String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "period" =
case
(ParseErrorBundle Text CustomErr -> (Interval, DateSpan))
-> ((Interval, DateSpan) -> (Interval, DateSpan))
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> (Interval, DateSpan)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: ParseErrorBundle Text CustomErr
e -> String -> (Interval, DateSpan)
forall a. String -> a
usageError (String -> (Interval, DateSpan)) -> String -> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ "could not parse period option: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e) (Interval, DateSpan) -> (Interval, DateSpan)
forall a. a -> a
id (Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> (Interval, DateSpan))
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$
Day
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
parsePeriodExpr Day
d (Text -> Text
stripquotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v)
of
(_, DateSpan _ (Just e :: Day
e)) -> Day -> Maybe Day
forall a. a -> Maybe a
Just Day
e
_ -> Maybe Day
forall a. Maybe a
Nothing
| Bool
otherwise = Maybe Day
forall a. Maybe a
Nothing
intervalFromRawOpts :: RawOpts -> Interval
intervalFromRawOpts :: RawOpts -> Interval
intervalFromRawOpts = Interval -> [Interval] -> Interval
forall a. a -> [a] -> a
lastDef Interval
NoInterval ([Interval] -> Interval)
-> (RawOpts -> [Interval]) -> RawOpts -> Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Maybe Interval) -> RawOpts -> [Interval]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String, String) -> Maybe Interval
forall a. (Eq a, IsString a) => (a, String) -> Maybe Interval
intervalfromrawopt
where
intervalfromrawopt :: (a, String) -> Maybe Interval
intervalfromrawopt (n :: a
n,v :: String
v)
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "period" =
(ParseErrorBundle Text CustomErr -> Maybe Interval)
-> ((Interval, DateSpan) -> Maybe Interval)
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> Maybe Interval
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\e :: ParseErrorBundle Text CustomErr
e -> String -> Maybe Interval
forall a. String -> a
usageError (String -> Maybe Interval) -> String -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ "could not parse period option: "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e)
(Interval, DateSpan) -> Maybe Interval
extractIntervalOrNothing (Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> Maybe Interval)
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> Maybe Interval
forall a b. (a -> b) -> a -> b
$
Day
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
parsePeriodExpr
(String -> Day
forall a. String -> a
error' "intervalFromRawOpts: did not expect to need today's date here")
(Text -> Text
stripquotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v)
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "daily" = Interval -> Maybe Interval
forall a. a -> Maybe a
Just (Interval -> Maybe Interval) -> Interval -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Days 1
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "weekly" = Interval -> Maybe Interval
forall a. a -> Maybe a
Just (Interval -> Maybe Interval) -> Interval -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Weeks 1
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "monthly" = Interval -> Maybe Interval
forall a. a -> Maybe a
Just (Interval -> Maybe Interval) -> Interval -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Months 1
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "quarterly" = Interval -> Maybe Interval
forall a. a -> Maybe a
Just (Interval -> Maybe Interval) -> Interval -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Quarters 1
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "yearly" = Interval -> Maybe Interval
forall a. a -> Maybe a
Just (Interval -> Maybe Interval) -> Interval -> Maybe Interval
forall a b. (a -> b) -> a -> b
$ Int -> Interval
Years 1
| Bool
otherwise = Maybe Interval
forall a. Maybe a
Nothing
forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts :: Day -> RawOpts -> Maybe DateSpan
forecastPeriodFromRawOpts d :: Day
d opts :: RawOpts
opts =
case String -> RawOpts -> Maybe String
maybestringopt "forecast" RawOpts
opts
of
Nothing -> Maybe DateSpan
forall a. Maybe a
Nothing
Just "" -> DateSpan -> Maybe DateSpan
forall a. a -> Maybe a
Just DateSpan
nulldatespan
Just str :: String
str ->
(ParseErrorBundle Text CustomErr -> Maybe DateSpan)
-> ((Interval, DateSpan) -> Maybe DateSpan)
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> Maybe DateSpan
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\e :: ParseErrorBundle Text CustomErr
e -> String -> Maybe DateSpan
forall a. String -> a
usageError (String -> Maybe DateSpan) -> String -> Maybe DateSpan
forall a b. (a -> b) -> a -> b
$ "could not parse forecast period : "String -> ShowS
forall a. [a] -> [a] -> [a]
++ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e) (DateSpan -> Maybe DateSpan
forall a. a -> Maybe a
Just (DateSpan -> Maybe DateSpan)
-> ((Interval, DateSpan) -> DateSpan)
-> (Interval, DateSpan)
-> Maybe DateSpan
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Interval, DateSpan) -> DateSpan
forall a b. (a, b) -> b
snd) (Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> Maybe DateSpan)
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
-> Maybe DateSpan
forall a b. (a -> b) -> a -> b
$
Day
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
parsePeriodExpr Day
d (Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan))
-> Text
-> Either (ParseErrorBundle Text CustomErr) (Interval, DateSpan)
forall a b. (a -> b) -> a -> b
$ Text -> Text
stripquotes (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
str
extractIntervalOrNothing :: (Interval, DateSpan) -> Maybe Interval
(NoInterval, _) = Maybe Interval
forall a. Maybe a
Nothing
extractIntervalOrNothing (interval :: Interval
interval, _) = Interval -> Maybe Interval
forall a. a -> Maybe a
Just Interval
interval
statusesFromRawOpts :: RawOpts -> [Status]
statusesFromRawOpts :: RawOpts -> [Status]
statusesFromRawOpts = [Status] -> [Status]
forall a. Ord a => [a] -> [a]
simplifyStatuses ([Status] -> [Status])
-> (RawOpts -> [Status]) -> RawOpts -> [Status]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Maybe Status) -> RawOpts -> [Status]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String, String) -> Maybe Status
forall a b. (Eq a, IsString a) => (a, b) -> Maybe Status
statusfromrawopt
where
statusfromrawopt :: (a, b) -> Maybe Status
statusfromrawopt (n :: a
n,_)
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "unmarked" = Status -> Maybe Status
forall a. a -> Maybe a
Just Status
Unmarked
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "pending" = Status -> Maybe Status
forall a. a -> Maybe a
Just Status
Pending
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "cleared" = Status -> Maybe Status
forall a. a -> Maybe a
Just Status
Cleared
| Bool
otherwise = Maybe Status
forall a. Maybe a
Nothing
simplifyStatuses :: [a] -> [a]
simplifyStatuses l :: [a]
l
| [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
l' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
numstatuses = []
| Bool
otherwise = [a]
l'
where
l' :: [a]
l' = [a] -> [a]
forall a. Ord a => [a] -> [a]
nubSort [a]
l
numstatuses :: Int
numstatuses = [Status] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Status
forall a. Bounded a => a
minBound .. Status
forall a. Bounded a => a
maxBound :: Status]
reportOptsToggleStatus :: Status -> ReportOpts -> ReportOpts
reportOptsToggleStatus s :: Status
s ropts :: ReportOpts
ropts@ReportOpts{statuses_ :: ReportOpts -> [Status]
statuses_=[Status]
ss}
| Status
s Status -> [Status] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Status]
ss = ReportOpts
ropts{statuses_ :: [Status]
statuses_=(Status -> Bool) -> [Status] -> [Status]
forall a. (a -> Bool) -> [a] -> [a]
filter (Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
/= Status
s) [Status]
ss}
| Bool
otherwise = ReportOpts
ropts{statuses_ :: [Status]
statuses_=[Status] -> [Status]
forall a. Ord a => [a] -> [a]
simplifyStatuses (Status
sStatus -> [Status] -> [Status]
forall a. a -> [a] -> [a]
:[Status]
ss)}
valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType
valuationTypeFromRawOpts :: RawOpts -> Maybe ValuationType
valuationTypeFromRawOpts = [ValuationType] -> Maybe ValuationType
forall a. [a] -> Maybe a
lastMay ([ValuationType] -> Maybe ValuationType)
-> (RawOpts -> [ValuationType]) -> RawOpts -> Maybe ValuationType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> Maybe ValuationType)
-> RawOpts -> [ValuationType]
forall a. ((String, String) -> Maybe a) -> RawOpts -> [a]
collectopts (String, String) -> Maybe ValuationType
forall a. (Eq a, IsString a) => (a, String) -> Maybe ValuationType
valuationfromrawopt
where
valuationfromrawopt :: (a, String) -> Maybe ValuationType
valuationfromrawopt (n :: a
n,v :: String
v)
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "B" = ValuationType -> Maybe ValuationType
forall a. a -> Maybe a
Just (ValuationType -> Maybe ValuationType)
-> ValuationType -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ Maybe Text -> ValuationType
AtCost Maybe Text
forall a. Maybe a
Nothing
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "V" = ValuationType -> Maybe ValuationType
forall a. a -> Maybe a
Just (ValuationType -> Maybe ValuationType)
-> ValuationType -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ Maybe Text -> ValuationType
AtDefault Maybe Text
forall a. Maybe a
Nothing
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "X" = ValuationType -> Maybe ValuationType
forall a. a -> Maybe a
Just (ValuationType -> Maybe ValuationType)
-> ValuationType -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ Maybe Text -> ValuationType
AtDefault (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
v)
| a
n a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== "value" = ValuationType -> Maybe ValuationType
forall a. a -> Maybe a
Just (ValuationType -> Maybe ValuationType)
-> ValuationType -> Maybe ValuationType
forall a b. (a -> b) -> a -> b
$ String -> ValuationType
valuation String
v
| Bool
otherwise = Maybe ValuationType
forall a. Maybe a
Nothing
valuation :: String -> ValuationType
valuation v :: String
v
| String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["cost","c"] = Maybe Text -> ValuationType
AtCost Maybe Text
mc
| String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["then" ,"t"] = Maybe Text -> ValuationType
AtThen Maybe Text
mc
| String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["end" ,"e"] = Maybe Text -> ValuationType
AtEnd Maybe Text
mc
| String
t String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["now" ,"n"] = Maybe Text -> ValuationType
AtNow Maybe Text
mc
| Bool
otherwise =
case String -> Maybe Day
parsedateM String
t of
Just d :: Day
d -> Day -> Maybe Text -> ValuationType
AtDate Day
d Maybe Text
mc
Nothing -> String -> ValuationType
forall a. String -> a
usageError (String -> ValuationType) -> String -> ValuationType
forall a b. (a -> b) -> a -> b
$ "could not parse \""String -> ShowS
forall a. [a] -> [a] -> [a]
++String
tString -> ShowS
forall a. [a] -> [a] -> [a]
++"\" as valuation type, should be: cost|then|end|now|c|t|e|n|YYYY-MM-DD"
where
(t :: String
t,c' :: String
c') = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==',') String
v
mc :: Maybe Text
mc = case Int -> ShowS
forall a. Int -> [a] -> [a]
drop 1 String
c' of
"" -> Maybe Text
forall a. Maybe a
Nothing
c :: String
c -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
c
valuationTypeIsCost :: ReportOpts -> Bool
valuationTypeIsCost :: ReportOpts -> Bool
valuationTypeIsCost ropts :: ReportOpts
ropts =
case ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts of
Just (AtCost _) -> Bool
True
_ -> Bool
False
valuationTypeIsDefaultValue :: ReportOpts -> Bool
valuationTypeIsDefaultValue :: ReportOpts -> Bool
valuationTypeIsDefaultValue ropts :: ReportOpts
ropts =
case ReportOpts -> Maybe ValuationType
value_ ReportOpts
ropts of
Just (AtDefault _) -> Bool
True
_ -> Bool
False
transactionDateFn :: ReportOpts -> (Transaction -> Day)
transactionDateFn :: ReportOpts -> Transaction -> Day
transactionDateFn ReportOpts{..} = if Bool
date2_ then Transaction -> Day
transactionDate2 else Transaction -> Day
tdate
postingDateFn :: ReportOpts -> (Posting -> Day)
postingDateFn :: ReportOpts -> Posting -> Day
postingDateFn ReportOpts{..} = if Bool
date2_ then Posting -> Day
postingDate2 else Posting -> Day
postingDate
whichDateFromOpts :: ReportOpts -> WhichDate
whichDateFromOpts :: ReportOpts -> WhichDate
whichDateFromOpts ReportOpts{..} = if Bool
date2_ then WhichDate
SecondaryDate else WhichDate
PrimaryDate
tree_ :: ReportOpts -> Bool
tree_ :: ReportOpts -> Bool
tree_ ReportOpts{accountlistmode_ :: ReportOpts -> AccountListMode
accountlistmode_ = AccountListMode
ALTree} = Bool
True
tree_ ReportOpts{accountlistmode_ :: ReportOpts -> AccountListMode
accountlistmode_ = AccountListMode
ALFlat} = Bool
False
flat_ :: ReportOpts -> Bool
flat_ :: ReportOpts -> Bool
flat_ = Bool -> Bool
not (Bool -> Bool) -> (ReportOpts -> Bool) -> ReportOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> Bool
tree_
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
journalSelectingAmountFromOpts :: ReportOpts -> Journal -> Journal
journalSelectingAmountFromOpts opts :: ReportOpts
opts =
case ReportOpts -> Maybe ValuationType
value_ ReportOpts
opts of
Just (AtCost _) -> Journal -> Journal
journalToCost
_ -> Journal -> Journal
forall a. a -> a
id
queryFromOpts :: Day -> ReportOpts -> Query
queryFromOpts :: Day -> ReportOpts -> Query
queryFromOpts d :: Day
d ropts :: ReportOpts
ropts = Query -> Query
simplifyQuery (Query -> Query) -> ([Query] -> Query) -> [Query] -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Query] -> Query
And ([Query] -> Query) -> [Query] -> Query
forall a b. (a -> b) -> a -> b
$ [Query
flagsq, Query
argsq]
where
flagsq :: Query
flagsq = Day -> ReportOpts -> Query
queryFromOptsOnly Day
d ReportOpts
ropts
argsq :: Query
argsq = (Query, [QueryOpt]) -> Query
forall a b. (a, b) -> a
fst ((Query, [QueryOpt]) -> Query) -> (Query, [QueryOpt]) -> Query
forall a b. (a -> b) -> a -> b
$ (String -> (Query, [QueryOpt]))
-> ((Query, [QueryOpt]) -> (Query, [QueryOpt]))
-> Either String (Query, [QueryOpt])
-> (Query, [QueryOpt])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> (Query, [QueryOpt])
forall a. String -> a
error' (Query, [QueryOpt]) -> (Query, [QueryOpt])
forall a. a -> a
id (Either String (Query, [QueryOpt]) -> (Query, [QueryOpt]))
-> Either String (Query, [QueryOpt]) -> (Query, [QueryOpt])
forall a b. (a -> b) -> a -> b
$ Day -> Text -> Either String (Query, [QueryOpt])
parseQuery Day
d (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ReportOpts -> String
query_ ReportOpts
ropts)
queryFromOptsOnly :: Day -> ReportOpts -> Query
queryFromOptsOnly :: Day -> ReportOpts -> Query
queryFromOptsOnly _d :: Day
_d ReportOpts{..} = Query -> Query
simplifyQuery (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$ [Query] -> Query
And [Query]
flagsq
where
flagsq :: [Query]
flagsq = (Bool -> Query) -> Bool -> [Query] -> [Query]
forall a. (Bool -> a) -> Bool -> [a] -> [a]
consIf Bool -> Query
Real Bool
real_
([Query] -> [Query]) -> ([Query] -> [Query]) -> [Query] -> [Query]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Query) -> Bool -> [Query] -> [Query]
forall a. (Bool -> a) -> Bool -> [a] -> [a]
consIf Bool -> Query
Empty Bool
empty_
([Query] -> [Query]) -> ([Query] -> [Query]) -> [Query] -> [Query]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Query) -> Maybe Int -> [Query] -> [Query]
forall a a. (a -> a) -> Maybe a -> [a] -> [a]
consJust Int -> Query
Depth Maybe Int
depth_
([Query] -> [Query]) -> [Query] -> [Query]
forall a b. (a -> b) -> a -> b
$ [ (if Bool
date2_ then DateSpan -> Query
Date2 else DateSpan -> Query
Date) (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ Period -> DateSpan
periodAsDateSpan Period
period_
, [Query] -> Query
Or ([Query] -> Query) -> [Query] -> Query
forall a b. (a -> b) -> a -> b
$ (Status -> Query) -> [Status] -> [Query]
forall a b. (a -> b) -> [a] -> [b]
map Status -> Query
StatusQ [Status]
statuses_
]
consIf :: (Bool -> a) -> Bool -> [a] -> [a]
consIf f :: Bool -> a
f b :: Bool
b = if Bool
b then (Bool -> a
f Bool
Truea -> [a] -> [a]
forall a. a -> [a] -> [a]
:) else [a] -> [a]
forall a. a -> a
id
consJust :: (a -> a) -> Maybe a -> [a] -> [a]
consJust f :: a -> a
f = ([a] -> [a]) -> (a -> [a] -> [a]) -> Maybe a -> [a] -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [a] -> [a]
forall a. a -> a
id ((:) (a -> [a] -> [a]) -> (a -> a) -> a -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)
queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts :: Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts d :: Day
d = (Query, [QueryOpt]) -> [QueryOpt]
forall a b. (a, b) -> b
snd ((Query, [QueryOpt]) -> [QueryOpt])
-> (ReportOpts -> (Query, [QueryOpt])) -> ReportOpts -> [QueryOpt]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> (Query, [QueryOpt]))
-> ((Query, [QueryOpt]) -> (Query, [QueryOpt]))
-> Either String (Query, [QueryOpt])
-> (Query, [QueryOpt])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> (Query, [QueryOpt])
forall a. String -> a
error' (Query, [QueryOpt]) -> (Query, [QueryOpt])
forall a. a -> a
id (Either String (Query, [QueryOpt]) -> (Query, [QueryOpt]))
-> (ReportOpts -> Either String (Query, [QueryOpt]))
-> ReportOpts
-> (Query, [QueryOpt])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Text -> Either String (Query, [QueryOpt])
parseQuery Day
d (Text -> Either String (Query, [QueryOpt]))
-> (ReportOpts -> Text)
-> ReportOpts
-> Either String (Query, [QueryOpt])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ReportOpts -> String) -> ReportOpts -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportOpts -> String
query_
reportSpan :: Journal -> ReportOpts -> IO DateSpan
reportSpan :: Journal -> ReportOpts -> IO DateSpan
reportSpan j :: Journal
j ropts :: ReportOpts
ropts = do
(mspecifiedstartdate :: Maybe Day
mspecifiedstartdate, mspecifiedenddate :: Maybe Day
mspecifiedenddate) <-
String -> (Maybe Day, Maybe Day) -> (Maybe Day, Maybe Day)
forall a. Show a => String -> a -> a
dbg3 "specifieddates" ((Maybe Day, Maybe Day) -> (Maybe Day, Maybe Day))
-> IO (Maybe Day, Maybe Day) -> IO (Maybe Day, Maybe Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates ReportOpts
ropts
let
DateSpan mjournalstartdate :: Maybe Day
mjournalstartdate mjournalenddate :: Maybe Day
mjournalenddate =
String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg3 "journalspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Bool -> Journal -> DateSpan
journalDateSpan Bool
False Journal
j
mstartdate :: Maybe Day
mstartdate = Maybe Day
mspecifiedstartdate Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Day
mjournalstartdate
menddate :: Maybe Day
menddate = Maybe Day
mspecifiedenddate Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Day
mjournalenddate
DateSpan -> IO DateSpan
forall (m :: * -> *) a. Monad m => a -> m a
return (DateSpan -> IO DateSpan) -> DateSpan -> IO DateSpan
forall a b. (a -> b) -> a -> b
$ String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg3 "reportspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan Maybe Day
mstartdate Maybe Day
menddate
reportStartDate :: Journal -> ReportOpts -> IO (Maybe Day)
reportStartDate :: Journal -> ReportOpts -> IO (Maybe Day)
reportStartDate j :: Journal
j ropts :: ReportOpts
ropts = DateSpan -> Maybe Day
spanStart (DateSpan -> Maybe Day) -> IO DateSpan -> IO (Maybe Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> ReportOpts -> IO DateSpan
reportSpan Journal
j ReportOpts
ropts
reportEndDate :: Journal -> ReportOpts -> IO (Maybe Day)
reportEndDate :: Journal -> ReportOpts -> IO (Maybe Day)
reportEndDate j :: Journal
j ropts :: ReportOpts
ropts = DateSpan -> Maybe Day
spanEnd (DateSpan -> Maybe Day) -> IO DateSpan -> IO (Maybe Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> ReportOpts -> IO DateSpan
reportSpan Journal
j ReportOpts
ropts
specifiedStartEndDates :: ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates :: ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates ropts :: ReportOpts
ropts = do
Day
today <- IO Day
getCurrentDay
let
q :: Query
q = Day -> ReportOpts -> Query
queryFromOpts Day
today ReportOpts
ropts
mspecifiedstartdate :: Maybe Day
mspecifiedstartdate = Bool -> Query -> Maybe Day
queryStartDate Bool
False Query
q
mspecifiedenddate :: Maybe Day
mspecifiedenddate = Bool -> Query -> Maybe Day
queryEndDate Bool
False Query
q
(Maybe Day, Maybe Day) -> IO (Maybe Day, Maybe Day)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Day
mspecifiedstartdate, Maybe Day
mspecifiedenddate)
specifiedStartDate :: ReportOpts -> IO (Maybe Day)
specifiedStartDate :: ReportOpts -> IO (Maybe Day)
specifiedStartDate ropts :: ReportOpts
ropts = (Maybe Day, Maybe Day) -> Maybe Day
forall a b. (a, b) -> a
fst ((Maybe Day, Maybe Day) -> Maybe Day)
-> IO (Maybe Day, Maybe Day) -> IO (Maybe Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates ReportOpts
ropts
specifiedEndDate :: ReportOpts -> IO (Maybe Day)
specifiedEndDate :: ReportOpts -> IO (Maybe Day)
specifiedEndDate ropts :: ReportOpts
ropts = (Maybe Day, Maybe Day) -> Maybe Day
forall a b. (a, b) -> b
snd ((Maybe Day, Maybe Day) -> Maybe Day)
-> IO (Maybe Day, Maybe Day) -> IO (Maybe Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates ReportOpts
ropts
reportPeriodStart :: ReportOpts -> Maybe Day
reportPeriodStart :: ReportOpts -> Maybe Day
reportPeriodStart ropts :: ReportOpts
ropts@ReportOpts{..} = do
Day
t <- Maybe Day
today_
Bool -> Query -> Maybe Day
queryStartDate Bool
False (Query -> Maybe Day) -> Query -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Day -> ReportOpts -> Query
queryFromOpts Day
t ReportOpts
ropts
reportPeriodOrJournalStart :: ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalStart :: ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalStart ropts :: ReportOpts
ropts j :: Journal
j =
ReportOpts -> Maybe Day
reportPeriodStart ReportOpts
ropts Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Journal -> Maybe Day
journalStartDate Bool
False Journal
j
reportPeriodLastDay :: ReportOpts -> Maybe Day
reportPeriodLastDay :: ReportOpts -> Maybe Day
reportPeriodLastDay ropts :: ReportOpts
ropts@ReportOpts{..} = do
Day
t <- Maybe Day
today_
let q :: Query
q = Day -> ReportOpts -> Query
queryFromOpts Day
t ReportOpts
ropts
Day
qend <- Bool -> Query -> Maybe Day
queryEndDate Bool
False Query
q
Day -> Maybe Day
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Day -> Day
addDays (-1) Day
qend
reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalLastDay :: ReportOpts -> Journal -> Maybe Day
reportPeriodOrJournalLastDay ropts :: ReportOpts
ropts j :: Journal
j =
ReportOpts -> Maybe Day
reportPeriodLastDay ReportOpts
ropts Maybe Day -> Maybe Day -> Maybe Day
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Journal -> Maybe Day
journalEndDate Bool
False Journal
j
tests_ReportOptions :: TestTree
tests_ReportOptions = String -> [TestTree] -> TestTree
tests "ReportOptions" [
String -> Assertion -> TestTree
test "queryFromOpts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Query
Any
Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts{query_ :: String
query_="a"} Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Regexp -> Query
Acct (String -> Regexp
toRegexCI' "a")
Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts{query_ :: String
query_="desc:'a a'"} Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Regexp -> Query
Desc (String -> Regexp
toRegexCI' "a a")
Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts{period_ :: Period
period_=Day -> Period
PeriodFrom (Integer -> Int -> Int -> Day
fromGregorian 2012 01 01),query_ :: String
query_="date:'to 2013'" }
Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (DateSpan -> Query
Date (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian 2012 01 01) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian 2013 01 01))
Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts{query_ :: String
query_="date2:'in 2012'"} Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (DateSpan -> Query
Date2 (DateSpan -> Query) -> DateSpan -> Query
forall a b. (a -> b) -> a -> b
$ Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian 2012 01 01) (Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Int -> Day
fromGregorian 2013 01 01))
Day -> ReportOpts -> Query
queryFromOpts Day
nulldate ReportOpts
defreportopts{query_ :: String
query_="'a a' 'b"} Query -> Query -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= [Query] -> Query
Or [Regexp -> Query
Acct (Regexp -> Query) -> Regexp -> Query
forall a b. (a -> b) -> a -> b
$ String -> Regexp
toRegexCI' "a a", Regexp -> Query
Acct (Regexp -> Query) -> Regexp -> Query
forall a b. (a -> b) -> a -> b
$ String -> Regexp
toRegexCI' "'b"]
,String -> Assertion -> TestTree
test "queryOptsFromOpts" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts Day
nulldate ReportOpts
defreportopts [QueryOpt] -> [QueryOpt] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= []
Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts Day
nulldate ReportOpts
defreportopts{query_ :: String
query_="a"} [QueryOpt] -> [QueryOpt] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= []
Day -> ReportOpts -> [QueryOpt]
queryOptsFromOpts Day
nulldate ReportOpts
defreportopts{period_ :: Period
period_=Day -> Period
PeriodFrom (Integer -> Int -> Int -> Day
fromGregorian 2012 01 01)
,query_ :: String
query_="date:'to 2013'"} [QueryOpt] -> [QueryOpt] -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= []
]