{-|

Most data types are defined here to avoid import cycles.
Here is an overview of the hledger data model:

> Journal                  -- a journal is read from one or more data files. It contains..
>  [Transaction]           -- journal transactions (aka entries), which have date, cleared status, code, description and..
>   [Posting]              -- multiple account postings, which have account name and amount
>  [MarketPrice]           -- historical market prices for commodities
>
> Ledger                   -- a ledger is derived from a journal, by applying a filter specification and doing some further processing. It contains..
>  Journal                 -- a filtered copy of the original journal, containing only the transactions and postings we are interested in
>  [Account]               -- all accounts, in tree order beginning with a "root" account", with their balances and sub/parent accounts

For more detailed documentation on each type, see the corresponding modules.

-}

-- {-# LANGUAGE DeriveAnyClass #-}  -- https://hackage.haskell.org/package/deepseq-1.4.4.0/docs/Control-DeepSeq.html#v:rnf
{-# LANGUAGE CPP        #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE RecordWildCards      #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE StrictData           #-}

module Hledger.Data.Types (
  module Hledger.Data.Types,
#if MIN_VERSION_time(1,11,0)
  Year
#endif
)
where

import GHC.Generics (Generic)
import Control.DeepSeq (NFData(..))
import Data.Bifunctor (first)
import Data.Decimal (Decimal, DecimalRaw(..))
import Data.Default (Default(..))
import Data.Functor (($>))
import Data.List (intercalate, sortBy)
--XXX https://hackage.haskell.org/package/containers/docs/Data-Map.html
--Note: You should use Data.Map.Strict instead of this module if:
--You will eventually need all the values stored.
--The stored values don't represent large virtual data structures to be lazily computed.
import qualified Data.Map as M
import Data.Ord (comparing)
import Data.Semigroup (Min(..))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Calendar (Day)
import Data.Time.Clock.POSIX (POSIXTime)
import Data.Time.LocalTime (LocalTime)
import Data.Word (Word8)
import Text.Blaze (ToMarkup(..))
import Text.Megaparsec (SourcePos(SourcePos), mkPos)

import Hledger.Utils.Regex


-- synonyms for various date-related scalars
#if MIN_VERSION_time(1,11,0)
import Data.Time.Calendar (Year)
#else
type Year = Integer
#endif
type Month = Int     -- 1-12
type Quarter = Int   -- 1-4
type YearWeek = Int  -- 1-52
type MonthWeek = Int -- 1-5
type YearDay = Int   -- 1-366
type MonthDay = Int  -- 1-31
type WeekDay = Int   -- 1-7

-- | A possibly incomplete year-month-day date provided by the user, to be
-- interpreted as either a date or a date span depending on context. Missing
-- parts "on the left" will be filled from the provided reference date, e.g. if
-- the year and month are missing, the reference date's year and month are used.
-- Missing parts "on the right" are assumed, when interpreting as a date, to be
-- 1, (e.g. if the year and month are present but the day is missing, it means
-- first day of that month); or when interpreting as a date span, to be a
-- wildcard (so it would mean all days of that month). See the `smartdate`
-- parser for more examples.
--
-- Or, one of the standard periods and an offset relative to the reference date:
-- (last|this|next) (day|week|month|quarter|year), where "this" means the period
-- containing the reference date.
data SmartDate
  = SmartCompleteDate Day
  | SmartAssumeStart Year (Maybe Month)         -- XXX improve these constructor names
  | SmartFromReference (Maybe Month) MonthDay   --
  | SmartMonth Month
  | SmartRelative Integer SmartInterval
  deriving (Int -> SmartDate -> ShowS
[SmartDate] -> ShowS
SmartDate -> String
(Int -> SmartDate -> ShowS)
-> (SmartDate -> String)
-> ([SmartDate] -> ShowS)
-> Show SmartDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SmartDate -> ShowS
showsPrec :: Int -> SmartDate -> ShowS
$cshow :: SmartDate -> String
show :: SmartDate -> String
$cshowList :: [SmartDate] -> ShowS
showList :: [SmartDate] -> ShowS
Show)

data SmartInterval = Day | Week | Month | Quarter | Year deriving (Int -> SmartInterval -> ShowS
[SmartInterval] -> ShowS
SmartInterval -> String
(Int -> SmartInterval -> ShowS)
-> (SmartInterval -> String)
-> ([SmartInterval] -> ShowS)
-> Show SmartInterval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SmartInterval -> ShowS
showsPrec :: Int -> SmartInterval -> ShowS
$cshow :: SmartInterval -> String
show :: SmartInterval -> String
$cshowList :: [SmartInterval] -> ShowS
showList :: [SmartInterval] -> ShowS
Show)

data WhichDate = PrimaryDate | SecondaryDate deriving (WhichDate -> WhichDate -> Bool
(WhichDate -> WhichDate -> Bool)
-> (WhichDate -> WhichDate -> Bool) -> Eq WhichDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WhichDate -> WhichDate -> Bool
== :: WhichDate -> WhichDate -> Bool
$c/= :: WhichDate -> WhichDate -> Bool
/= :: WhichDate -> WhichDate -> Bool
Eq,Int -> WhichDate -> ShowS
[WhichDate] -> ShowS
WhichDate -> String
(Int -> WhichDate -> ShowS)
-> (WhichDate -> String)
-> ([WhichDate] -> ShowS)
-> Show WhichDate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WhichDate -> ShowS
showsPrec :: Int -> WhichDate -> ShowS
$cshow :: WhichDate -> String
show :: WhichDate -> String
$cshowList :: [WhichDate] -> ShowS
showList :: [WhichDate] -> ShowS
Show)

-- | A date which is either exact or flexible.
-- Flexible dates are allowed to be adjusted in certain situations.
data EFDay = Exact Day | Flex Day deriving (EFDay -> EFDay -> Bool
(EFDay -> EFDay -> Bool) -> (EFDay -> EFDay -> Bool) -> Eq EFDay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EFDay -> EFDay -> Bool
== :: EFDay -> EFDay -> Bool
$c/= :: EFDay -> EFDay -> Bool
/= :: EFDay -> EFDay -> Bool
Eq,(forall x. EFDay -> Rep EFDay x)
-> (forall x. Rep EFDay x -> EFDay) -> Generic EFDay
forall x. Rep EFDay x -> EFDay
forall x. EFDay -> Rep EFDay x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EFDay -> Rep EFDay x
from :: forall x. EFDay -> Rep EFDay x
$cto :: forall x. Rep EFDay x -> EFDay
to :: forall x. Rep EFDay x -> EFDay
Generic,Int -> EFDay -> ShowS
[EFDay] -> ShowS
EFDay -> String
(Int -> EFDay -> ShowS)
-> (EFDay -> String) -> ([EFDay] -> ShowS) -> Show EFDay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EFDay -> ShowS
showsPrec :: Int -> EFDay -> ShowS
$cshow :: EFDay -> String
show :: EFDay -> String
$cshowList :: [EFDay] -> ShowS
showList :: [EFDay] -> ShowS
Show)

-- EFDay's Ord instance treats them like ordinary dates, ignoring exact/flexible.
instance Ord EFDay where compare :: EFDay -> EFDay -> Ordering
compare EFDay
d1 EFDay
d2 = Day -> Day -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (EFDay -> Day
fromEFDay EFDay
d1) (EFDay -> Day
fromEFDay EFDay
d2)

-- instance Ord EFDay where compare = maCompare

fromEFDay :: EFDay -> Day
fromEFDay :: EFDay -> Day
fromEFDay (Exact Day
d) = Day
d
fromEFDay (Flex  Day
d) = Day
d

modifyEFDay :: (Day -> Day) -> EFDay -> EFDay
modifyEFDay :: (Day -> Day) -> EFDay -> EFDay
modifyEFDay Day -> Day
f (Exact Day
d) = Day -> EFDay
Exact (Day -> EFDay) -> Day -> EFDay
forall a b. (a -> b) -> a -> b
$ Day -> Day
f Day
d
modifyEFDay Day -> Day
f (Flex  Day
d) = Day -> EFDay
Flex  (Day -> EFDay) -> Day -> EFDay
forall a b. (a -> b) -> a -> b
$ Day -> Day
f Day
d

-- | A possibly open-ended span of time, from an optional inclusive start date
-- to an optional exclusive end date. Each date can be either exact or flexible.
-- An "exact date span" is a Datepan with exact start and end dates.
data DateSpan = DateSpan (Maybe EFDay) (Maybe EFDay) deriving (DateSpan -> DateSpan -> Bool
(DateSpan -> DateSpan -> Bool)
-> (DateSpan -> DateSpan -> Bool) -> Eq DateSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DateSpan -> DateSpan -> Bool
== :: DateSpan -> DateSpan -> Bool
$c/= :: DateSpan -> DateSpan -> Bool
/= :: DateSpan -> DateSpan -> Bool
Eq,Eq DateSpan
Eq DateSpan =>
(DateSpan -> DateSpan -> Ordering)
-> (DateSpan -> DateSpan -> Bool)
-> (DateSpan -> DateSpan -> Bool)
-> (DateSpan -> DateSpan -> Bool)
-> (DateSpan -> DateSpan -> Bool)
-> (DateSpan -> DateSpan -> DateSpan)
-> (DateSpan -> DateSpan -> DateSpan)
-> Ord DateSpan
DateSpan -> DateSpan -> Bool
DateSpan -> DateSpan -> Ordering
DateSpan -> DateSpan -> DateSpan
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DateSpan -> DateSpan -> Ordering
compare :: DateSpan -> DateSpan -> Ordering
$c< :: DateSpan -> DateSpan -> Bool
< :: DateSpan -> DateSpan -> Bool
$c<= :: DateSpan -> DateSpan -> Bool
<= :: DateSpan -> DateSpan -> Bool
$c> :: DateSpan -> DateSpan -> Bool
> :: DateSpan -> DateSpan -> Bool
$c>= :: DateSpan -> DateSpan -> Bool
>= :: DateSpan -> DateSpan -> Bool
$cmax :: DateSpan -> DateSpan -> DateSpan
max :: DateSpan -> DateSpan -> DateSpan
$cmin :: DateSpan -> DateSpan -> DateSpan
min :: DateSpan -> DateSpan -> DateSpan
Ord,(forall x. DateSpan -> Rep DateSpan x)
-> (forall x. Rep DateSpan x -> DateSpan) -> Generic DateSpan
forall x. Rep DateSpan x -> DateSpan
forall x. DateSpan -> Rep DateSpan x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DateSpan -> Rep DateSpan x
from :: forall x. DateSpan -> Rep DateSpan x
$cto :: forall x. Rep DateSpan x -> DateSpan
to :: forall x. Rep DateSpan x -> DateSpan
Generic)

instance Default DateSpan where def :: DateSpan
def = Maybe EFDay -> Maybe EFDay -> DateSpan
DateSpan Maybe EFDay
forall a. Maybe a
Nothing Maybe EFDay
forall a. Maybe a
Nothing

-- Some common report subperiods, both finite and open-ended.
-- A higher-level abstraction than DateSpan.
data Period =
    DayPeriod Day
  | WeekPeriod Day
  | MonthPeriod Year Month
  | QuarterPeriod Year Quarter
  | YearPeriod Year
  | PeriodBetween Day Day
  | PeriodFrom Day
  | PeriodTo Day
  | PeriodAll
  deriving (Period -> Period -> Bool
(Period -> Period -> Bool)
-> (Period -> Period -> Bool) -> Eq Period
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Period -> Period -> Bool
== :: Period -> Period -> Bool
$c/= :: Period -> Period -> Bool
/= :: Period -> Period -> Bool
Eq,Eq Period
Eq Period =>
(Period -> Period -> Ordering)
-> (Period -> Period -> Bool)
-> (Period -> Period -> Bool)
-> (Period -> Period -> Bool)
-> (Period -> Period -> Bool)
-> (Period -> Period -> Period)
-> (Period -> Period -> Period)
-> Ord Period
Period -> Period -> Bool
Period -> Period -> Ordering
Period -> Period -> Period
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Period -> Period -> Ordering
compare :: Period -> Period -> Ordering
$c< :: Period -> Period -> Bool
< :: Period -> Period -> Bool
$c<= :: Period -> Period -> Bool
<= :: Period -> Period -> Bool
$c> :: Period -> Period -> Bool
> :: Period -> Period -> Bool
$c>= :: Period -> Period -> Bool
>= :: Period -> Period -> Bool
$cmax :: Period -> Period -> Period
max :: Period -> Period -> Period
$cmin :: Period -> Period -> Period
min :: Period -> Period -> Period
Ord,Int -> Period -> ShowS
[Period] -> ShowS
Period -> String
(Int -> Period -> ShowS)
-> (Period -> String) -> ([Period] -> ShowS) -> Show Period
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Period -> ShowS
showsPrec :: Int -> Period -> ShowS
$cshow :: Period -> String
show :: Period -> String
$cshowList :: [Period] -> ShowS
showList :: [Period] -> ShowS
Show,(forall x. Period -> Rep Period x)
-> (forall x. Rep Period x -> Period) -> Generic Period
forall x. Rep Period x -> Period
forall x. Period -> Rep Period x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Period -> Rep Period x
from :: forall x. Period -> Rep Period x
$cto :: forall x. Rep Period x -> Period
to :: forall x. Rep Period x -> Period
Generic)

instance Default Period where def :: Period
def = Period
PeriodAll

-- All the kinds of report interval allowed in a period expression
-- (to generate periodic reports or periodic transactions).
data Interval =
    NoInterval
  | Days Int
  | Weeks Int
  | Months Int
  | Quarters Int
  | Years Int
  | NthWeekdayOfMonth Int Int  -- n,              weekday 1-7
  | MonthDay Int               -- 1-31
  | MonthAndDay Int Int        -- month 1-12,     monthday 1-31
  | DaysOfWeek [Int]           -- [weekday 1-7]
  deriving (Interval -> Interval -> Bool
(Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool) -> Eq Interval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Interval -> Interval -> Bool
== :: Interval -> Interval -> Bool
$c/= :: Interval -> Interval -> Bool
/= :: Interval -> Interval -> Bool
Eq,Int -> Interval -> ShowS
[Interval] -> ShowS
Interval -> String
(Int -> Interval -> ShowS)
-> (Interval -> String) -> ([Interval] -> ShowS) -> Show Interval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Interval -> ShowS
showsPrec :: Int -> Interval -> ShowS
$cshow :: Interval -> String
show :: Interval -> String
$cshowList :: [Interval] -> ShowS
showList :: [Interval] -> ShowS
Show,Eq Interval
Eq Interval =>
(Interval -> Interval -> Ordering)
-> (Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool)
-> (Interval -> Interval -> Interval)
-> (Interval -> Interval -> Interval)
-> Ord Interval
Interval -> Interval -> Bool
Interval -> Interval -> Ordering
Interval -> Interval -> Interval
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Interval -> Interval -> Ordering
compare :: Interval -> Interval -> Ordering
$c< :: Interval -> Interval -> Bool
< :: Interval -> Interval -> Bool
$c<= :: Interval -> Interval -> Bool
<= :: Interval -> Interval -> Bool
$c> :: Interval -> Interval -> Bool
> :: Interval -> Interval -> Bool
$c>= :: Interval -> Interval -> Bool
>= :: Interval -> Interval -> Bool
$cmax :: Interval -> Interval -> Interval
max :: Interval -> Interval -> Interval
$cmin :: Interval -> Interval -> Interval
min :: Interval -> Interval -> Interval
Ord,(forall x. Interval -> Rep Interval x)
-> (forall x. Rep Interval x -> Interval) -> Generic Interval
forall x. Rep Interval x -> Interval
forall x. Interval -> Rep Interval x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Interval -> Rep Interval x
from :: forall x. Interval -> Rep Interval x
$cto :: forall x. Rep Interval x -> Interval
to :: forall x. Rep Interval x -> Interval
Generic)

instance Default Interval where def :: Interval
def = Interval
NoInterval

type Payee = Text

type AccountName = Text

-- A specification indicating how to depth-limit
data DepthSpec = DepthSpec {
  DepthSpec -> Maybe Int
dsFlatDepth    :: Maybe Int,
  DepthSpec -> [(Regexp, Int)]
dsRegexpDepths :: [(Regexp, Int)]
  } deriving (DepthSpec -> DepthSpec -> Bool
(DepthSpec -> DepthSpec -> Bool)
-> (DepthSpec -> DepthSpec -> Bool) -> Eq DepthSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DepthSpec -> DepthSpec -> Bool
== :: DepthSpec -> DepthSpec -> Bool
$c/= :: DepthSpec -> DepthSpec -> Bool
/= :: DepthSpec -> DepthSpec -> Bool
Eq,Int -> DepthSpec -> ShowS
[DepthSpec] -> ShowS
DepthSpec -> String
(Int -> DepthSpec -> ShowS)
-> (DepthSpec -> String)
-> ([DepthSpec] -> ShowS)
-> Show DepthSpec
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DepthSpec -> ShowS
showsPrec :: Int -> DepthSpec -> ShowS
$cshow :: DepthSpec -> String
show :: DepthSpec -> String
$cshowList :: [DepthSpec] -> ShowS
showList :: [DepthSpec] -> ShowS
Show)

-- Semigroup instance consider all regular expressions, but take the minimum of the simple flat depths
instance Semigroup DepthSpec where
    DepthSpec Maybe Int
d1 [(Regexp, Int)]
l1 <> :: DepthSpec -> DepthSpec -> DepthSpec
<> DepthSpec Maybe Int
d2 [(Regexp, Int)]
l2 = Maybe Int -> [(Regexp, Int)] -> DepthSpec
DepthSpec (Min Int -> Int
forall a. Min a -> a
getMin (Min Int -> Int) -> Maybe (Min Int) -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Min Int
forall a. a -> Min a
Min (Int -> Min Int) -> Maybe Int -> Maybe (Min Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
d1) Maybe (Min Int) -> Maybe (Min Int) -> Maybe (Min Int)
forall a. Semigroup a => a -> a -> a
<> (Int -> Min Int
forall a. a -> Min a
Min (Int -> Min Int) -> Maybe Int -> Maybe (Min Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
d2)) ([(Regexp, Int)]
l1 [(Regexp, Int)] -> [(Regexp, Int)] -> [(Regexp, Int)]
forall a. [a] -> [a] -> [a]
++ [(Regexp, Int)]
l2)

instance Monoid DepthSpec where
    mempty :: DepthSpec
mempty = Maybe Int -> [(Regexp, Int)] -> DepthSpec
DepthSpec Maybe Int
forall a. Maybe a
Nothing []

data AccountType =
    Asset
  | Liability
  | Equity
  | Revenue
  | Expense
  | Cash  -- ^ a subtype of Asset - liquid assets to show in cashflow report
  | Conversion -- ^ a subtype of Equity - account with which to balance commodity conversions
  deriving (AccountType -> AccountType -> Bool
(AccountType -> AccountType -> Bool)
-> (AccountType -> AccountType -> Bool) -> Eq AccountType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccountType -> AccountType -> Bool
== :: AccountType -> AccountType -> Bool
$c/= :: AccountType -> AccountType -> Bool
/= :: AccountType -> AccountType -> Bool
Eq,Eq AccountType
Eq AccountType =>
(AccountType -> AccountType -> Ordering)
-> (AccountType -> AccountType -> Bool)
-> (AccountType -> AccountType -> Bool)
-> (AccountType -> AccountType -> Bool)
-> (AccountType -> AccountType -> Bool)
-> (AccountType -> AccountType -> AccountType)
-> (AccountType -> AccountType -> AccountType)
-> Ord AccountType
AccountType -> AccountType -> Bool
AccountType -> AccountType -> Ordering
AccountType -> AccountType -> AccountType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AccountType -> AccountType -> Ordering
compare :: AccountType -> AccountType -> Ordering
$c< :: AccountType -> AccountType -> Bool
< :: AccountType -> AccountType -> Bool
$c<= :: AccountType -> AccountType -> Bool
<= :: AccountType -> AccountType -> Bool
$c> :: AccountType -> AccountType -> Bool
> :: AccountType -> AccountType -> Bool
$c>= :: AccountType -> AccountType -> Bool
>= :: AccountType -> AccountType -> Bool
$cmax :: AccountType -> AccountType -> AccountType
max :: AccountType -> AccountType -> AccountType
$cmin :: AccountType -> AccountType -> AccountType
min :: AccountType -> AccountType -> AccountType
Ord,(forall x. AccountType -> Rep AccountType x)
-> (forall x. Rep AccountType x -> AccountType)
-> Generic AccountType
forall x. Rep AccountType x -> AccountType
forall x. AccountType -> Rep AccountType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccountType -> Rep AccountType x
from :: forall x. AccountType -> Rep AccountType x
$cto :: forall x. Rep AccountType x -> AccountType
to :: forall x. Rep AccountType x -> AccountType
Generic)

instance Show AccountType where
  show :: AccountType -> String
show AccountType
Asset      = String
"A"
  show AccountType
Liability  = String
"L"
  show AccountType
Equity     = String
"E"
  show AccountType
Revenue    = String
"R"
  show AccountType
Expense    = String
"X"
  show AccountType
Cash       = String
"C"
  show AccountType
Conversion = String
"V"

isBalanceSheetAccountType :: AccountType -> Bool
isBalanceSheetAccountType :: AccountType -> Bool
isBalanceSheetAccountType AccountType
t = AccountType
t AccountType -> [AccountType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [
  AccountType
Asset,
  AccountType
Liability,
  AccountType
Equity,
  AccountType
Cash,
  AccountType
Conversion
  ]

isIncomeStatementAccountType :: AccountType -> Bool
isIncomeStatementAccountType :: AccountType -> Bool
isIncomeStatementAccountType AccountType
t = AccountType
t AccountType -> [AccountType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [
  AccountType
Revenue,
  AccountType
Expense
  ]

-- | Check whether the first argument is a subtype of the second: either equal
-- or one of the defined subtypes.
isAccountSubtypeOf :: AccountType -> AccountType -> Bool
isAccountSubtypeOf :: AccountType -> AccountType -> Bool
isAccountSubtypeOf AccountType
Asset      AccountType
Asset      = Bool
True
isAccountSubtypeOf AccountType
Liability  AccountType
Liability  = Bool
True
isAccountSubtypeOf AccountType
Equity     AccountType
Equity     = Bool
True
isAccountSubtypeOf AccountType
Revenue    AccountType
Revenue    = Bool
True
isAccountSubtypeOf AccountType
Expense    AccountType
Expense    = Bool
True
isAccountSubtypeOf AccountType
Cash       AccountType
Cash       = Bool
True
isAccountSubtypeOf AccountType
Cash       AccountType
Asset      = Bool
True
isAccountSubtypeOf AccountType
Conversion AccountType
Conversion = Bool
True
isAccountSubtypeOf AccountType
Conversion AccountType
Equity     = Bool
True
isAccountSubtypeOf AccountType
_          AccountType
_          = Bool
False

-- not worth the trouble, letters defined in accountdirectivep for now
--instance Read AccountType
--  where
--    readsPrec _ ('A' : xs) = [(Asset,     xs)]
--    readsPrec _ ('L' : xs) = [(Liability, xs)]
--    readsPrec _ ('E' : xs) = [(Equity,    xs)]
--    readsPrec _ ('R' : xs) = [(Revenue,   xs)]
--    readsPrec _ ('X' : xs) = [(Expense,   xs)]
--    readsPrec _ _ = []

data AccountAlias = BasicAlias AccountName AccountName
                  | RegexAlias Regexp Replacement
  deriving (AccountAlias -> AccountAlias -> Bool
(AccountAlias -> AccountAlias -> Bool)
-> (AccountAlias -> AccountAlias -> Bool) -> Eq AccountAlias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccountAlias -> AccountAlias -> Bool
== :: AccountAlias -> AccountAlias -> Bool
$c/= :: AccountAlias -> AccountAlias -> Bool
/= :: AccountAlias -> AccountAlias -> Bool
Eq, ReadPrec [AccountAlias]
ReadPrec AccountAlias
Int -> ReadS AccountAlias
ReadS [AccountAlias]
(Int -> ReadS AccountAlias)
-> ReadS [AccountAlias]
-> ReadPrec AccountAlias
-> ReadPrec [AccountAlias]
-> Read AccountAlias
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AccountAlias
readsPrec :: Int -> ReadS AccountAlias
$creadList :: ReadS [AccountAlias]
readList :: ReadS [AccountAlias]
$creadPrec :: ReadPrec AccountAlias
readPrec :: ReadPrec AccountAlias
$creadListPrec :: ReadPrec [AccountAlias]
readListPrec :: ReadPrec [AccountAlias]
Read, Int -> AccountAlias -> ShowS
[AccountAlias] -> ShowS
AccountAlias -> String
(Int -> AccountAlias -> ShowS)
-> (AccountAlias -> String)
-> ([AccountAlias] -> ShowS)
-> Show AccountAlias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountAlias -> ShowS
showsPrec :: Int -> AccountAlias -> ShowS
$cshow :: AccountAlias -> String
show :: AccountAlias -> String
$cshowList :: [AccountAlias] -> ShowS
showList :: [AccountAlias] -> ShowS
Show, Eq AccountAlias
Eq AccountAlias =>
(AccountAlias -> AccountAlias -> Ordering)
-> (AccountAlias -> AccountAlias -> Bool)
-> (AccountAlias -> AccountAlias -> Bool)
-> (AccountAlias -> AccountAlias -> Bool)
-> (AccountAlias -> AccountAlias -> Bool)
-> (AccountAlias -> AccountAlias -> AccountAlias)
-> (AccountAlias -> AccountAlias -> AccountAlias)
-> Ord AccountAlias
AccountAlias -> AccountAlias -> Bool
AccountAlias -> AccountAlias -> Ordering
AccountAlias -> AccountAlias -> AccountAlias
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AccountAlias -> AccountAlias -> Ordering
compare :: AccountAlias -> AccountAlias -> Ordering
$c< :: AccountAlias -> AccountAlias -> Bool
< :: AccountAlias -> AccountAlias -> Bool
$c<= :: AccountAlias -> AccountAlias -> Bool
<= :: AccountAlias -> AccountAlias -> Bool
$c> :: AccountAlias -> AccountAlias -> Bool
> :: AccountAlias -> AccountAlias -> Bool
$c>= :: AccountAlias -> AccountAlias -> Bool
>= :: AccountAlias -> AccountAlias -> Bool
$cmax :: AccountAlias -> AccountAlias -> AccountAlias
max :: AccountAlias -> AccountAlias -> AccountAlias
$cmin :: AccountAlias -> AccountAlias -> AccountAlias
min :: AccountAlias -> AccountAlias -> AccountAlias
Ord, (forall x. AccountAlias -> Rep AccountAlias x)
-> (forall x. Rep AccountAlias x -> AccountAlias)
-> Generic AccountAlias
forall x. Rep AccountAlias x -> AccountAlias
forall x. AccountAlias -> Rep AccountAlias x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccountAlias -> Rep AccountAlias x
from :: forall x. AccountAlias -> Rep AccountAlias x
$cto :: forall x. Rep AccountAlias x -> AccountAlias
to :: forall x. Rep AccountAlias x -> AccountAlias
Generic)

data Side = L | R deriving (Side -> Side -> Bool
(Side -> Side -> Bool) -> (Side -> Side -> Bool) -> Eq Side
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Side -> Side -> Bool
== :: Side -> Side -> Bool
$c/= :: Side -> Side -> Bool
/= :: Side -> Side -> Bool
Eq,Int -> Side -> ShowS
[Side] -> ShowS
Side -> String
(Int -> Side -> ShowS)
-> (Side -> String) -> ([Side] -> ShowS) -> Show Side
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Side -> ShowS
showsPrec :: Int -> Side -> ShowS
$cshow :: Side -> String
show :: Side -> String
$cshowList :: [Side] -> ShowS
showList :: [Side] -> ShowS
Show,ReadPrec [Side]
ReadPrec Side
Int -> ReadS Side
ReadS [Side]
(Int -> ReadS Side)
-> ReadS [Side] -> ReadPrec Side -> ReadPrec [Side] -> Read Side
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Side
readsPrec :: Int -> ReadS Side
$creadList :: ReadS [Side]
readList :: ReadS [Side]
$creadPrec :: ReadPrec Side
readPrec :: ReadPrec Side
$creadListPrec :: ReadPrec [Side]
readListPrec :: ReadPrec [Side]
Read,Eq Side
Eq Side =>
(Side -> Side -> Ordering)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Bool)
-> (Side -> Side -> Side)
-> (Side -> Side -> Side)
-> Ord Side
Side -> Side -> Bool
Side -> Side -> Ordering
Side -> Side -> Side
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Side -> Side -> Ordering
compare :: Side -> Side -> Ordering
$c< :: Side -> Side -> Bool
< :: Side -> Side -> Bool
$c<= :: Side -> Side -> Bool
<= :: Side -> Side -> Bool
$c> :: Side -> Side -> Bool
> :: Side -> Side -> Bool
$c>= :: Side -> Side -> Bool
>= :: Side -> Side -> Bool
$cmax :: Side -> Side -> Side
max :: Side -> Side -> Side
$cmin :: Side -> Side -> Side
min :: Side -> Side -> Side
Ord,(forall x. Side -> Rep Side x)
-> (forall x. Rep Side x -> Side) -> Generic Side
forall x. Rep Side x -> Side
forall x. Side -> Rep Side x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Side -> Rep Side x
from :: forall x. Side -> Rep Side x
$cto :: forall x. Rep Side x -> Side
to :: forall x. Rep Side x -> Side
Generic)

-- | One of the decimal marks we support: either period or comma.
type DecimalMark = Char

isDecimalMark :: Char -> Bool
isDecimalMark :: Char -> Bool
isDecimalMark Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
','

-- | The basic numeric type used in amounts.
type Quantity = Decimal
-- The following is for hledger-web, and requires blaze-markup.
-- Doing it here avoids needing a matching flag on the hledger-web package.
instance ToMarkup Quantity
 where
   toMarkup :: Quantity -> Markup
toMarkup = String -> Markup
forall a. ToMarkup a => a -> Markup
toMarkup (String -> Markup) -> (Quantity -> String) -> Quantity -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Quantity -> String
forall a. Show a => a -> String
show
deriving instance Generic (DecimalRaw a)

-- | An amount's per-unit or total cost/selling price in another
-- commodity, as recorded in the journal entry eg with @ or @@.
-- "Cost", formerly AKA "transaction price". The amount is always positive.
data AmountCost = UnitCost !Amount | TotalCost !Amount
  deriving (AmountCost -> AmountCost -> Bool
(AmountCost -> AmountCost -> Bool)
-> (AmountCost -> AmountCost -> Bool) -> Eq AmountCost
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AmountCost -> AmountCost -> Bool
== :: AmountCost -> AmountCost -> Bool
$c/= :: AmountCost -> AmountCost -> Bool
/= :: AmountCost -> AmountCost -> Bool
Eq,Eq AmountCost
Eq AmountCost =>
(AmountCost -> AmountCost -> Ordering)
-> (AmountCost -> AmountCost -> Bool)
-> (AmountCost -> AmountCost -> Bool)
-> (AmountCost -> AmountCost -> Bool)
-> (AmountCost -> AmountCost -> Bool)
-> (AmountCost -> AmountCost -> AmountCost)
-> (AmountCost -> AmountCost -> AmountCost)
-> Ord AmountCost
AmountCost -> AmountCost -> Bool
AmountCost -> AmountCost -> Ordering
AmountCost -> AmountCost -> AmountCost
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AmountCost -> AmountCost -> Ordering
compare :: AmountCost -> AmountCost -> Ordering
$c< :: AmountCost -> AmountCost -> Bool
< :: AmountCost -> AmountCost -> Bool
$c<= :: AmountCost -> AmountCost -> Bool
<= :: AmountCost -> AmountCost -> Bool
$c> :: AmountCost -> AmountCost -> Bool
> :: AmountCost -> AmountCost -> Bool
$c>= :: AmountCost -> AmountCost -> Bool
>= :: AmountCost -> AmountCost -> Bool
$cmax :: AmountCost -> AmountCost -> AmountCost
max :: AmountCost -> AmountCost -> AmountCost
$cmin :: AmountCost -> AmountCost -> AmountCost
min :: AmountCost -> AmountCost -> AmountCost
Ord,(forall x. AmountCost -> Rep AmountCost x)
-> (forall x. Rep AmountCost x -> AmountCost) -> Generic AmountCost
forall x. Rep AmountCost x -> AmountCost
forall x. AmountCost -> Rep AmountCost x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AmountCost -> Rep AmountCost x
from :: forall x. AmountCost -> Rep AmountCost x
$cto :: forall x. Rep AmountCost x -> AmountCost
to :: forall x. Rep AmountCost x -> AmountCost
Generic,Int -> AmountCost -> ShowS
[AmountCost] -> ShowS
AmountCost -> String
(Int -> AmountCost -> ShowS)
-> (AmountCost -> String)
-> ([AmountCost] -> ShowS)
-> Show AmountCost
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AmountCost -> ShowS
showsPrec :: Int -> AmountCost -> ShowS
$cshow :: AmountCost -> String
show :: AmountCost -> String
$cshowList :: [AmountCost] -> ShowS
showList :: [AmountCost] -> ShowS
Show)

-- | Display styles for amounts - things which can be detected during parsing, such as
-- commodity side and spacing, digit group marks, decimal mark, number of decimal digits etc.
-- Every "Amount" has an AmountStyle.
-- After amounts are parsed from the input, for each "Commodity" a standard style is inferred
-- and then used when displaying amounts in that commodity.
-- Related to "AmountFormat" but higher level.
--
-- See also:
-- - hledger manual > Commodity styles
-- - hledger manual > Amounts
-- - hledger manual > Commodity display style
data AmountStyle = AmountStyle {
  AmountStyle -> Side
ascommodityside   :: !Side,                     -- ^ show the symbol on the left or the right ?
  AmountStyle -> Bool
ascommodityspaced :: !Bool,                     -- ^ show a space between symbol and quantity ?
  AmountStyle -> Maybe DigitGroupStyle
asdigitgroups     :: !(Maybe DigitGroupStyle),  -- ^ show the integer part with these digit group marks, or not
  AmountStyle -> Maybe Char
asdecimalmark     :: !(Maybe Char),             -- ^ show this character (should be . or ,) as decimal mark, or use the default (.)
  AmountStyle -> AmountPrecision
asprecision       :: !AmountPrecision,          -- ^ "display precision" - show this number of digits after the decimal point
  AmountStyle -> Rounding
asrounding        :: !Rounding                  -- ^ "rounding strategy" - kept here for convenience, for now:
                                                  --   when displaying an amount, it is ignored,
                                                  --   but when applying this style to another amount, it determines 
                                                  --   how hard we should try to adjust that amount's display precision.
} deriving (AmountStyle -> AmountStyle -> Bool
(AmountStyle -> AmountStyle -> Bool)
-> (AmountStyle -> AmountStyle -> Bool) -> Eq AmountStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AmountStyle -> AmountStyle -> Bool
== :: AmountStyle -> AmountStyle -> Bool
$c/= :: AmountStyle -> AmountStyle -> Bool
/= :: AmountStyle -> AmountStyle -> Bool
Eq,Eq AmountStyle
Eq AmountStyle =>
(AmountStyle -> AmountStyle -> Ordering)
-> (AmountStyle -> AmountStyle -> Bool)
-> (AmountStyle -> AmountStyle -> Bool)
-> (AmountStyle -> AmountStyle -> Bool)
-> (AmountStyle -> AmountStyle -> Bool)
-> (AmountStyle -> AmountStyle -> AmountStyle)
-> (AmountStyle -> AmountStyle -> AmountStyle)
-> Ord AmountStyle
AmountStyle -> AmountStyle -> Bool
AmountStyle -> AmountStyle -> Ordering
AmountStyle -> AmountStyle -> AmountStyle
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AmountStyle -> AmountStyle -> Ordering
compare :: AmountStyle -> AmountStyle -> Ordering
$c< :: AmountStyle -> AmountStyle -> Bool
< :: AmountStyle -> AmountStyle -> Bool
$c<= :: AmountStyle -> AmountStyle -> Bool
<= :: AmountStyle -> AmountStyle -> Bool
$c> :: AmountStyle -> AmountStyle -> Bool
> :: AmountStyle -> AmountStyle -> Bool
$c>= :: AmountStyle -> AmountStyle -> Bool
>= :: AmountStyle -> AmountStyle -> Bool
$cmax :: AmountStyle -> AmountStyle -> AmountStyle
max :: AmountStyle -> AmountStyle -> AmountStyle
$cmin :: AmountStyle -> AmountStyle -> AmountStyle
min :: AmountStyle -> AmountStyle -> AmountStyle
Ord,ReadPrec [AmountStyle]
ReadPrec AmountStyle
Int -> ReadS AmountStyle
ReadS [AmountStyle]
(Int -> ReadS AmountStyle)
-> ReadS [AmountStyle]
-> ReadPrec AmountStyle
-> ReadPrec [AmountStyle]
-> Read AmountStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AmountStyle
readsPrec :: Int -> ReadS AmountStyle
$creadList :: ReadS [AmountStyle]
readList :: ReadS [AmountStyle]
$creadPrec :: ReadPrec AmountStyle
readPrec :: ReadPrec AmountStyle
$creadListPrec :: ReadPrec [AmountStyle]
readListPrec :: ReadPrec [AmountStyle]
Read,(forall x. AmountStyle -> Rep AmountStyle x)
-> (forall x. Rep AmountStyle x -> AmountStyle)
-> Generic AmountStyle
forall x. Rep AmountStyle x -> AmountStyle
forall x. AmountStyle -> Rep AmountStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AmountStyle -> Rep AmountStyle x
from :: forall x. AmountStyle -> Rep AmountStyle x
$cto :: forall x. Rep AmountStyle x -> AmountStyle
to :: forall x. Rep AmountStyle x -> AmountStyle
Generic)

instance Show AmountStyle where
  show :: AmountStyle -> String
show AmountStyle{Bool
Maybe Char
Maybe DigitGroupStyle
Rounding
AmountPrecision
Side
ascommodityside :: AmountStyle -> Side
ascommodityspaced :: AmountStyle -> Bool
asdigitgroups :: AmountStyle -> Maybe DigitGroupStyle
asdecimalmark :: AmountStyle -> Maybe Char
asprecision :: AmountStyle -> AmountPrecision
asrounding :: AmountStyle -> Rounding
ascommodityside :: Side
ascommodityspaced :: Bool
asdigitgroups :: Maybe DigitGroupStyle
asdecimalmark :: Maybe Char
asprecision :: AmountPrecision
asrounding :: Rounding
..} = [String] -> String
unwords
    [ String
"AmountStylePP"
    , Side -> String
forall a. Show a => a -> String
show Side
ascommodityside
    , Bool -> String
forall a. Show a => a -> String
show Bool
ascommodityspaced
    , Maybe DigitGroupStyle -> String
forall a. Show a => a -> String
show Maybe DigitGroupStyle
asdigitgroups
    , Maybe Char -> String
forall a. Show a => a -> String
show Maybe Char
asdecimalmark
    , AmountPrecision -> String
forall a. Show a => a -> String
show AmountPrecision
asprecision
    , Rounding -> String
forall a. Show a => a -> String
show Rounding
asrounding
    ]

-- | The "display precision" for a hledger amount, by which we mean
-- the number of decimal digits to display to the right of the decimal mark.
data AmountPrecision =
    Precision !Word8    -- ^ show this many decimal digits (0..255)
  | NaturalPrecision    -- ^ show all significant decimal digits stored internally
  deriving (AmountPrecision -> AmountPrecision -> Bool
(AmountPrecision -> AmountPrecision -> Bool)
-> (AmountPrecision -> AmountPrecision -> Bool)
-> Eq AmountPrecision
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AmountPrecision -> AmountPrecision -> Bool
== :: AmountPrecision -> AmountPrecision -> Bool
$c/= :: AmountPrecision -> AmountPrecision -> Bool
/= :: AmountPrecision -> AmountPrecision -> Bool
Eq,Eq AmountPrecision
Eq AmountPrecision =>
(AmountPrecision -> AmountPrecision -> Ordering)
-> (AmountPrecision -> AmountPrecision -> Bool)
-> (AmountPrecision -> AmountPrecision -> Bool)
-> (AmountPrecision -> AmountPrecision -> Bool)
-> (AmountPrecision -> AmountPrecision -> Bool)
-> (AmountPrecision -> AmountPrecision -> AmountPrecision)
-> (AmountPrecision -> AmountPrecision -> AmountPrecision)
-> Ord AmountPrecision
AmountPrecision -> AmountPrecision -> Bool
AmountPrecision -> AmountPrecision -> Ordering
AmountPrecision -> AmountPrecision -> AmountPrecision
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AmountPrecision -> AmountPrecision -> Ordering
compare :: AmountPrecision -> AmountPrecision -> Ordering
$c< :: AmountPrecision -> AmountPrecision -> Bool
< :: AmountPrecision -> AmountPrecision -> Bool
$c<= :: AmountPrecision -> AmountPrecision -> Bool
<= :: AmountPrecision -> AmountPrecision -> Bool
$c> :: AmountPrecision -> AmountPrecision -> Bool
> :: AmountPrecision -> AmountPrecision -> Bool
$c>= :: AmountPrecision -> AmountPrecision -> Bool
>= :: AmountPrecision -> AmountPrecision -> Bool
$cmax :: AmountPrecision -> AmountPrecision -> AmountPrecision
max :: AmountPrecision -> AmountPrecision -> AmountPrecision
$cmin :: AmountPrecision -> AmountPrecision -> AmountPrecision
min :: AmountPrecision -> AmountPrecision -> AmountPrecision
Ord,ReadPrec [AmountPrecision]
ReadPrec AmountPrecision
Int -> ReadS AmountPrecision
ReadS [AmountPrecision]
(Int -> ReadS AmountPrecision)
-> ReadS [AmountPrecision]
-> ReadPrec AmountPrecision
-> ReadPrec [AmountPrecision]
-> Read AmountPrecision
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS AmountPrecision
readsPrec :: Int -> ReadS AmountPrecision
$creadList :: ReadS [AmountPrecision]
readList :: ReadS [AmountPrecision]
$creadPrec :: ReadPrec AmountPrecision
readPrec :: ReadPrec AmountPrecision
$creadListPrec :: ReadPrec [AmountPrecision]
readListPrec :: ReadPrec [AmountPrecision]
Read,Int -> AmountPrecision -> ShowS
[AmountPrecision] -> ShowS
AmountPrecision -> String
(Int -> AmountPrecision -> ShowS)
-> (AmountPrecision -> String)
-> ([AmountPrecision] -> ShowS)
-> Show AmountPrecision
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AmountPrecision -> ShowS
showsPrec :: Int -> AmountPrecision -> ShowS
$cshow :: AmountPrecision -> String
show :: AmountPrecision -> String
$cshowList :: [AmountPrecision] -> ShowS
showList :: [AmountPrecision] -> ShowS
Show,(forall x. AmountPrecision -> Rep AmountPrecision x)
-> (forall x. Rep AmountPrecision x -> AmountPrecision)
-> Generic AmountPrecision
forall x. Rep AmountPrecision x -> AmountPrecision
forall x. AmountPrecision -> Rep AmountPrecision x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AmountPrecision -> Rep AmountPrecision x
from :: forall x. AmountPrecision -> Rep AmountPrecision x
$cto :: forall x. Rep AmountPrecision x -> AmountPrecision
to :: forall x. Rep AmountPrecision x -> AmountPrecision
Generic)

-- | "Rounding strategy" - how to apply an AmountStyle's display precision
-- to a posting amount (and its cost, if any). 
-- Mainly used to customise print's output, with --round=none|soft|hard|all.
data Rounding =
    NoRounding    -- ^ keep display precisions unchanged in amt and cost
  | SoftRounding  -- ^ do soft rounding of amt and cost amounts (show more or fewer decimal zeros to approximate the target precision, but don't hide significant digits)
  | HardRounding  -- ^ do hard rounding of amt (use the exact target precision, possibly hiding significant digits), and soft rounding of cost
  | AllRounding   -- ^ do hard rounding of amt and cost
  deriving (Rounding -> Rounding -> Bool
(Rounding -> Rounding -> Bool)
-> (Rounding -> Rounding -> Bool) -> Eq Rounding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rounding -> Rounding -> Bool
== :: Rounding -> Rounding -> Bool
$c/= :: Rounding -> Rounding -> Bool
/= :: Rounding -> Rounding -> Bool
Eq,Eq Rounding
Eq Rounding =>
(Rounding -> Rounding -> Ordering)
-> (Rounding -> Rounding -> Bool)
-> (Rounding -> Rounding -> Bool)
-> (Rounding -> Rounding -> Bool)
-> (Rounding -> Rounding -> Bool)
-> (Rounding -> Rounding -> Rounding)
-> (Rounding -> Rounding -> Rounding)
-> Ord Rounding
Rounding -> Rounding -> Bool
Rounding -> Rounding -> Ordering
Rounding -> Rounding -> Rounding
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Rounding -> Rounding -> Ordering
compare :: Rounding -> Rounding -> Ordering
$c< :: Rounding -> Rounding -> Bool
< :: Rounding -> Rounding -> Bool
$c<= :: Rounding -> Rounding -> Bool
<= :: Rounding -> Rounding -> Bool
$c> :: Rounding -> Rounding -> Bool
> :: Rounding -> Rounding -> Bool
$c>= :: Rounding -> Rounding -> Bool
>= :: Rounding -> Rounding -> Bool
$cmax :: Rounding -> Rounding -> Rounding
max :: Rounding -> Rounding -> Rounding
$cmin :: Rounding -> Rounding -> Rounding
min :: Rounding -> Rounding -> Rounding
Ord,ReadPrec [Rounding]
ReadPrec Rounding
Int -> ReadS Rounding
ReadS [Rounding]
(Int -> ReadS Rounding)
-> ReadS [Rounding]
-> ReadPrec Rounding
-> ReadPrec [Rounding]
-> Read Rounding
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Rounding
readsPrec :: Int -> ReadS Rounding
$creadList :: ReadS [Rounding]
readList :: ReadS [Rounding]
$creadPrec :: ReadPrec Rounding
readPrec :: ReadPrec Rounding
$creadListPrec :: ReadPrec [Rounding]
readListPrec :: ReadPrec [Rounding]
Read,Int -> Rounding -> ShowS
[Rounding] -> ShowS
Rounding -> String
(Int -> Rounding -> ShowS)
-> (Rounding -> String) -> ([Rounding] -> ShowS) -> Show Rounding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rounding -> ShowS
showsPrec :: Int -> Rounding -> ShowS
$cshow :: Rounding -> String
show :: Rounding -> String
$cshowList :: [Rounding] -> ShowS
showList :: [Rounding] -> ShowS
Show,(forall x. Rounding -> Rep Rounding x)
-> (forall x. Rep Rounding x -> Rounding) -> Generic Rounding
forall x. Rep Rounding x -> Rounding
forall x. Rounding -> Rep Rounding x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Rounding -> Rep Rounding x
from :: forall x. Rounding -> Rep Rounding x
$cto :: forall x. Rep Rounding x -> Rounding
to :: forall x. Rep Rounding x -> Rounding
Generic)

-- | A style for displaying digit groups in the integer part of a
-- floating point number. It consists of the character used to
-- separate groups (comma or period, whichever is not used as decimal
-- point), and the size of each group, starting with the one nearest
-- the decimal point. The last group size is assumed to repeat. Eg,
-- comma between thousands is DigitGroups ',' [3].
data DigitGroupStyle = DigitGroups !Char ![Word8]
  deriving (DigitGroupStyle -> DigitGroupStyle -> Bool
(DigitGroupStyle -> DigitGroupStyle -> Bool)
-> (DigitGroupStyle -> DigitGroupStyle -> Bool)
-> Eq DigitGroupStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DigitGroupStyle -> DigitGroupStyle -> Bool
== :: DigitGroupStyle -> DigitGroupStyle -> Bool
$c/= :: DigitGroupStyle -> DigitGroupStyle -> Bool
/= :: DigitGroupStyle -> DigitGroupStyle -> Bool
Eq,Eq DigitGroupStyle
Eq DigitGroupStyle =>
(DigitGroupStyle -> DigitGroupStyle -> Ordering)
-> (DigitGroupStyle -> DigitGroupStyle -> Bool)
-> (DigitGroupStyle -> DigitGroupStyle -> Bool)
-> (DigitGroupStyle -> DigitGroupStyle -> Bool)
-> (DigitGroupStyle -> DigitGroupStyle -> Bool)
-> (DigitGroupStyle -> DigitGroupStyle -> DigitGroupStyle)
-> (DigitGroupStyle -> DigitGroupStyle -> DigitGroupStyle)
-> Ord DigitGroupStyle
DigitGroupStyle -> DigitGroupStyle -> Bool
DigitGroupStyle -> DigitGroupStyle -> Ordering
DigitGroupStyle -> DigitGroupStyle -> DigitGroupStyle
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DigitGroupStyle -> DigitGroupStyle -> Ordering
compare :: DigitGroupStyle -> DigitGroupStyle -> Ordering
$c< :: DigitGroupStyle -> DigitGroupStyle -> Bool
< :: DigitGroupStyle -> DigitGroupStyle -> Bool
$c<= :: DigitGroupStyle -> DigitGroupStyle -> Bool
<= :: DigitGroupStyle -> DigitGroupStyle -> Bool
$c> :: DigitGroupStyle -> DigitGroupStyle -> Bool
> :: DigitGroupStyle -> DigitGroupStyle -> Bool
$c>= :: DigitGroupStyle -> DigitGroupStyle -> Bool
>= :: DigitGroupStyle -> DigitGroupStyle -> Bool
$cmax :: DigitGroupStyle -> DigitGroupStyle -> DigitGroupStyle
max :: DigitGroupStyle -> DigitGroupStyle -> DigitGroupStyle
$cmin :: DigitGroupStyle -> DigitGroupStyle -> DigitGroupStyle
min :: DigitGroupStyle -> DigitGroupStyle -> DigitGroupStyle
Ord,ReadPrec [DigitGroupStyle]
ReadPrec DigitGroupStyle
Int -> ReadS DigitGroupStyle
ReadS [DigitGroupStyle]
(Int -> ReadS DigitGroupStyle)
-> ReadS [DigitGroupStyle]
-> ReadPrec DigitGroupStyle
-> ReadPrec [DigitGroupStyle]
-> Read DigitGroupStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DigitGroupStyle
readsPrec :: Int -> ReadS DigitGroupStyle
$creadList :: ReadS [DigitGroupStyle]
readList :: ReadS [DigitGroupStyle]
$creadPrec :: ReadPrec DigitGroupStyle
readPrec :: ReadPrec DigitGroupStyle
$creadListPrec :: ReadPrec [DigitGroupStyle]
readListPrec :: ReadPrec [DigitGroupStyle]
Read,Int -> DigitGroupStyle -> ShowS
[DigitGroupStyle] -> ShowS
DigitGroupStyle -> String
(Int -> DigitGroupStyle -> ShowS)
-> (DigitGroupStyle -> String)
-> ([DigitGroupStyle] -> ShowS)
-> Show DigitGroupStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DigitGroupStyle -> ShowS
showsPrec :: Int -> DigitGroupStyle -> ShowS
$cshow :: DigitGroupStyle -> String
show :: DigitGroupStyle -> String
$cshowList :: [DigitGroupStyle] -> ShowS
showList :: [DigitGroupStyle] -> ShowS
Show,(forall x. DigitGroupStyle -> Rep DigitGroupStyle x)
-> (forall x. Rep DigitGroupStyle x -> DigitGroupStyle)
-> Generic DigitGroupStyle
forall x. Rep DigitGroupStyle x -> DigitGroupStyle
forall x. DigitGroupStyle -> Rep DigitGroupStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DigitGroupStyle -> Rep DigitGroupStyle x
from :: forall x. DigitGroupStyle -> Rep DigitGroupStyle x
$cto :: forall x. Rep DigitGroupStyle x -> DigitGroupStyle
to :: forall x. Rep DigitGroupStyle x -> DigitGroupStyle
Generic)

type CommoditySymbol = Text

data Commodity = Commodity {
  Commodity -> AccountName
csymbol :: CommoditySymbol,
  Commodity -> Maybe AmountStyle
cformat :: Maybe AmountStyle
  } deriving (Int -> Commodity -> ShowS
[Commodity] -> ShowS
Commodity -> String
(Int -> Commodity -> ShowS)
-> (Commodity -> String)
-> ([Commodity] -> ShowS)
-> Show Commodity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Commodity -> ShowS
showsPrec :: Int -> Commodity -> ShowS
$cshow :: Commodity -> String
show :: Commodity -> String
$cshowList :: [Commodity] -> ShowS
showList :: [Commodity] -> ShowS
Show,Commodity -> Commodity -> Bool
(Commodity -> Commodity -> Bool)
-> (Commodity -> Commodity -> Bool) -> Eq Commodity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Commodity -> Commodity -> Bool
== :: Commodity -> Commodity -> Bool
$c/= :: Commodity -> Commodity -> Bool
/= :: Commodity -> Commodity -> Bool
Eq,(forall x. Commodity -> Rep Commodity x)
-> (forall x. Rep Commodity x -> Commodity) -> Generic Commodity
forall x. Rep Commodity x -> Commodity
forall x. Commodity -> Rep Commodity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Commodity -> Rep Commodity x
from :: forall x. Commodity -> Rep Commodity x
$cto :: forall x. Rep Commodity x -> Commodity
to :: forall x. Rep Commodity x -> Commodity
Generic) --,Ord)

data Amount = Amount {
      Amount -> AccountName
acommodity  :: !CommoditySymbol,     -- commodity symbol, or special value "AUTO"
      Amount -> Quantity
aquantity   :: !Quantity,            -- numeric quantity, or zero in case of "AUTO"
      Amount -> AmountStyle
astyle      :: !AmountStyle,
      Amount -> Maybe AmountCost
acost       :: !(Maybe AmountCost)  -- ^ the (fixed, transaction-specific) cost in another commodity of this amount, if any
    } deriving (Amount -> Amount -> Bool
(Amount -> Amount -> Bool)
-> (Amount -> Amount -> Bool) -> Eq Amount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Amount -> Amount -> Bool
== :: Amount -> Amount -> Bool
$c/= :: Amount -> Amount -> Bool
/= :: Amount -> Amount -> Bool
Eq,Eq Amount
Eq Amount =>
(Amount -> Amount -> Ordering)
-> (Amount -> Amount -> Bool)
-> (Amount -> Amount -> Bool)
-> (Amount -> Amount -> Bool)
-> (Amount -> Amount -> Bool)
-> (Amount -> Amount -> Amount)
-> (Amount -> Amount -> Amount)
-> Ord Amount
Amount -> Amount -> Bool
Amount -> Amount -> Ordering
Amount -> Amount -> Amount
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Amount -> Amount -> Ordering
compare :: Amount -> Amount -> Ordering
$c< :: Amount -> Amount -> Bool
< :: Amount -> Amount -> Bool
$c<= :: Amount -> Amount -> Bool
<= :: Amount -> Amount -> Bool
$c> :: Amount -> Amount -> Bool
> :: Amount -> Amount -> Bool
$c>= :: Amount -> Amount -> Bool
>= :: Amount -> Amount -> Bool
$cmax :: Amount -> Amount -> Amount
max :: Amount -> Amount -> Amount
$cmin :: Amount -> Amount -> Amount
min :: Amount -> Amount -> Amount
Ord,(forall x. Amount -> Rep Amount x)
-> (forall x. Rep Amount x -> Amount) -> Generic Amount
forall x. Rep Amount x -> Amount
forall x. Amount -> Rep Amount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Amount -> Rep Amount x
from :: forall x. Amount -> Rep Amount x
$cto :: forall x. Rep Amount x -> Amount
to :: forall x. Rep Amount x -> Amount
Generic,Int -> Amount -> ShowS
[Amount] -> ShowS
Amount -> String
(Int -> Amount -> ShowS)
-> (Amount -> String) -> ([Amount] -> ShowS) -> Show Amount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Amount -> ShowS
showsPrec :: Int -> Amount -> ShowS
$cshow :: Amount -> String
show :: Amount -> String
$cshowList :: [Amount] -> ShowS
showList :: [Amount] -> ShowS
Show)

-- | Types with this class have one or more amounts,
-- which can have display styles applied to them.
class HasAmounts a where
  styleAmounts :: M.Map CommoditySymbol AmountStyle -> a -> a

instance HasAmounts a =>
  HasAmounts [a]
  where styleAmounts :: Map AccountName AmountStyle -> [a] -> [a]
styleAmounts Map AccountName AmountStyle
styles = (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Map AccountName AmountStyle -> a -> a
forall a. HasAmounts a => Map AccountName AmountStyle -> a -> a
styleAmounts Map AccountName AmountStyle
styles)

instance (HasAmounts a, HasAmounts b) =>
  HasAmounts (a,b)
  where styleAmounts :: Map AccountName AmountStyle -> (a, b) -> (a, b)
styleAmounts Map AccountName AmountStyle
styles (a
aa,b
bb) = (Map AccountName AmountStyle -> a -> a
forall a. HasAmounts a => Map AccountName AmountStyle -> a -> a
styleAmounts Map AccountName AmountStyle
styles a
aa, Map AccountName AmountStyle -> b -> b
forall a. HasAmounts a => Map AccountName AmountStyle -> a -> a
styleAmounts Map AccountName AmountStyle
styles b
bb)

instance HasAmounts a =>
  HasAmounts (Maybe a)
  where styleAmounts :: Map AccountName AmountStyle -> Maybe a -> Maybe a
styleAmounts Map AccountName AmountStyle
styles = (a -> a) -> Maybe a -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map AccountName AmountStyle -> a -> a
forall a. HasAmounts a => Map AccountName AmountStyle -> a -> a
styleAmounts Map AccountName AmountStyle
styles)


newtype MixedAmount = Mixed (M.Map MixedAmountKey Amount) deriving ((forall x. MixedAmount -> Rep MixedAmount x)
-> (forall x. Rep MixedAmount x -> MixedAmount)
-> Generic MixedAmount
forall x. Rep MixedAmount x -> MixedAmount
forall x. MixedAmount -> Rep MixedAmount x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MixedAmount -> Rep MixedAmount x
from :: forall x. MixedAmount -> Rep MixedAmount x
$cto :: forall x. Rep MixedAmount x -> MixedAmount
to :: forall x. Rep MixedAmount x -> MixedAmount
Generic,Int -> MixedAmount -> ShowS
[MixedAmount] -> ShowS
MixedAmount -> String
(Int -> MixedAmount -> ShowS)
-> (MixedAmount -> String)
-> ([MixedAmount] -> ShowS)
-> Show MixedAmount
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MixedAmount -> ShowS
showsPrec :: Int -> MixedAmount -> ShowS
$cshow :: MixedAmount -> String
show :: MixedAmount -> String
$cshowList :: [MixedAmount] -> ShowS
showList :: [MixedAmount] -> ShowS
Show)

instance Eq  MixedAmount where MixedAmount
a == :: MixedAmount -> MixedAmount -> Bool
== MixedAmount
b  = MixedAmount -> MixedAmount -> Ordering
maCompare MixedAmount
a MixedAmount
b Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
instance Ord MixedAmount where compare :: MixedAmount -> MixedAmount -> Ordering
compare = MixedAmount -> MixedAmount -> Ordering
maCompare

-- | Compare two MixedAmounts, substituting 0 for the quantity of any missing
-- commodities in either.
maCompare :: MixedAmount -> MixedAmount -> Ordering
maCompare :: MixedAmount -> MixedAmount -> Ordering
maCompare (Mixed Map MixedAmountKey Amount
a) (Mixed Map MixedAmountKey Amount
b) = [(MixedAmountKey, Amount)]
-> [(MixedAmountKey, Amount)] -> Ordering
forall {a}. Ord a => [(a, Amount)] -> [(a, Amount)] -> Ordering
go (Map MixedAmountKey Amount -> [(MixedAmountKey, Amount)]
forall k a. Map k a -> [(k, a)]
M.toList Map MixedAmountKey Amount
a) (Map MixedAmountKey Amount -> [(MixedAmountKey, Amount)]
forall k a. Map k a -> [(k, a)]
M.toList Map MixedAmountKey Amount
b)
  where
    go :: [(a, Amount)] -> [(a, Amount)] -> Ordering
go xss :: [(a, Amount)]
xss@((a
kx,Amount
x):[(a, Amount)]
xs) yss :: [(a, Amount)]
yss@((a
ky,Amount
y):[(a, Amount)]
ys) = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
kx a
ky of
                 Ordering
EQ -> Maybe Amount -> Maybe Amount -> Ordering
compareQuantities (Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
x) (Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
y) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [(a, Amount)] -> [(a, Amount)] -> Ordering
go [(a, Amount)]
xs [(a, Amount)]
ys
                 Ordering
LT -> Maybe Amount -> Maybe Amount -> Ordering
compareQuantities (Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
x) Maybe Amount
forall a. Maybe a
Nothing  Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [(a, Amount)] -> [(a, Amount)] -> Ordering
go [(a, Amount)]
xs [(a, Amount)]
yss
                 Ordering
GT -> Maybe Amount -> Maybe Amount -> Ordering
compareQuantities Maybe Amount
forall a. Maybe a
Nothing  (Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
y) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [(a, Amount)] -> [(a, Amount)] -> Ordering
go [(a, Amount)]
xss [(a, Amount)]
ys
    go ((a
_,Amount
x):[(a, Amount)]
xs) [] = Maybe Amount -> Maybe Amount -> Ordering
compareQuantities (Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
x) Maybe Amount
forall a. Maybe a
Nothing  Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [(a, Amount)] -> [(a, Amount)] -> Ordering
go [(a, Amount)]
xs []
    go [] ((a
_,Amount
y):[(a, Amount)]
ys) = Maybe Amount -> Maybe Amount -> Ordering
compareQuantities Maybe Amount
forall a. Maybe a
Nothing  (Amount -> Maybe Amount
forall a. a -> Maybe a
Just Amount
y) Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> [(a, Amount)] -> [(a, Amount)] -> Ordering
go [] [(a, Amount)]
ys
    go []         [] = Ordering
EQ
    compareQuantities :: Maybe Amount -> Maybe Amount -> Ordering
compareQuantities = (Maybe Amount -> Quantity)
-> Maybe Amount -> Maybe Amount -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Quantity -> (Amount -> Quantity) -> Maybe Amount -> Quantity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Quantity
0 Amount -> Quantity
aquantity) (Maybe Amount -> Maybe Amount -> Ordering)
-> (Maybe Amount -> Maybe Amount -> Ordering)
-> Maybe Amount
-> Maybe Amount
-> Ordering
forall a. Semigroup a => a -> a -> a
<> (Maybe Amount -> Quantity)
-> Maybe Amount -> Maybe Amount -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Quantity -> (Amount -> Quantity) -> Maybe Amount -> Quantity
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Quantity
0 Amount -> Quantity
totalcost)
    totalcost :: Amount -> Quantity
totalcost Amount
x = case Amount -> Maybe AmountCost
acost Amount
x of
                        Just (TotalCost Amount
p) -> Amount -> Quantity
aquantity Amount
p
                        Maybe AmountCost
_                   -> Quantity
0

-- | Stores the CommoditySymbol of the Amount, along with the CommoditySymbol of
-- the cost, and its unit cost if being used.
data MixedAmountKey
  = MixedAmountKeyNoCost   !CommoditySymbol
  | MixedAmountKeyTotalCost !CommoditySymbol !CommoditySymbol
  | MixedAmountKeyUnitCost  !CommoditySymbol !CommoditySymbol !Quantity
  deriving (MixedAmountKey -> MixedAmountKey -> Bool
(MixedAmountKey -> MixedAmountKey -> Bool)
-> (MixedAmountKey -> MixedAmountKey -> Bool) -> Eq MixedAmountKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MixedAmountKey -> MixedAmountKey -> Bool
== :: MixedAmountKey -> MixedAmountKey -> Bool
$c/= :: MixedAmountKey -> MixedAmountKey -> Bool
/= :: MixedAmountKey -> MixedAmountKey -> Bool
Eq,(forall x. MixedAmountKey -> Rep MixedAmountKey x)
-> (forall x. Rep MixedAmountKey x -> MixedAmountKey)
-> Generic MixedAmountKey
forall x. Rep MixedAmountKey x -> MixedAmountKey
forall x. MixedAmountKey -> Rep MixedAmountKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MixedAmountKey -> Rep MixedAmountKey x
from :: forall x. MixedAmountKey -> Rep MixedAmountKey x
$cto :: forall x. Rep MixedAmountKey x -> MixedAmountKey
to :: forall x. Rep MixedAmountKey x -> MixedAmountKey
Generic,Int -> MixedAmountKey -> ShowS
[MixedAmountKey] -> ShowS
MixedAmountKey -> String
(Int -> MixedAmountKey -> ShowS)
-> (MixedAmountKey -> String)
-> ([MixedAmountKey] -> ShowS)
-> Show MixedAmountKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MixedAmountKey -> ShowS
showsPrec :: Int -> MixedAmountKey -> ShowS
$cshow :: MixedAmountKey -> String
show :: MixedAmountKey -> String
$cshowList :: [MixedAmountKey] -> ShowS
showList :: [MixedAmountKey] -> ShowS
Show)

-- | We don't auto-derive the Ord instance because it would give an undesired ordering.
-- We want the keys to be sorted lexicographically:
-- (1) By the primary commodity of the amount.
-- (2) By the commodity of the cost, with no cost being first.
-- (3) By the unit cost, from most negative to most positive, with total costs
-- before unit costs.
-- For example, we would like the ordering to give
-- MixedAmountKeyNoCost "X" < MixedAmountKeyTotalCost "X" "Z" < MixedAmountKeyNoCost "Y"
instance Ord MixedAmountKey where
  compare :: MixedAmountKey -> MixedAmountKey -> Ordering
compare = (MixedAmountKey -> AccountName)
-> MixedAmountKey -> MixedAmountKey -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing MixedAmountKey -> AccountName
commodity (MixedAmountKey -> MixedAmountKey -> Ordering)
-> (MixedAmountKey -> MixedAmountKey -> Ordering)
-> MixedAmountKey
-> MixedAmountKey
-> Ordering
forall a. Semigroup a => a -> a -> a
<> (MixedAmountKey -> Maybe AccountName)
-> MixedAmountKey -> MixedAmountKey -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing MixedAmountKey -> Maybe AccountName
pCommodity (MixedAmountKey -> MixedAmountKey -> Ordering)
-> (MixedAmountKey -> MixedAmountKey -> Ordering)
-> MixedAmountKey
-> MixedAmountKey
-> Ordering
forall a. Semigroup a => a -> a -> a
<> (MixedAmountKey -> Maybe Quantity)
-> MixedAmountKey -> MixedAmountKey -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing MixedAmountKey -> Maybe Quantity
pCost
    where
      commodity :: MixedAmountKey -> AccountName
commodity (MixedAmountKeyNoCost    AccountName
c)     = AccountName
c
      commodity (MixedAmountKeyTotalCost AccountName
c AccountName
_)   = AccountName
c
      commodity (MixedAmountKeyUnitCost  AccountName
c AccountName
_ Quantity
_) = AccountName
c

      pCommodity :: MixedAmountKey -> Maybe AccountName
pCommodity (MixedAmountKeyNoCost    AccountName
_)      = Maybe AccountName
forall a. Maybe a
Nothing
      pCommodity (MixedAmountKeyTotalCost AccountName
_ AccountName
pc)   = AccountName -> Maybe AccountName
forall a. a -> Maybe a
Just AccountName
pc
      pCommodity (MixedAmountKeyUnitCost  AccountName
_ AccountName
pc Quantity
_) = AccountName -> Maybe AccountName
forall a. a -> Maybe a
Just AccountName
pc

      pCost :: MixedAmountKey -> Maybe Quantity
pCost (MixedAmountKeyNoCost    AccountName
_)     = Maybe Quantity
forall a. Maybe a
Nothing
      pCost (MixedAmountKeyTotalCost AccountName
_ AccountName
_)   = Maybe Quantity
forall a. Maybe a
Nothing
      pCost (MixedAmountKeyUnitCost  AccountName
_ AccountName
_ Quantity
q) = Quantity -> Maybe Quantity
forall a. a -> Maybe a
Just Quantity
q

data PostingType = RegularPosting | VirtualPosting | BalancedVirtualPosting
                   deriving (PostingType -> PostingType -> Bool
(PostingType -> PostingType -> Bool)
-> (PostingType -> PostingType -> Bool) -> Eq PostingType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PostingType -> PostingType -> Bool
== :: PostingType -> PostingType -> Bool
$c/= :: PostingType -> PostingType -> Bool
/= :: PostingType -> PostingType -> Bool
Eq,Int -> PostingType -> ShowS
[PostingType] -> ShowS
PostingType -> String
(Int -> PostingType -> ShowS)
-> (PostingType -> String)
-> ([PostingType] -> ShowS)
-> Show PostingType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PostingType -> ShowS
showsPrec :: Int -> PostingType -> ShowS
$cshow :: PostingType -> String
show :: PostingType -> String
$cshowList :: [PostingType] -> ShowS
showList :: [PostingType] -> ShowS
Show,(forall x. PostingType -> Rep PostingType x)
-> (forall x. Rep PostingType x -> PostingType)
-> Generic PostingType
forall x. Rep PostingType x -> PostingType
forall x. PostingType -> Rep PostingType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PostingType -> Rep PostingType x
from :: forall x. PostingType -> Rep PostingType x
$cto :: forall x. Rep PostingType x -> PostingType
to :: forall x. Rep PostingType x -> PostingType
Generic)

type TagName = Text
type TagValue = Text
type Tag = (TagName, TagValue)  -- ^ A tag name and (possibly empty) value.
type HiddenTag = Tag            -- ^ A tag whose name begins with _.
type DateTag = (TagName, Day)

-- | Add the _ prefix to a normal visible tag's name, making it a hidden tag.
toHiddenTag :: Tag -> HiddenTag
toHiddenTag :: Tag -> Tag
toHiddenTag = (AccountName -> AccountName) -> Tag -> Tag
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AccountName -> AccountName
toHiddenTagName

-- | Drop the _ prefix from a hidden tag's name, making it a normal visible tag.
toVisibleTag :: HiddenTag -> Tag
toVisibleTag :: Tag -> Tag
toVisibleTag = (AccountName -> AccountName) -> Tag -> Tag
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first AccountName -> AccountName
toVisibleTagName

-- | Does this tag name begin with the hidden tag prefix (_) ?
isHiddenTagName :: TagName -> Bool
isHiddenTagName :: AccountName -> Bool
isHiddenTagName AccountName
t =
  case AccountName -> Maybe (Char, AccountName)
T.uncons AccountName
t of
    Just (Char
'_',AccountName
_) -> Bool
True
    Maybe (Char, AccountName)
_ -> Bool
False

-- | Add the _ prefix to a normal visible tag's name, making it a hidden tag.
toHiddenTagName :: TagName -> TagName
toHiddenTagName :: AccountName -> AccountName
toHiddenTagName = Char -> AccountName -> AccountName
T.cons Char
'_'

-- | Drop the _ prefix from a hidden tag's name, making it a normal visible tag.
toVisibleTagName :: TagName -> TagName
toVisibleTagName :: AccountName -> AccountName
toVisibleTagName = Int -> AccountName -> AccountName
T.drop Int
1

-- | The status of a transaction or posting, recorded with a status mark
-- (nothing, !, or *). What these mean is ultimately user defined.
data Status = Unmarked | Pending | Cleared
  deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
/= :: Status -> Status -> Bool
Eq,Eq Status
Eq Status =>
(Status -> Status -> Ordering)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Bool)
-> (Status -> Status -> Status)
-> (Status -> Status -> Status)
-> Ord Status
Status -> Status -> Bool
Status -> Status -> Ordering
Status -> Status -> Status
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Status -> Status -> Ordering
compare :: Status -> Status -> Ordering
$c< :: Status -> Status -> Bool
< :: Status -> Status -> Bool
$c<= :: Status -> Status -> Bool
<= :: Status -> Status -> Bool
$c> :: Status -> Status -> Bool
> :: Status -> Status -> Bool
$c>= :: Status -> Status -> Bool
>= :: Status -> Status -> Bool
$cmax :: Status -> Status -> Status
max :: Status -> Status -> Status
$cmin :: Status -> Status -> Status
min :: Status -> Status -> Status
Ord,Status
Status -> Status -> Bounded Status
forall a. a -> a -> Bounded a
$cminBound :: Status
minBound :: Status
$cmaxBound :: Status
maxBound :: Status
Bounded,Int -> Status
Status -> Int
Status -> [Status]
Status -> Status
Status -> Status -> [Status]
Status -> Status -> Status -> [Status]
(Status -> Status)
-> (Status -> Status)
-> (Int -> Status)
-> (Status -> Int)
-> (Status -> [Status])
-> (Status -> Status -> [Status])
-> (Status -> Status -> [Status])
-> (Status -> Status -> Status -> [Status])
-> Enum Status
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Status -> Status
succ :: Status -> Status
$cpred :: Status -> Status
pred :: Status -> Status
$ctoEnum :: Int -> Status
toEnum :: Int -> Status
$cfromEnum :: Status -> Int
fromEnum :: Status -> Int
$cenumFrom :: Status -> [Status]
enumFrom :: Status -> [Status]
$cenumFromThen :: Status -> Status -> [Status]
enumFromThen :: Status -> Status -> [Status]
$cenumFromTo :: Status -> Status -> [Status]
enumFromTo :: Status -> Status -> [Status]
$cenumFromThenTo :: Status -> Status -> Status -> [Status]
enumFromThenTo :: Status -> Status -> Status -> [Status]
Enum,(forall x. Status -> Rep Status x)
-> (forall x. Rep Status x -> Status) -> Generic Status
forall x. Rep Status x -> Status
forall x. Status -> Rep Status x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Status -> Rep Status x
from :: forall x. Status -> Rep Status x
$cto :: forall x. Rep Status x -> Status
to :: forall x. Rep Status x -> Status
Generic)

instance Show Status where -- custom show.. bad idea.. don't do it..
  show :: Status -> String
show Status
Unmarked = String
""
  show Status
Pending   = String
"!"
  show Status
Cleared   = String
"*"

nullsourcepos :: SourcePos
nullsourcepos :: SourcePos
nullsourcepos = String -> Pos -> Pos -> SourcePos
SourcePos String
"" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1)

nullsourcepospair :: (SourcePos, SourcePos)
nullsourcepospair :: (SourcePos, SourcePos)
nullsourcepospair = (String -> Pos -> Pos -> SourcePos
SourcePos String
"" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1), String -> Pos -> Pos -> SourcePos
SourcePos String
"" (Int -> Pos
mkPos Int
2) (Int -> Pos
mkPos Int
1))

-- | A balance assertion is a declaration about an account's expected balance
-- at a certain point (posting date and parse order). They provide additional
-- error checking and readability to a journal file.
--
-- A balance assignments is an instruction to hledger to adjust an
-- account's balance to a certain amount at a certain point.
--
-- The 'BalanceAssertion' type is used for representing both of these.
--
-- hledger supports multiple kinds of balance assertions/assignments,
-- which differ in whether they refer to a single commodity or all commodities,
-- and the (subaccount-)inclusive or exclusive account balance.
--
data BalanceAssertion = BalanceAssertion {
      BalanceAssertion -> Amount
baamount    :: Amount,    -- ^ the expected balance in a particular commodity
      BalanceAssertion -> Bool
batotal     :: Bool,      -- ^ disallow additional non-asserted commodities ?
      BalanceAssertion -> Bool
bainclusive :: Bool,      -- ^ include subaccounts when calculating the actual balance ?
      BalanceAssertion -> SourcePos
baposition  :: SourcePos  -- ^ the assertion's file position, for error reporting
    } deriving (BalanceAssertion -> BalanceAssertion -> Bool
(BalanceAssertion -> BalanceAssertion -> Bool)
-> (BalanceAssertion -> BalanceAssertion -> Bool)
-> Eq BalanceAssertion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BalanceAssertion -> BalanceAssertion -> Bool
== :: BalanceAssertion -> BalanceAssertion -> Bool
$c/= :: BalanceAssertion -> BalanceAssertion -> Bool
/= :: BalanceAssertion -> BalanceAssertion -> Bool
Eq,(forall x. BalanceAssertion -> Rep BalanceAssertion x)
-> (forall x. Rep BalanceAssertion x -> BalanceAssertion)
-> Generic BalanceAssertion
forall x. Rep BalanceAssertion x -> BalanceAssertion
forall x. BalanceAssertion -> Rep BalanceAssertion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. BalanceAssertion -> Rep BalanceAssertion x
from :: forall x. BalanceAssertion -> Rep BalanceAssertion x
$cto :: forall x. Rep BalanceAssertion x -> BalanceAssertion
to :: forall x. Rep BalanceAssertion x -> BalanceAssertion
Generic,Int -> BalanceAssertion -> ShowS
[BalanceAssertion] -> ShowS
BalanceAssertion -> String
(Int -> BalanceAssertion -> ShowS)
-> (BalanceAssertion -> String)
-> ([BalanceAssertion] -> ShowS)
-> Show BalanceAssertion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BalanceAssertion -> ShowS
showsPrec :: Int -> BalanceAssertion -> ShowS
$cshow :: BalanceAssertion -> String
show :: BalanceAssertion -> String
$cshowList :: [BalanceAssertion] -> ShowS
showList :: [BalanceAssertion] -> ShowS
Show)

data Posting = Posting {
      Posting -> Maybe Day
pdate             :: Maybe Day,         -- ^ this posting's date, if different from the transaction's
      Posting -> Maybe Day
pdate2            :: Maybe Day,         -- ^ this posting's secondary date, if different from the transaction's
      Posting -> Status
pstatus           :: Status,
      Posting -> AccountName
paccount          :: AccountName,
      Posting -> MixedAmount
pamount           :: MixedAmount,
      Posting -> AccountName
pcomment          :: Text,              -- ^ this posting's comment lines, as a single non-indented multi-line string
      Posting -> PostingType
ptype             :: PostingType,
      Posting -> [Tag]
ptags             :: [Tag],                   -- ^ tag names and values, extracted from the posting comment 
                                                    --   and (after finalisation) the posting account's directive if any
      Posting -> Maybe BalanceAssertion
pbalanceassertion :: Maybe BalanceAssertion,  -- ^ an expected balance in the account after this posting,
                                                    --   in a single commodity, excluding subaccounts.
      Posting -> Maybe Transaction
ptransaction      :: Maybe Transaction,       -- ^ this posting's parent transaction (co-recursive types).
                                                    --   Tying this knot gets tedious, Maybe makes it easier/optional.
      Posting -> Maybe Posting
poriginal         :: Maybe Posting            -- ^ When this posting has been transformed in some way
                                                    --   (eg its amount or cost was inferred, or the account name was
                                                    --   changed by a pivot or budget report), this references the original
                                                    --   untransformed posting (which will have Nothing in this field).
    } deriving ((forall x. Posting -> Rep Posting x)
-> (forall x. Rep Posting x -> Posting) -> Generic Posting
forall x. Rep Posting x -> Posting
forall x. Posting -> Rep Posting x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Posting -> Rep Posting x
from :: forall x. Posting -> Rep Posting x
$cto :: forall x. Rep Posting x -> Posting
to :: forall x. Rep Posting x -> Posting
Generic)

-- The equality test for postings ignores the parent transaction's
-- identity, to avoid recurring ad infinitum.
-- XXX could check that it's Just or Nothing.
instance Eq Posting where
    == :: Posting -> Posting -> Bool
(==) (Posting Maybe Day
a1 Maybe Day
b1 Status
c1 AccountName
d1 MixedAmount
e1 AccountName
f1 PostingType
g1 [Tag]
h1 Maybe BalanceAssertion
i1 Maybe Transaction
_ Maybe Posting
_) (Posting Maybe Day
a2 Maybe Day
b2 Status
c2 AccountName
d2 MixedAmount
e2 AccountName
f2 PostingType
g2 [Tag]
h2 Maybe BalanceAssertion
i2 Maybe Transaction
_ Maybe Posting
_) =  Maybe Day
a1Maybe Day -> Maybe Day -> Bool
forall a. Eq a => a -> a -> Bool
==Maybe Day
a2 Bool -> Bool -> Bool
&& Maybe Day
b1Maybe Day -> Maybe Day -> Bool
forall a. Eq a => a -> a -> Bool
==Maybe Day
b2 Bool -> Bool -> Bool
&& Status
c1Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
==Status
c2 Bool -> Bool -> Bool
&& AccountName
d1AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
==AccountName
d2 Bool -> Bool -> Bool
&& MixedAmount
e1MixedAmount -> MixedAmount -> Bool
forall a. Eq a => a -> a -> Bool
==MixedAmount
e2 Bool -> Bool -> Bool
&& AccountName
f1AccountName -> AccountName -> Bool
forall a. Eq a => a -> a -> Bool
==AccountName
f2 Bool -> Bool -> Bool
&& PostingType
g1PostingType -> PostingType -> Bool
forall a. Eq a => a -> a -> Bool
==PostingType
g2 Bool -> Bool -> Bool
&& [Tag]
h1[Tag] -> [Tag] -> Bool
forall a. Eq a => a -> a -> Bool
==[Tag]
h2 Bool -> Bool -> Bool
&& Maybe BalanceAssertion
i1Maybe BalanceAssertion -> Maybe BalanceAssertion -> Bool
forall a. Eq a => a -> a -> Bool
==Maybe BalanceAssertion
i2

-- | Posting's show instance elides the parent transaction so as not to recurse forever.
instance Show Posting where
  show :: Posting -> String
show Posting{[Tag]
Maybe Day
Maybe Transaction
Maybe Posting
Maybe BalanceAssertion
AccountName
Status
PostingType
MixedAmount
pdate :: Posting -> Maybe Day
pdate2 :: Posting -> Maybe Day
pstatus :: Posting -> Status
paccount :: Posting -> AccountName
pamount :: Posting -> MixedAmount
pcomment :: Posting -> AccountName
ptype :: Posting -> PostingType
ptags :: Posting -> [Tag]
pbalanceassertion :: Posting -> Maybe BalanceAssertion
ptransaction :: Posting -> Maybe Transaction
poriginal :: Posting -> Maybe Posting
pdate :: Maybe Day
pdate2 :: Maybe Day
pstatus :: Status
paccount :: AccountName
pamount :: MixedAmount
pcomment :: AccountName
ptype :: PostingType
ptags :: [Tag]
pbalanceassertion :: Maybe BalanceAssertion
ptransaction :: Maybe Transaction
poriginal :: Maybe Posting
..} = String
"PostingPP {" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [
     String
"pdate="             String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (Maybe Day -> String
forall a. Show a => a -> String
show Maybe Day
pdate)
    ,String
"pdate2="            String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (Maybe Day -> String
forall a. Show a => a -> String
show Maybe Day
pdate2)
    ,String
"pstatus="           String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show (Status -> String
forall a. Show a => a -> String
show Status
pstatus)
    ,String
"paccount="          String -> ShowS
forall a. [a] -> [a] -> [a]
++ AccountName -> String
forall a. Show a => a -> String
show AccountName
paccount
    ,String
"pamount="           String -> ShowS
forall a. [a] -> [a] -> [a]
++ MixedAmount -> String
forall a. Show a => a -> String
show MixedAmount
pamount
    ,String
"pcomment="          String -> ShowS
forall a. [a] -> [a] -> [a]
++ AccountName -> String
forall a. Show a => a -> String
show AccountName
pcomment
    ,String
"ptype="             String -> ShowS
forall a. [a] -> [a] -> [a]
++ PostingType -> String
forall a. Show a => a -> String
show PostingType
ptype
    ,String
"ptags="             String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Tag] -> String
forall a. Show a => a -> String
show [Tag]
ptags
    ,String
"pbalanceassertion=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe BalanceAssertion -> String
forall a. Show a => a -> String
show Maybe BalanceAssertion
pbalanceassertion
    ,String
"ptransaction="      String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe String -> String
forall a. Show a => a -> String
show (Maybe Transaction
ptransaction Maybe Transaction -> String -> Maybe String
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> String
"txn")
    ,String
"poriginal="         String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe Posting -> String
forall a. Show a => a -> String
show Maybe Posting
poriginal
    ] String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"}"

data Transaction = Transaction {
      Transaction -> Year
tindex                   :: Integer,   -- ^ this transaction's 1-based position in the transaction stream, or 0 when not available
      Transaction -> AccountName
tprecedingcomment        :: Text,      -- ^ any comment lines immediately preceding this transaction
      Transaction -> (SourcePos, SourcePos)
tsourcepos               :: (SourcePos, SourcePos),  -- ^ the file position where the date starts, and where the last posting ends
      Transaction -> Day
tdate                    :: Day,
      Transaction -> Maybe Day
tdate2                   :: Maybe Day,
      Transaction -> Status
tstatus                  :: Status,
      Transaction -> AccountName
tcode                    :: Text,
      Transaction -> AccountName
tdescription             :: Text,
      Transaction -> AccountName
tcomment                 :: Text,      -- ^ this transaction's comment lines, as a single non-indented multi-line string
      Transaction -> [Tag]
ttags                    :: [Tag],     -- ^ tag names and values, extracted from the comment
      Transaction -> [Posting]
tpostings                :: [Posting]  -- ^ this transaction's postings
    } deriving (Transaction -> Transaction -> Bool
(Transaction -> Transaction -> Bool)
-> (Transaction -> Transaction -> Bool) -> Eq Transaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Transaction -> Transaction -> Bool
== :: Transaction -> Transaction -> Bool
$c/= :: Transaction -> Transaction -> Bool
/= :: Transaction -> Transaction -> Bool
Eq,(forall x. Transaction -> Rep Transaction x)
-> (forall x. Rep Transaction x -> Transaction)
-> Generic Transaction
forall x. Rep Transaction x -> Transaction
forall x. Transaction -> Rep Transaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Transaction -> Rep Transaction x
from :: forall x. Transaction -> Rep Transaction x
$cto :: forall x. Rep Transaction x -> Transaction
to :: forall x. Rep Transaction x -> Transaction
Generic,Int -> Transaction -> ShowS
[Transaction] -> ShowS
Transaction -> String
(Int -> Transaction -> ShowS)
-> (Transaction -> String)
-> ([Transaction] -> ShowS)
-> Show Transaction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Transaction -> ShowS
showsPrec :: Int -> Transaction -> ShowS
$cshow :: Transaction -> String
show :: Transaction -> String
$cshowList :: [Transaction] -> ShowS
showList :: [Transaction] -> ShowS
Show)

-- | A transaction modifier rule. This has a query which matches postings
-- in the journal, and a list of transformations to apply to those
-- postings or their transactions. Currently there is one kind of transformation:
-- the TMPostingRule, which adds a posting ("auto posting") to the transaction,
-- optionally setting its amount to the matched posting's amount multiplied by a constant.
data TransactionModifier = TransactionModifier {
      TransactionModifier -> AccountName
tmquerytxt :: Text,
      TransactionModifier -> [TMPostingRule]
tmpostingrules :: [TMPostingRule]
    } deriving (TransactionModifier -> TransactionModifier -> Bool
(TransactionModifier -> TransactionModifier -> Bool)
-> (TransactionModifier -> TransactionModifier -> Bool)
-> Eq TransactionModifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TransactionModifier -> TransactionModifier -> Bool
== :: TransactionModifier -> TransactionModifier -> Bool
$c/= :: TransactionModifier -> TransactionModifier -> Bool
/= :: TransactionModifier -> TransactionModifier -> Bool
Eq,(forall x. TransactionModifier -> Rep TransactionModifier x)
-> (forall x. Rep TransactionModifier x -> TransactionModifier)
-> Generic TransactionModifier
forall x. Rep TransactionModifier x -> TransactionModifier
forall x. TransactionModifier -> Rep TransactionModifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TransactionModifier -> Rep TransactionModifier x
from :: forall x. TransactionModifier -> Rep TransactionModifier x
$cto :: forall x. Rep TransactionModifier x -> TransactionModifier
to :: forall x. Rep TransactionModifier x -> TransactionModifier
Generic,Int -> TransactionModifier -> ShowS
[TransactionModifier] -> ShowS
TransactionModifier -> String
(Int -> TransactionModifier -> ShowS)
-> (TransactionModifier -> String)
-> ([TransactionModifier] -> ShowS)
-> Show TransactionModifier
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TransactionModifier -> ShowS
showsPrec :: Int -> TransactionModifier -> ShowS
$cshow :: TransactionModifier -> String
show :: TransactionModifier -> String
$cshowList :: [TransactionModifier] -> ShowS
showList :: [TransactionModifier] -> ShowS
Show)

nulltransactionmodifier :: TransactionModifier
nulltransactionmodifier = TransactionModifier{
  tmquerytxt :: AccountName
tmquerytxt = AccountName
""
 ,tmpostingrules :: [TMPostingRule]
tmpostingrules = []
}

-- | A transaction modifier transformation, which adds an extra posting
-- to the matched posting's transaction.
-- Can be like a regular posting, or can have the tmprIsMultiplier flag set,
-- indicating that it's a multiplier for the matched posting's amount.
data TMPostingRule = TMPostingRule
  { TMPostingRule -> Posting
tmprPosting :: Posting
  , TMPostingRule -> Bool
tmprIsMultiplier :: Bool
  } deriving (TMPostingRule -> TMPostingRule -> Bool
(TMPostingRule -> TMPostingRule -> Bool)
-> (TMPostingRule -> TMPostingRule -> Bool) -> Eq TMPostingRule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TMPostingRule -> TMPostingRule -> Bool
== :: TMPostingRule -> TMPostingRule -> Bool
$c/= :: TMPostingRule -> TMPostingRule -> Bool
/= :: TMPostingRule -> TMPostingRule -> Bool
Eq,(forall x. TMPostingRule -> Rep TMPostingRule x)
-> (forall x. Rep TMPostingRule x -> TMPostingRule)
-> Generic TMPostingRule
forall x. Rep TMPostingRule x -> TMPostingRule
forall x. TMPostingRule -> Rep TMPostingRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TMPostingRule -> Rep TMPostingRule x
from :: forall x. TMPostingRule -> Rep TMPostingRule x
$cto :: forall x. Rep TMPostingRule x -> TMPostingRule
to :: forall x. Rep TMPostingRule x -> TMPostingRule
Generic,Int -> TMPostingRule -> ShowS
[TMPostingRule] -> ShowS
TMPostingRule -> String
(Int -> TMPostingRule -> ShowS)
-> (TMPostingRule -> String)
-> ([TMPostingRule] -> ShowS)
-> Show TMPostingRule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TMPostingRule -> ShowS
showsPrec :: Int -> TMPostingRule -> ShowS
$cshow :: TMPostingRule -> String
show :: TMPostingRule -> String
$cshowList :: [TMPostingRule] -> ShowS
showList :: [TMPostingRule] -> ShowS
Show)

-- | A periodic transaction rule, describing a transaction that recurs.
data PeriodicTransaction = PeriodicTransaction {
      PeriodicTransaction -> AccountName
ptperiodexpr   :: Text,     -- ^ the period expression as written
      PeriodicTransaction -> Interval
ptinterval     :: Interval, -- ^ the interval at which this transaction recurs
      PeriodicTransaction -> DateSpan
ptspan         :: DateSpan, -- ^ the (possibly unbounded) period during which this transaction recurs. Contains a whole number of intervals.
      --
      PeriodicTransaction -> (SourcePos, SourcePos)
ptsourcepos    :: (SourcePos, SourcePos),  -- ^ the file position where the period expression starts, and where the last posting ends
      PeriodicTransaction -> Status
ptstatus       :: Status,   -- ^ some of Transaction's fields
      PeriodicTransaction -> AccountName
ptcode         :: Text,
      PeriodicTransaction -> AccountName
ptdescription  :: Text,
      PeriodicTransaction -> AccountName
ptcomment      :: Text,
      PeriodicTransaction -> [Tag]
pttags         :: [Tag],
      PeriodicTransaction -> [Posting]
ptpostings     :: [Posting]
    } deriving (PeriodicTransaction -> PeriodicTransaction -> Bool
(PeriodicTransaction -> PeriodicTransaction -> Bool)
-> (PeriodicTransaction -> PeriodicTransaction -> Bool)
-> Eq PeriodicTransaction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeriodicTransaction -> PeriodicTransaction -> Bool
== :: PeriodicTransaction -> PeriodicTransaction -> Bool
$c/= :: PeriodicTransaction -> PeriodicTransaction -> Bool
/= :: PeriodicTransaction -> PeriodicTransaction -> Bool
Eq,(forall x. PeriodicTransaction -> Rep PeriodicTransaction x)
-> (forall x. Rep PeriodicTransaction x -> PeriodicTransaction)
-> Generic PeriodicTransaction
forall x. Rep PeriodicTransaction x -> PeriodicTransaction
forall x. PeriodicTransaction -> Rep PeriodicTransaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PeriodicTransaction -> Rep PeriodicTransaction x
from :: forall x. PeriodicTransaction -> Rep PeriodicTransaction x
$cto :: forall x. Rep PeriodicTransaction x -> PeriodicTransaction
to :: forall x. Rep PeriodicTransaction x -> PeriodicTransaction
Generic) -- , Show in PeriodicTransaction.hs

nullperiodictransaction :: PeriodicTransaction
nullperiodictransaction = PeriodicTransaction{
      ptperiodexpr :: AccountName
ptperiodexpr   = AccountName
""
     ,ptinterval :: Interval
ptinterval     = Interval
forall a. Default a => a
def
     ,ptspan :: DateSpan
ptspan         = DateSpan
forall a. Default a => a
def
     ,ptsourcepos :: (SourcePos, SourcePos)
ptsourcepos    = (String -> Pos -> Pos -> SourcePos
SourcePos String
"" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1), String -> Pos -> Pos -> SourcePos
SourcePos String
"" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1))
     ,ptstatus :: Status
ptstatus       = Status
Unmarked
     ,ptcode :: AccountName
ptcode         = AccountName
""
     ,ptdescription :: AccountName
ptdescription  = AccountName
""
     ,ptcomment :: AccountName
ptcomment      = AccountName
""
     ,pttags :: [Tag]
pttags         = []
     ,ptpostings :: [Posting]
ptpostings     = []
}

data TimeclockCode = SetBalance | SetRequiredHours | In | Out | FinalOut deriving (TimeclockCode -> TimeclockCode -> Bool
(TimeclockCode -> TimeclockCode -> Bool)
-> (TimeclockCode -> TimeclockCode -> Bool) -> Eq TimeclockCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeclockCode -> TimeclockCode -> Bool
== :: TimeclockCode -> TimeclockCode -> Bool
$c/= :: TimeclockCode -> TimeclockCode -> Bool
/= :: TimeclockCode -> TimeclockCode -> Bool
Eq,Eq TimeclockCode
Eq TimeclockCode =>
(TimeclockCode -> TimeclockCode -> Ordering)
-> (TimeclockCode -> TimeclockCode -> Bool)
-> (TimeclockCode -> TimeclockCode -> Bool)
-> (TimeclockCode -> TimeclockCode -> Bool)
-> (TimeclockCode -> TimeclockCode -> Bool)
-> (TimeclockCode -> TimeclockCode -> TimeclockCode)
-> (TimeclockCode -> TimeclockCode -> TimeclockCode)
-> Ord TimeclockCode
TimeclockCode -> TimeclockCode -> Bool
TimeclockCode -> TimeclockCode -> Ordering
TimeclockCode -> TimeclockCode -> TimeclockCode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TimeclockCode -> TimeclockCode -> Ordering
compare :: TimeclockCode -> TimeclockCode -> Ordering
$c< :: TimeclockCode -> TimeclockCode -> Bool
< :: TimeclockCode -> TimeclockCode -> Bool
$c<= :: TimeclockCode -> TimeclockCode -> Bool
<= :: TimeclockCode -> TimeclockCode -> Bool
$c> :: TimeclockCode -> TimeclockCode -> Bool
> :: TimeclockCode -> TimeclockCode -> Bool
$c>= :: TimeclockCode -> TimeclockCode -> Bool
>= :: TimeclockCode -> TimeclockCode -> Bool
$cmax :: TimeclockCode -> TimeclockCode -> TimeclockCode
max :: TimeclockCode -> TimeclockCode -> TimeclockCode
$cmin :: TimeclockCode -> TimeclockCode -> TimeclockCode
min :: TimeclockCode -> TimeclockCode -> TimeclockCode
Ord,(forall x. TimeclockCode -> Rep TimeclockCode x)
-> (forall x. Rep TimeclockCode x -> TimeclockCode)
-> Generic TimeclockCode
forall x. Rep TimeclockCode x -> TimeclockCode
forall x. TimeclockCode -> Rep TimeclockCode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimeclockCode -> Rep TimeclockCode x
from :: forall x. TimeclockCode -> Rep TimeclockCode x
$cto :: forall x. Rep TimeclockCode x -> TimeclockCode
to :: forall x. Rep TimeclockCode x -> TimeclockCode
Generic)

data TimeclockEntry = TimeclockEntry {
      TimeclockEntry -> SourcePos
tlsourcepos   :: SourcePos,
      TimeclockEntry -> TimeclockCode
tlcode        :: TimeclockCode,
      TimeclockEntry -> LocalTime
tldatetime    :: LocalTime,
      TimeclockEntry -> AccountName
tlaccount     :: AccountName,
      TimeclockEntry -> AccountName
tldescription :: Text,
      TimeclockEntry -> AccountName
tlcomment     :: Text,
      TimeclockEntry -> [Tag]
tltags        :: [Tag]
    } deriving (TimeclockEntry -> TimeclockEntry -> Bool
(TimeclockEntry -> TimeclockEntry -> Bool)
-> (TimeclockEntry -> TimeclockEntry -> Bool) -> Eq TimeclockEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeclockEntry -> TimeclockEntry -> Bool
== :: TimeclockEntry -> TimeclockEntry -> Bool
$c/= :: TimeclockEntry -> TimeclockEntry -> Bool
/= :: TimeclockEntry -> TimeclockEntry -> Bool
Eq,Eq TimeclockEntry
Eq TimeclockEntry =>
(TimeclockEntry -> TimeclockEntry -> Ordering)
-> (TimeclockEntry -> TimeclockEntry -> Bool)
-> (TimeclockEntry -> TimeclockEntry -> Bool)
-> (TimeclockEntry -> TimeclockEntry -> Bool)
-> (TimeclockEntry -> TimeclockEntry -> Bool)
-> (TimeclockEntry -> TimeclockEntry -> TimeclockEntry)
-> (TimeclockEntry -> TimeclockEntry -> TimeclockEntry)
-> Ord TimeclockEntry
TimeclockEntry -> TimeclockEntry -> Bool
TimeclockEntry -> TimeclockEntry -> Ordering
TimeclockEntry -> TimeclockEntry -> TimeclockEntry
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TimeclockEntry -> TimeclockEntry -> Ordering
compare :: TimeclockEntry -> TimeclockEntry -> Ordering
$c< :: TimeclockEntry -> TimeclockEntry -> Bool
< :: TimeclockEntry -> TimeclockEntry -> Bool
$c<= :: TimeclockEntry -> TimeclockEntry -> Bool
<= :: TimeclockEntry -> TimeclockEntry -> Bool
$c> :: TimeclockEntry -> TimeclockEntry -> Bool
> :: TimeclockEntry -> TimeclockEntry -> Bool
$c>= :: TimeclockEntry -> TimeclockEntry -> Bool
>= :: TimeclockEntry -> TimeclockEntry -> Bool
$cmax :: TimeclockEntry -> TimeclockEntry -> TimeclockEntry
max :: TimeclockEntry -> TimeclockEntry -> TimeclockEntry
$cmin :: TimeclockEntry -> TimeclockEntry -> TimeclockEntry
min :: TimeclockEntry -> TimeclockEntry -> TimeclockEntry
Ord,(forall x. TimeclockEntry -> Rep TimeclockEntry x)
-> (forall x. Rep TimeclockEntry x -> TimeclockEntry)
-> Generic TimeclockEntry
forall x. Rep TimeclockEntry x -> TimeclockEntry
forall x. TimeclockEntry -> Rep TimeclockEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TimeclockEntry -> Rep TimeclockEntry x
from :: forall x. TimeclockEntry -> Rep TimeclockEntry x
$cto :: forall x. Rep TimeclockEntry x -> TimeclockEntry
to :: forall x. Rep TimeclockEntry x -> TimeclockEntry
Generic)

-- | A market price declaration made by the journal format's P directive.
-- It declares two things: a historical exchange rate between two commodities,
-- and an amount display style for the second commodity.
data PriceDirective = PriceDirective {
   PriceDirective -> SourcePos
pdsourcepos :: SourcePos
  ,PriceDirective -> Day
pddate      :: Day
  ,PriceDirective -> AccountName
pdcommodity :: CommoditySymbol
  ,PriceDirective -> Amount
pdamount    :: Amount
  } deriving (PriceDirective -> PriceDirective -> Bool
(PriceDirective -> PriceDirective -> Bool)
-> (PriceDirective -> PriceDirective -> Bool) -> Eq PriceDirective
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PriceDirective -> PriceDirective -> Bool
== :: PriceDirective -> PriceDirective -> Bool
$c/= :: PriceDirective -> PriceDirective -> Bool
/= :: PriceDirective -> PriceDirective -> Bool
Eq,Eq PriceDirective
Eq PriceDirective =>
(PriceDirective -> PriceDirective -> Ordering)
-> (PriceDirective -> PriceDirective -> Bool)
-> (PriceDirective -> PriceDirective -> Bool)
-> (PriceDirective -> PriceDirective -> Bool)
-> (PriceDirective -> PriceDirective -> Bool)
-> (PriceDirective -> PriceDirective -> PriceDirective)
-> (PriceDirective -> PriceDirective -> PriceDirective)
-> Ord PriceDirective
PriceDirective -> PriceDirective -> Bool
PriceDirective -> PriceDirective -> Ordering
PriceDirective -> PriceDirective -> PriceDirective
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PriceDirective -> PriceDirective -> Ordering
compare :: PriceDirective -> PriceDirective -> Ordering
$c< :: PriceDirective -> PriceDirective -> Bool
< :: PriceDirective -> PriceDirective -> Bool
$c<= :: PriceDirective -> PriceDirective -> Bool
<= :: PriceDirective -> PriceDirective -> Bool
$c> :: PriceDirective -> PriceDirective -> Bool
> :: PriceDirective -> PriceDirective -> Bool
$c>= :: PriceDirective -> PriceDirective -> Bool
>= :: PriceDirective -> PriceDirective -> Bool
$cmax :: PriceDirective -> PriceDirective -> PriceDirective
max :: PriceDirective -> PriceDirective -> PriceDirective
$cmin :: PriceDirective -> PriceDirective -> PriceDirective
min :: PriceDirective -> PriceDirective -> PriceDirective
Ord,(forall x. PriceDirective -> Rep PriceDirective x)
-> (forall x. Rep PriceDirective x -> PriceDirective)
-> Generic PriceDirective
forall x. Rep PriceDirective x -> PriceDirective
forall x. PriceDirective -> Rep PriceDirective x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PriceDirective -> Rep PriceDirective x
from :: forall x. PriceDirective -> Rep PriceDirective x
$cto :: forall x. Rep PriceDirective x -> PriceDirective
to :: forall x. Rep PriceDirective x -> PriceDirective
Generic,Int -> PriceDirective -> ShowS
[PriceDirective] -> ShowS
PriceDirective -> String
(Int -> PriceDirective -> ShowS)
-> (PriceDirective -> String)
-> ([PriceDirective] -> ShowS)
-> Show PriceDirective
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PriceDirective -> ShowS
showsPrec :: Int -> PriceDirective -> ShowS
$cshow :: PriceDirective -> String
show :: PriceDirective -> String
$cshowList :: [PriceDirective] -> ShowS
showList :: [PriceDirective] -> ShowS
Show)

-- | A historical market price (exchange rate) from one commodity to another.
-- A more concise form of a PriceDirective, without the amount display info.
data MarketPrice = MarketPrice {
   MarketPrice -> Day
mpdate :: Day                -- ^ Date on which this price becomes effective.
  ,MarketPrice -> AccountName
mpfrom :: CommoditySymbol    -- ^ The commodity being converted from.
  ,MarketPrice -> AccountName
mpto   :: CommoditySymbol    -- ^ The commodity being converted to.
  ,MarketPrice -> Quantity
mprate :: Quantity           -- ^ One unit of the "from" commodity is worth this quantity of the "to" commodity.
  } deriving (MarketPrice -> MarketPrice -> Bool
(MarketPrice -> MarketPrice -> Bool)
-> (MarketPrice -> MarketPrice -> Bool) -> Eq MarketPrice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MarketPrice -> MarketPrice -> Bool
== :: MarketPrice -> MarketPrice -> Bool
$c/= :: MarketPrice -> MarketPrice -> Bool
/= :: MarketPrice -> MarketPrice -> Bool
Eq,Eq MarketPrice
Eq MarketPrice =>
(MarketPrice -> MarketPrice -> Ordering)
-> (MarketPrice -> MarketPrice -> Bool)
-> (MarketPrice -> MarketPrice -> Bool)
-> (MarketPrice -> MarketPrice -> Bool)
-> (MarketPrice -> MarketPrice -> Bool)
-> (MarketPrice -> MarketPrice -> MarketPrice)
-> (MarketPrice -> MarketPrice -> MarketPrice)
-> Ord MarketPrice
MarketPrice -> MarketPrice -> Bool
MarketPrice -> MarketPrice -> Ordering
MarketPrice -> MarketPrice -> MarketPrice
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MarketPrice -> MarketPrice -> Ordering
compare :: MarketPrice -> MarketPrice -> Ordering
$c< :: MarketPrice -> MarketPrice -> Bool
< :: MarketPrice -> MarketPrice -> Bool
$c<= :: MarketPrice -> MarketPrice -> Bool
<= :: MarketPrice -> MarketPrice -> Bool
$c> :: MarketPrice -> MarketPrice -> Bool
> :: MarketPrice -> MarketPrice -> Bool
$c>= :: MarketPrice -> MarketPrice -> Bool
>= :: MarketPrice -> MarketPrice -> Bool
$cmax :: MarketPrice -> MarketPrice -> MarketPrice
max :: MarketPrice -> MarketPrice -> MarketPrice
$cmin :: MarketPrice -> MarketPrice -> MarketPrice
min :: MarketPrice -> MarketPrice -> MarketPrice
Ord,(forall x. MarketPrice -> Rep MarketPrice x)
-> (forall x. Rep MarketPrice x -> MarketPrice)
-> Generic MarketPrice
forall x. Rep MarketPrice x -> MarketPrice
forall x. MarketPrice -> Rep MarketPrice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MarketPrice -> Rep MarketPrice x
from :: forall x. MarketPrice -> Rep MarketPrice x
$cto :: forall x. Rep MarketPrice x -> MarketPrice
to :: forall x. Rep MarketPrice x -> MarketPrice
Generic, Int -> MarketPrice -> ShowS
[MarketPrice] -> ShowS
MarketPrice -> String
(Int -> MarketPrice -> ShowS)
-> (MarketPrice -> String)
-> ([MarketPrice] -> ShowS)
-> Show MarketPrice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MarketPrice -> ShowS
showsPrec :: Int -> MarketPrice -> ShowS
$cshow :: MarketPrice -> String
show :: MarketPrice -> String
$cshowList :: [MarketPrice] -> ShowS
showList :: [MarketPrice] -> ShowS
Show)

showMarketPrice :: MarketPrice -> String
showMarketPrice MarketPrice{Quantity
AccountName
Day
mpdate :: MarketPrice -> Day
mpfrom :: MarketPrice -> AccountName
mpto :: MarketPrice -> AccountName
mprate :: MarketPrice -> Quantity
mpdate :: Day
mpfrom :: AccountName
mpto :: AccountName
mprate :: Quantity
..} = [String] -> String
unwords [Day -> String
forall a. Show a => a -> String
show Day
mpdate, AccountName -> String
T.unpack AccountName
mpfrom String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
">" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> AccountName -> String
T.unpack AccountName
mpto, Quantity -> String
forall a. Show a => a -> String
show Quantity
mprate]
showMarketPrices :: [MarketPrice] -> String
showMarketPrices = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String)
-> ([MarketPrice] -> [String]) -> [MarketPrice] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MarketPrice -> String) -> [MarketPrice] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:)ShowS -> (MarketPrice -> String) -> MarketPrice -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MarketPrice -> String
showMarketPrice) ([MarketPrice] -> [String])
-> ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MarketPrice -> MarketPrice -> Ordering)
-> [MarketPrice] -> [MarketPrice]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((MarketPrice -> Day) -> MarketPrice -> MarketPrice -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing MarketPrice -> Day
mpdate)

-- additional valuation-related types in Valuation.hs

-- | A journal, containing general ledger transactions; also directives and various other things.
-- This is hledger's main data model.
--
-- During parsing, it is used as the type alias "ParsedJournal".
-- The jparse* fields are mainly used during parsing and included here for convenience.
-- The list fields described as "in parse order" are usually reversed for efficiency during parsing.
-- After parsing, "journalFinalise" converts ParsedJournal to a finalised "Journal",
-- which has all lists correctly ordered, and much data inference and validation applied.
--
data Journal = Journal {
  -- parsing-related state
   Journal -> Maybe Year
jparsedefaultyear        :: Maybe Year                             -- ^ the current default year, specified by the most recent Y directive (or current date)
  ,Journal -> Maybe (AccountName, AmountStyle)
jparsedefaultcommodity   :: Maybe (CommoditySymbol,AmountStyle)    -- ^ the current default commodity and its format, specified by the most recent D directive
  ,Journal -> Maybe Char
jparsedecimalmark        :: Maybe DecimalMark                      -- ^ the character to always parse as decimal point, if set by CsvReader's decimal-mark (or a future journal directive)
  ,Journal -> [AccountName]
jparseparentaccounts     :: [AccountName]                          -- ^ the current stack of parent account names, specified by apply account directives
  ,Journal -> [AccountAlias]
jparsealiases            :: [AccountAlias]                         -- ^ the current account name aliases in effect, specified by alias directives (& options ?)
  -- ,jparsetransactioncount :: Integer                               -- ^ the current count of transactions parsed so far (only journal format txns, currently)
  ,Journal -> [TimeclockEntry]
jparsetimeclockentries   :: [TimeclockEntry]                       -- ^ timeclock sessions which have not been clocked out
  ,Journal -> [String]
jincludefilestack        :: [FilePath]
  -- principal data
  ,Journal -> [(AccountName, PayeeDeclarationInfo)]
jdeclaredpayees          :: [(Payee,PayeeDeclarationInfo)]         -- ^ Payees declared by payee directives, in parse order.
  ,Journal -> [(AccountName, TagDeclarationInfo)]
jdeclaredtags            :: [(TagName,TagDeclarationInfo)]         -- ^ Tags declared by tag directives, in parse order.
  ,Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts        :: [(AccountName,AccountDeclarationInfo)] -- ^ Accounts declared by account directives, in parse order.
  ,Journal -> Map AccountName [Tag]
jdeclaredaccounttags     :: M.Map AccountName [Tag]                -- ^ Accounts which were declared with tags, and those tags.
  ,Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes    :: M.Map AccountType [AccountName]        -- ^ Accounts which were declared with a type: tag, grouped by the type.
  ,Journal -> Map AccountName AccountType
jaccounttypes            :: M.Map AccountName AccountType          -- ^ All the account types known, from account declarations or account names or parent accounts.
  ,Journal -> Map AccountName Commodity
jdeclaredcommodities     :: M.Map CommoditySymbol Commodity        -- ^ Commodities (and their display styles) declared by commodity directives, in parse order.
  ,Journal -> Map AccountName AmountStyle
jinferredcommoditystyles :: M.Map CommoditySymbol AmountStyle      -- ^ Commodity display styles inferred from amounts in the journal.
  ,Journal -> Map AccountName AmountStyle
jglobalcommoditystyles   :: M.Map CommoditySymbol AmountStyle      -- ^ Commodity display styles declared by command line options (sometimes augmented, see the import command).
  ,Journal -> [PriceDirective]
jpricedirectives         :: [PriceDirective]                       -- ^ P (market price) directives in the journal, in parse order.
  ,Journal -> [MarketPrice]
jinferredmarketprices    :: [MarketPrice]                          -- ^ Market prices inferred from transactions in the journal, in parse order.
  ,Journal -> [TransactionModifier]
jtxnmodifiers            :: [TransactionModifier]                  -- ^ Auto posting rules declared in the journal.
  ,Journal -> [PeriodicTransaction]
jperiodictxns            :: [PeriodicTransaction]                  -- ^ Periodic transaction rules declared in the journal.
  ,Journal -> [Transaction]
jtxns                    :: [Transaction]                          -- ^ Transactions recorded in the journal. The important bit.
  ,Journal -> AccountName
jfinalcommentlines       :: Text                                   -- ^ any final trailing comments in the (main) journal file
  ,Journal -> [(String, AccountName)]
jfiles                   :: [(FilePath, Text)]                     -- ^ the file path and raw text of the main and
                                                                      --   any included journal files. The main file is first,
                                                                      --   followed by any included files in the order encountered.
                                                                      --   TODO: FilePath is a sloppy type here, don't assume it's a
                                                                      --   real file; values like "" or "-" can be seen
  ,Journal -> POSIXTime
jlastreadtime            :: POSIXTime                              -- ^ when this journal was last read from its file(s)
  -- NOTE: after adding new fields, eg involving account names, consider updating
  -- the Anon instance in Hleger.Cli.Anon
  } deriving (Journal -> Journal -> Bool
(Journal -> Journal -> Bool)
-> (Journal -> Journal -> Bool) -> Eq Journal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Journal -> Journal -> Bool
== :: Journal -> Journal -> Bool
$c/= :: Journal -> Journal -> Bool
/= :: Journal -> Journal -> Bool
Eq, (forall x. Journal -> Rep Journal x)
-> (forall x. Rep Journal x -> Journal) -> Generic Journal
forall x. Rep Journal x -> Journal
forall x. Journal -> Rep Journal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Journal -> Rep Journal x
from :: forall x. Journal -> Rep Journal x
$cto :: forall x. Rep Journal x -> Journal
to :: forall x. Rep Journal x -> Journal
Generic)

-- | A journal in the process of being parsed, not yet finalised.
-- The data is partial, and list fields are in reverse order.
type ParsedJournal = Journal

-- | One of the standard *-separated value file types known by hledger,
data SepFormat 
  = Csv  -- comma-separated
  | Tsv  -- tab-separated
  | Ssv  -- semicolon-separated
  deriving (SepFormat -> SepFormat -> Bool
(SepFormat -> SepFormat -> Bool)
-> (SepFormat -> SepFormat -> Bool) -> Eq SepFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SepFormat -> SepFormat -> Bool
== :: SepFormat -> SepFormat -> Bool
$c/= :: SepFormat -> SepFormat -> Bool
/= :: SepFormat -> SepFormat -> Bool
Eq, Eq SepFormat
Eq SepFormat =>
(SepFormat -> SepFormat -> Ordering)
-> (SepFormat -> SepFormat -> Bool)
-> (SepFormat -> SepFormat -> Bool)
-> (SepFormat -> SepFormat -> Bool)
-> (SepFormat -> SepFormat -> Bool)
-> (SepFormat -> SepFormat -> SepFormat)
-> (SepFormat -> SepFormat -> SepFormat)
-> Ord SepFormat
SepFormat -> SepFormat -> Bool
SepFormat -> SepFormat -> Ordering
SepFormat -> SepFormat -> SepFormat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SepFormat -> SepFormat -> Ordering
compare :: SepFormat -> SepFormat -> Ordering
$c< :: SepFormat -> SepFormat -> Bool
< :: SepFormat -> SepFormat -> Bool
$c<= :: SepFormat -> SepFormat -> Bool
<= :: SepFormat -> SepFormat -> Bool
$c> :: SepFormat -> SepFormat -> Bool
> :: SepFormat -> SepFormat -> Bool
$c>= :: SepFormat -> SepFormat -> Bool
>= :: SepFormat -> SepFormat -> Bool
$cmax :: SepFormat -> SepFormat -> SepFormat
max :: SepFormat -> SepFormat -> SepFormat
$cmin :: SepFormat -> SepFormat -> SepFormat
min :: SepFormat -> SepFormat -> SepFormat
Ord)

-- | The id of a data format understood by hledger, eg @journal@ or @csv@.
-- The --output-format option selects one of these for output.
data StorageFormat 
  = Rules 
  | Journal' 
  | Ledger' 
  | Timeclock 
  | Timedot 
  | Sep SepFormat 
  deriving (StorageFormat -> StorageFormat -> Bool
(StorageFormat -> StorageFormat -> Bool)
-> (StorageFormat -> StorageFormat -> Bool) -> Eq StorageFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StorageFormat -> StorageFormat -> Bool
== :: StorageFormat -> StorageFormat -> Bool
$c/= :: StorageFormat -> StorageFormat -> Bool
/= :: StorageFormat -> StorageFormat -> Bool
Eq, Eq StorageFormat
Eq StorageFormat =>
(StorageFormat -> StorageFormat -> Ordering)
-> (StorageFormat -> StorageFormat -> Bool)
-> (StorageFormat -> StorageFormat -> Bool)
-> (StorageFormat -> StorageFormat -> Bool)
-> (StorageFormat -> StorageFormat -> Bool)
-> (StorageFormat -> StorageFormat -> StorageFormat)
-> (StorageFormat -> StorageFormat -> StorageFormat)
-> Ord StorageFormat
StorageFormat -> StorageFormat -> Bool
StorageFormat -> StorageFormat -> Ordering
StorageFormat -> StorageFormat -> StorageFormat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StorageFormat -> StorageFormat -> Ordering
compare :: StorageFormat -> StorageFormat -> Ordering
$c< :: StorageFormat -> StorageFormat -> Bool
< :: StorageFormat -> StorageFormat -> Bool
$c<= :: StorageFormat -> StorageFormat -> Bool
<= :: StorageFormat -> StorageFormat -> Bool
$c> :: StorageFormat -> StorageFormat -> Bool
> :: StorageFormat -> StorageFormat -> Bool
$c>= :: StorageFormat -> StorageFormat -> Bool
>= :: StorageFormat -> StorageFormat -> Bool
$cmax :: StorageFormat -> StorageFormat -> StorageFormat
max :: StorageFormat -> StorageFormat -> StorageFormat
$cmin :: StorageFormat -> StorageFormat -> StorageFormat
min :: StorageFormat -> StorageFormat -> StorageFormat
Ord)

instance Show SepFormat where
  show :: SepFormat -> String
show SepFormat
Csv = String
"csv"
  show SepFormat
Ssv = String
"ssv"
  show SepFormat
Tsv = String
"tsv"

instance Show StorageFormat where
  show :: StorageFormat -> String
show StorageFormat
Rules = String
"rules"
  show StorageFormat
Journal' = String
"journal"
  show StorageFormat
Ledger' = String
"ledger"
  show StorageFormat
Timeclock = String
"timeclock"
  show StorageFormat
Timedot = String
"timedot"
  show (Sep SepFormat
Csv) = String
"csv"
  show (Sep SepFormat
Ssv) = String
"ssv"
  show (Sep SepFormat
Tsv) = String
"tsv"

-- | Extra information found in a payee directive.
data PayeeDeclarationInfo = PayeeDeclarationInfo {
   PayeeDeclarationInfo -> AccountName
pdicomment :: Text   -- ^ any comment lines following the payee directive
  ,PayeeDeclarationInfo -> [Tag]
pditags    :: [Tag]  -- ^ tags extracted from the comment, if any
} deriving (PayeeDeclarationInfo -> PayeeDeclarationInfo -> Bool
(PayeeDeclarationInfo -> PayeeDeclarationInfo -> Bool)
-> (PayeeDeclarationInfo -> PayeeDeclarationInfo -> Bool)
-> Eq PayeeDeclarationInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PayeeDeclarationInfo -> PayeeDeclarationInfo -> Bool
== :: PayeeDeclarationInfo -> PayeeDeclarationInfo -> Bool
$c/= :: PayeeDeclarationInfo -> PayeeDeclarationInfo -> Bool
/= :: PayeeDeclarationInfo -> PayeeDeclarationInfo -> Bool
Eq,Int -> PayeeDeclarationInfo -> ShowS
[PayeeDeclarationInfo] -> ShowS
PayeeDeclarationInfo -> String
(Int -> PayeeDeclarationInfo -> ShowS)
-> (PayeeDeclarationInfo -> String)
-> ([PayeeDeclarationInfo] -> ShowS)
-> Show PayeeDeclarationInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PayeeDeclarationInfo -> ShowS
showsPrec :: Int -> PayeeDeclarationInfo -> ShowS
$cshow :: PayeeDeclarationInfo -> String
show :: PayeeDeclarationInfo -> String
$cshowList :: [PayeeDeclarationInfo] -> ShowS
showList :: [PayeeDeclarationInfo] -> ShowS
Show,(forall x. PayeeDeclarationInfo -> Rep PayeeDeclarationInfo x)
-> (forall x. Rep PayeeDeclarationInfo x -> PayeeDeclarationInfo)
-> Generic PayeeDeclarationInfo
forall x. Rep PayeeDeclarationInfo x -> PayeeDeclarationInfo
forall x. PayeeDeclarationInfo -> Rep PayeeDeclarationInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PayeeDeclarationInfo -> Rep PayeeDeclarationInfo x
from :: forall x. PayeeDeclarationInfo -> Rep PayeeDeclarationInfo x
$cto :: forall x. Rep PayeeDeclarationInfo x -> PayeeDeclarationInfo
to :: forall x. Rep PayeeDeclarationInfo x -> PayeeDeclarationInfo
Generic)

nullpayeedeclarationinfo :: PayeeDeclarationInfo
nullpayeedeclarationinfo = PayeeDeclarationInfo {
   pdicomment :: AccountName
pdicomment          = AccountName
""
  ,pditags :: [Tag]
pditags             = []
}

-- | Extra information found in a tag directive.
newtype TagDeclarationInfo = TagDeclarationInfo {
   TagDeclarationInfo -> AccountName
tdicomment :: Text   -- ^ any comment lines following the tag directive. No tags allowed here.
} deriving (TagDeclarationInfo -> TagDeclarationInfo -> Bool
(TagDeclarationInfo -> TagDeclarationInfo -> Bool)
-> (TagDeclarationInfo -> TagDeclarationInfo -> Bool)
-> Eq TagDeclarationInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TagDeclarationInfo -> TagDeclarationInfo -> Bool
== :: TagDeclarationInfo -> TagDeclarationInfo -> Bool
$c/= :: TagDeclarationInfo -> TagDeclarationInfo -> Bool
/= :: TagDeclarationInfo -> TagDeclarationInfo -> Bool
Eq,Int -> TagDeclarationInfo -> ShowS
[TagDeclarationInfo] -> ShowS
TagDeclarationInfo -> String
(Int -> TagDeclarationInfo -> ShowS)
-> (TagDeclarationInfo -> String)
-> ([TagDeclarationInfo] -> ShowS)
-> Show TagDeclarationInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TagDeclarationInfo -> ShowS
showsPrec :: Int -> TagDeclarationInfo -> ShowS
$cshow :: TagDeclarationInfo -> String
show :: TagDeclarationInfo -> String
$cshowList :: [TagDeclarationInfo] -> ShowS
showList :: [TagDeclarationInfo] -> ShowS
Show,(forall x. TagDeclarationInfo -> Rep TagDeclarationInfo x)
-> (forall x. Rep TagDeclarationInfo x -> TagDeclarationInfo)
-> Generic TagDeclarationInfo
forall x. Rep TagDeclarationInfo x -> TagDeclarationInfo
forall x. TagDeclarationInfo -> Rep TagDeclarationInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TagDeclarationInfo -> Rep TagDeclarationInfo x
from :: forall x. TagDeclarationInfo -> Rep TagDeclarationInfo x
$cto :: forall x. Rep TagDeclarationInfo x -> TagDeclarationInfo
to :: forall x. Rep TagDeclarationInfo x -> TagDeclarationInfo
Generic)

nulltagdeclarationinfo :: TagDeclarationInfo
nulltagdeclarationinfo = TagDeclarationInfo {
   tdicomment :: AccountName
tdicomment          = AccountName
""
}

-- | Extra information about an account that can be derived from
-- its account directive (and the other account directives).
data AccountDeclarationInfo = AccountDeclarationInfo {
   AccountDeclarationInfo -> AccountName
adicomment          :: Text   -- ^ any comment lines following an account directive for this account
  ,AccountDeclarationInfo -> [Tag]
aditags             :: [Tag]  -- ^ tags extracted from the account comment, if any
  ,AccountDeclarationInfo -> Int
adideclarationorder :: Int    -- ^ the order in which this account was declared,
                                 --   relative to other account declarations, during parsing (1..)
  ,AccountDeclarationInfo -> SourcePos
adisourcepos        :: SourcePos  -- ^ source file and position
} deriving (AccountDeclarationInfo -> AccountDeclarationInfo -> Bool
(AccountDeclarationInfo -> AccountDeclarationInfo -> Bool)
-> (AccountDeclarationInfo -> AccountDeclarationInfo -> Bool)
-> Eq AccountDeclarationInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AccountDeclarationInfo -> AccountDeclarationInfo -> Bool
== :: AccountDeclarationInfo -> AccountDeclarationInfo -> Bool
$c/= :: AccountDeclarationInfo -> AccountDeclarationInfo -> Bool
/= :: AccountDeclarationInfo -> AccountDeclarationInfo -> Bool
Eq,Int -> AccountDeclarationInfo -> ShowS
[AccountDeclarationInfo] -> ShowS
AccountDeclarationInfo -> String
(Int -> AccountDeclarationInfo -> ShowS)
-> (AccountDeclarationInfo -> String)
-> ([AccountDeclarationInfo] -> ShowS)
-> Show AccountDeclarationInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AccountDeclarationInfo -> ShowS
showsPrec :: Int -> AccountDeclarationInfo -> ShowS
$cshow :: AccountDeclarationInfo -> String
show :: AccountDeclarationInfo -> String
$cshowList :: [AccountDeclarationInfo] -> ShowS
showList :: [AccountDeclarationInfo] -> ShowS
Show,(forall x. AccountDeclarationInfo -> Rep AccountDeclarationInfo x)
-> (forall x.
    Rep AccountDeclarationInfo x -> AccountDeclarationInfo)
-> Generic AccountDeclarationInfo
forall x. Rep AccountDeclarationInfo x -> AccountDeclarationInfo
forall x. AccountDeclarationInfo -> Rep AccountDeclarationInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AccountDeclarationInfo -> Rep AccountDeclarationInfo x
from :: forall x. AccountDeclarationInfo -> Rep AccountDeclarationInfo x
$cto :: forall x. Rep AccountDeclarationInfo x -> AccountDeclarationInfo
to :: forall x. Rep AccountDeclarationInfo x -> AccountDeclarationInfo
Generic)

nullaccountdeclarationinfo :: AccountDeclarationInfo
nullaccountdeclarationinfo = AccountDeclarationInfo {
   adicomment :: AccountName
adicomment          = AccountName
""
  ,aditags :: [Tag]
aditags             = []
  ,adideclarationorder :: Int
adideclarationorder = Int
0
  ,adisourcepos :: SourcePos
adisourcepos        = String -> Pos -> Pos -> SourcePos
SourcePos String
"" (Int -> Pos
mkPos Int
1) (Int -> Pos
mkPos Int
1)
}

-- | An account, with its balances, parent/subaccount relationships, etc.
-- Only the name is required; the other fields are added when needed.
data Account = Account {
   Account -> AccountName
aname                     :: AccountName    -- ^ this account's full name
  ,Account -> Maybe AccountDeclarationInfo
adeclarationinfo          :: Maybe AccountDeclarationInfo  -- ^ optional extra info from account directives
  -- relationships in the tree
  ,Account -> [Account]
asubs                     :: [Account]      -- ^ this account's sub-accounts
  ,Account -> Maybe Account
aparent                   :: Maybe Account  -- ^ parent account
  ,Account -> Bool
aboring                   :: Bool           -- ^ used in the accounts report to label elidable parents
  -- balance information
  ,Account -> Int
anumpostings              :: Int            -- ^ the number of postings to this account
  ,Account -> MixedAmount
aebalance                 :: MixedAmount    -- ^ this account's balance, excluding subaccounts
  ,Account -> MixedAmount
aibalance                 :: MixedAmount    -- ^ this account's balance, including subaccounts
  } deriving ((forall x. Account -> Rep Account x)
-> (forall x. Rep Account x -> Account) -> Generic Account
forall x. Rep Account x -> Account
forall x. Account -> Rep Account x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Account -> Rep Account x
from :: forall x. Account -> Rep Account x
$cto :: forall x. Rep Account x -> Account
to :: forall x. Rep Account x -> Account
Generic)

-- | Whether an account's balance is normally a positive number (in
-- accounting terms, a debit balance) or a negative number (credit balance).
-- Assets and expenses are normally positive (debit), while liabilities, equity
-- and income are normally negative (credit).
-- https://en.wikipedia.org/wiki/Normal_balance
data NormalSign = NormallyPositive | NormallyNegative deriving (Int -> NormalSign -> ShowS
[NormalSign] -> ShowS
NormalSign -> String
(Int -> NormalSign -> ShowS)
-> (NormalSign -> String)
-> ([NormalSign] -> ShowS)
-> Show NormalSign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NormalSign -> ShowS
showsPrec :: Int -> NormalSign -> ShowS
$cshow :: NormalSign -> String
show :: NormalSign -> String
$cshowList :: [NormalSign] -> ShowS
showList :: [NormalSign] -> ShowS
Show, NormalSign -> NormalSign -> Bool
(NormalSign -> NormalSign -> Bool)
-> (NormalSign -> NormalSign -> Bool) -> Eq NormalSign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NormalSign -> NormalSign -> Bool
== :: NormalSign -> NormalSign -> Bool
$c/= :: NormalSign -> NormalSign -> Bool
/= :: NormalSign -> NormalSign -> Bool
Eq)

-- | A Ledger has the journal it derives from, and the accounts
-- derived from that. Accounts are accessible both list-wise and
-- tree-wise, since each one knows its parent and subs; the first
-- account is the root of the tree and always exists.
data Ledger = Ledger {
   Ledger -> Journal
ljournal  :: Journal
  ,Ledger -> [Account]
laccounts :: [Account]
  } deriving ((forall x. Ledger -> Rep Ledger x)
-> (forall x. Rep Ledger x -> Ledger) -> Generic Ledger
forall x. Rep Ledger x -> Ledger
forall x. Ledger -> Rep Ledger x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ledger -> Rep Ledger x
from :: forall x. Ledger -> Rep Ledger x
$cto :: forall x. Rep Ledger x -> Ledger
to :: forall x. Rep Ledger x -> Ledger
Generic)

instance NFData AccountAlias
instance NFData AccountDeclarationInfo
instance NFData AccountType
instance NFData Amount
instance NFData AmountCost
instance NFData AmountPrecision
instance NFData AmountStyle
instance NFData BalanceAssertion
instance NFData Commodity
instance NFData DateSpan
instance NFData DigitGroupStyle
instance NFData EFDay
instance NFData Interval
instance NFData Journal
instance NFData MarketPrice
instance NFData MixedAmount
instance NFData MixedAmountKey
instance NFData Rounding
instance NFData PayeeDeclarationInfo
instance NFData PeriodicTransaction
instance NFData PostingType
instance NFData PriceDirective
instance NFData Side
instance NFData Status
instance NFData TagDeclarationInfo
instance NFData TimeclockCode
instance NFData TimeclockEntry
instance NFData TMPostingRule
instance NFData Transaction
instance NFData TransactionModifier

instance NFData Posting where
  -- Do not call rnf on the parent transaction to avoid recursive loops
  rnf :: Posting -> ()
rnf (Posting Maybe Day
d Maybe Day
d2 Status
s AccountName
n MixedAmount
a AccountName
c PostingType
t [Tag]
ta Maybe BalanceAssertion
b Maybe Transaction
mt Maybe Posting
op) =
      Maybe Day -> ()
forall a. NFData a => a -> ()
rnf Maybe Day
d () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Day -> ()
forall a. NFData a => a -> ()
rnf Maybe Day
d2 () -> () -> ()
forall a b. a -> b -> b
`seq` Status -> ()
forall a. NFData a => a -> ()
rnf Status
s () -> () -> ()
forall a b. a -> b -> b
`seq` AccountName -> ()
forall a. NFData a => a -> ()
rnf AccountName
n () -> () -> ()
forall a b. a -> b -> b
`seq` MixedAmount -> ()
forall a. NFData a => a -> ()
rnf MixedAmount
a () -> () -> ()
forall a b. a -> b -> b
`seq` AccountName -> ()
forall a. NFData a => a -> ()
rnf AccountName
c () -> () -> ()
forall a b. a -> b -> b
`seq` PostingType -> ()
forall a. NFData a => a -> ()
rnf PostingType
t () -> () -> ()
forall a b. a -> b -> b
`seq` [Tag] -> ()
forall a. NFData a => a -> ()
rnf [Tag]
ta () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe BalanceAssertion -> ()
forall a. NFData a => a -> ()
rnf Maybe BalanceAssertion
b () -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Transaction
mt Maybe Transaction -> () -> ()
forall a b. a -> b -> b
`seq` Maybe Posting -> ()
forall a. NFData a => a -> ()
rnf Maybe Posting
op () -> () -> ()
forall a b. a -> b -> b
`seq` ()