{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, DeriveGeneric, TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-|

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.

-}

module Hledger.Data.Types
where

import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
import Data.Data
import Data.Decimal
import Data.Default
import Data.Functor (($>))
import Data.List (intercalate)
import Text.Blaze (ToMarkup(..))
--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.Text (Text)
-- import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.LocalTime
import System.Time (ClockTime(..))
import Text.Printf

import Hledger.Utils.Regex


-- | A possibly incomplete date, whose missing parts will be filled from a reference date.
-- A numeric year, month, and day of month, or the empty string for any of these.
-- See the smartdate parser.
type SmartDate = (String,String,String)

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
/= :: WhichDate -> WhichDate -> Bool
$c/= :: WhichDate -> WhichDate -> Bool
== :: WhichDate -> WhichDate -> Bool
$c== :: 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
showList :: [WhichDate] -> ShowS
$cshowList :: [WhichDate] -> ShowS
show :: WhichDate -> String
$cshow :: WhichDate -> String
showsPrec :: Int -> WhichDate -> ShowS
$cshowsPrec :: Int -> WhichDate -> ShowS
Show)

data DateSpan = DateSpan (Maybe Day) (Maybe Day) deriving (DateSpan -> DateSpan -> Bool
(DateSpan -> DateSpan -> Bool)
-> (DateSpan -> DateSpan -> Bool) -> Eq DateSpan
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DateSpan -> DateSpan -> Bool
$c/= :: DateSpan -> DateSpan -> Bool
== :: DateSpan -> DateSpan -> Bool
$c== :: 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
min :: DateSpan -> DateSpan -> DateSpan
$cmin :: DateSpan -> DateSpan -> DateSpan
max :: DateSpan -> DateSpan -> DateSpan
$cmax :: DateSpan -> DateSpan -> DateSpan
>= :: DateSpan -> DateSpan -> Bool
$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
compare :: DateSpan -> DateSpan -> Ordering
$ccompare :: DateSpan -> DateSpan -> Ordering
$cp1Ord :: Eq DateSpan
Ord,Typeable DateSpan
Constr
DataType
Typeable DateSpan =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DateSpan -> c DateSpan)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DateSpan)
-> (DateSpan -> Constr)
-> (DateSpan -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DateSpan))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DateSpan))
-> ((forall b. Data b => b -> b) -> DateSpan -> DateSpan)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DateSpan -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DateSpan -> r)
-> (forall u. (forall d. Data d => d -> u) -> DateSpan -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> DateSpan -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DateSpan -> m DateSpan)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DateSpan -> m DateSpan)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DateSpan -> m DateSpan)
-> Data DateSpan
DateSpan -> Constr
DateSpan -> DataType
(forall b. Data b => b -> b) -> DateSpan -> DateSpan
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateSpan -> c DateSpan
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateSpan
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DateSpan -> u
forall u. (forall d. Data d => d -> u) -> DateSpan -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DateSpan -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DateSpan -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DateSpan -> m DateSpan
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DateSpan -> m DateSpan
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateSpan
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateSpan -> c DateSpan
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DateSpan)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DateSpan)
$cDateSpan :: Constr
$tDateSpan :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> DateSpan -> m DateSpan
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DateSpan -> m DateSpan
gmapMp :: (forall d. Data d => d -> m d) -> DateSpan -> m DateSpan
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DateSpan -> m DateSpan
gmapM :: (forall d. Data d => d -> m d) -> DateSpan -> m DateSpan
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DateSpan -> m DateSpan
gmapQi :: Int -> (forall d. Data d => d -> u) -> DateSpan -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DateSpan -> u
gmapQ :: (forall d. Data d => d -> u) -> DateSpan -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DateSpan -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DateSpan -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DateSpan -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DateSpan -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DateSpan -> r
gmapT :: (forall b. Data b => b -> b) -> DateSpan -> DateSpan
$cgmapT :: (forall b. Data b => b -> b) -> DateSpan -> DateSpan
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DateSpan)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DateSpan)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DateSpan)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DateSpan)
dataTypeOf :: DateSpan -> DataType
$cdataTypeOf :: DateSpan -> DataType
toConstr :: DateSpan -> Constr
$ctoConstr :: DateSpan -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateSpan
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DateSpan
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateSpan -> c DateSpan
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DateSpan -> c DateSpan
$cp1Data :: Typeable DateSpan
Data,(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
$cto :: forall x. Rep DateSpan x -> DateSpan
$cfrom :: forall x. DateSpan -> Rep DateSpan x
Generic,Typeable)

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

instance NFData DateSpan

-- synonyms for various date-related scalars
type Year = Integer
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

-- Typical report periods (spans of time), both finite and open-ended.
-- A richer 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
/= :: Period -> Period -> Bool
$c/= :: Period -> Period -> Bool
== :: Period -> Period -> Bool
$c== :: 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
min :: Period -> Period -> Period
$cmin :: Period -> Period -> Period
max :: Period -> Period -> Period
$cmax :: Period -> Period -> Period
>= :: Period -> Period -> Bool
$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
compare :: Period -> Period -> Ordering
$ccompare :: Period -> Period -> Ordering
$cp1Ord :: Eq 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
showList :: [Period] -> ShowS
$cshowList :: [Period] -> ShowS
show :: Period -> String
$cshow :: Period -> String
showsPrec :: Int -> Period -> ShowS
$cshowsPrec :: Int -> Period -> ShowS
Show,Typeable Period
Constr
DataType
Typeable Period =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Period -> c Period)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Period)
-> (Period -> Constr)
-> (Period -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Period))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Period))
-> ((forall b. Data b => b -> b) -> Period -> Period)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Period -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Period -> r)
-> (forall u. (forall d. Data d => d -> u) -> Period -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Period -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Period -> m Period)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Period -> m Period)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Period -> m Period)
-> Data Period
Period -> Constr
Period -> DataType
(forall b. Data b => b -> b) -> Period -> Period
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Period -> c Period
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Period
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Period -> u
forall u. (forall d. Data d => d -> u) -> Period -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Period -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Period -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Period -> m Period
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Period -> m Period
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Period
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Period -> c Period
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Period)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Period)
$cPeriodAll :: Constr
$cPeriodTo :: Constr
$cPeriodFrom :: Constr
$cPeriodBetween :: Constr
$cYearPeriod :: Constr
$cQuarterPeriod :: Constr
$cMonthPeriod :: Constr
$cWeekPeriod :: Constr
$cDayPeriod :: Constr
$tPeriod :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Period -> m Period
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Period -> m Period
gmapMp :: (forall d. Data d => d -> m d) -> Period -> m Period
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Period -> m Period
gmapM :: (forall d. Data d => d -> m d) -> Period -> m Period
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Period -> m Period
gmapQi :: Int -> (forall d. Data d => d -> u) -> Period -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Period -> u
gmapQ :: (forall d. Data d => d -> u) -> Period -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Period -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Period -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Period -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Period -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Period -> r
gmapT :: (forall b. Data b => b -> b) -> Period -> Period
$cgmapT :: (forall b. Data b => b -> b) -> Period -> Period
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Period)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Period)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Period)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Period)
dataTypeOf :: Period -> DataType
$cdataTypeOf :: Period -> DataType
toConstr :: Period -> Constr
$ctoConstr :: Period -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Period
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Period
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Period -> c Period
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Period -> c Period
$cp1Data :: Typeable Period
Data,(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
$cto :: forall x. Rep Period x -> Period
$cfrom :: forall x. Period -> Rep Period x
Generic,Typeable)

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

---- Typical report period/subperiod durations, from a day to a year.
--data Duration =
--    DayLong
--   WeekLong
--   MonthLong
--   QuarterLong
--   YearLong
--  deriving (Eq,Ord,Show,Data,Generic,Typeable)

-- Ways in which a period can be divided into subperiods.
data Interval =
    NoInterval
  | Days Int
  | Weeks Int
  | Months Int
  | Quarters Int
  | Years Int
  | DayOfMonth Int
  | WeekdayOfMonth Int Int
  | DayOfWeek Int
  | DayOfYear Int Int -- Month, Day
  -- WeekOfYear Int
  -- MonthOfYear Int
  -- QuarterOfYear Int
  deriving (Interval -> Interval -> Bool
(Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool) -> Eq Interval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interval -> Interval -> Bool
$c/= :: Interval -> Interval -> Bool
== :: Interval -> Interval -> Bool
$c== :: 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
showList :: [Interval] -> ShowS
$cshowList :: [Interval] -> ShowS
show :: Interval -> String
$cshow :: Interval -> String
showsPrec :: Int -> Interval -> ShowS
$cshowsPrec :: Int -> 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
min :: Interval -> Interval -> Interval
$cmin :: Interval -> Interval -> Interval
max :: Interval -> Interval -> Interval
$cmax :: Interval -> Interval -> Interval
>= :: Interval -> Interval -> Bool
$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
compare :: Interval -> Interval -> Ordering
$ccompare :: Interval -> Interval -> Ordering
$cp1Ord :: Eq Interval
Ord,Typeable Interval
Constr
DataType
Typeable Interval =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Interval -> c Interval)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Interval)
-> (Interval -> Constr)
-> (Interval -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Interval))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Interval))
-> ((forall b. Data b => b -> b) -> Interval -> Interval)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Interval -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Interval -> r)
-> (forall u. (forall d. Data d => d -> u) -> Interval -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Interval -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Interval -> m Interval)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Interval -> m Interval)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Interval -> m Interval)
-> Data Interval
Interval -> Constr
Interval -> DataType
(forall b. Data b => b -> b) -> Interval -> Interval
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Interval -> c Interval
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Interval
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Interval -> u
forall u. (forall d. Data d => d -> u) -> Interval -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Interval -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Interval -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Interval -> m Interval
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Interval -> m Interval
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Interval
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Interval -> c Interval
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Interval)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Interval)
$cDayOfYear :: Constr
$cDayOfWeek :: Constr
$cWeekdayOfMonth :: Constr
$cDayOfMonth :: Constr
$cYears :: Constr
$cQuarters :: Constr
$cMonths :: Constr
$cWeeks :: Constr
$cDays :: Constr
$cNoInterval :: Constr
$tInterval :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Interval -> m Interval
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Interval -> m Interval
gmapMp :: (forall d. Data d => d -> m d) -> Interval -> m Interval
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Interval -> m Interval
gmapM :: (forall d. Data d => d -> m d) -> Interval -> m Interval
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Interval -> m Interval
gmapQi :: Int -> (forall d. Data d => d -> u) -> Interval -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Interval -> u
gmapQ :: (forall d. Data d => d -> u) -> Interval -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Interval -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Interval -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Interval -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Interval -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Interval -> r
gmapT :: (forall b. Data b => b -> b) -> Interval -> Interval
$cgmapT :: (forall b. Data b => b -> b) -> Interval -> Interval
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Interval)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Interval)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Interval)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Interval)
dataTypeOf :: Interval -> DataType
$cdataTypeOf :: Interval -> DataType
toConstr :: Interval -> Constr
$ctoConstr :: Interval -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Interval
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Interval
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Interval -> c Interval
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Interval -> c Interval
$cp1Data :: Typeable Interval
Data,(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
$cto :: forall x. Rep Interval x -> Interval
$cfrom :: forall x. Interval -> Rep Interval x
Generic,Typeable)

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

instance NFData Interval

type AccountName = Text

data AccountType =
    Asset
  | Liability
  | Equity
  | Revenue
  | Expense
  deriving (Int -> AccountType -> ShowS
[AccountType] -> ShowS
AccountType -> String
(Int -> AccountType -> ShowS)
-> (AccountType -> String)
-> ([AccountType] -> ShowS)
-> Show AccountType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AccountType] -> ShowS
$cshowList :: [AccountType] -> ShowS
show :: AccountType -> String
$cshow :: AccountType -> String
showsPrec :: Int -> AccountType -> ShowS
$cshowsPrec :: Int -> AccountType -> ShowS
Show,AccountType -> AccountType -> Bool
(AccountType -> AccountType -> Bool)
-> (AccountType -> AccountType -> Bool) -> Eq AccountType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountType -> AccountType -> Bool
$c/= :: AccountType -> AccountType -> Bool
== :: AccountType -> AccountType -> Bool
$c== :: 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
min :: AccountType -> AccountType -> AccountType
$cmin :: AccountType -> AccountType -> AccountType
max :: AccountType -> AccountType -> AccountType
$cmax :: AccountType -> AccountType -> AccountType
>= :: AccountType -> AccountType -> Bool
$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
compare :: AccountType -> AccountType -> Ordering
$ccompare :: AccountType -> AccountType -> Ordering
$cp1Ord :: Eq AccountType
Ord,Typeable AccountType
Constr
DataType
Typeable AccountType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AccountType -> c AccountType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AccountType)
-> (AccountType -> Constr)
-> (AccountType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AccountType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AccountType))
-> ((forall b. Data b => b -> b) -> AccountType -> AccountType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AccountType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AccountType -> r)
-> (forall u. (forall d. Data d => d -> u) -> AccountType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AccountType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AccountType -> m AccountType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AccountType -> m AccountType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AccountType -> m AccountType)
-> Data AccountType
AccountType -> Constr
AccountType -> DataType
(forall b. Data b => b -> b) -> AccountType -> AccountType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AccountType -> c AccountType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AccountType -> u
forall u. (forall d. Data d => d -> u) -> AccountType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AccountType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AccountType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AccountType -> m AccountType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AccountType -> m AccountType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AccountType -> c AccountType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AccountType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccountType)
$cExpense :: Constr
$cRevenue :: Constr
$cEquity :: Constr
$cLiability :: Constr
$cAsset :: Constr
$tAccountType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AccountType -> m AccountType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AccountType -> m AccountType
gmapMp :: (forall d. Data d => d -> m d) -> AccountType -> m AccountType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AccountType -> m AccountType
gmapM :: (forall d. Data d => d -> m d) -> AccountType -> m AccountType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AccountType -> m AccountType
gmapQi :: Int -> (forall d. Data d => d -> u) -> AccountType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AccountType -> u
gmapQ :: (forall d. Data d => d -> u) -> AccountType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AccountType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AccountType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AccountType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AccountType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AccountType -> r
gmapT :: (forall b. Data b => b -> b) -> AccountType -> AccountType
$cgmapT :: (forall b. Data b => b -> b) -> AccountType -> AccountType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccountType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccountType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AccountType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AccountType)
dataTypeOf :: AccountType -> DataType
$cdataTypeOf :: AccountType -> DataType
toConstr :: AccountType -> Constr
$ctoConstr :: AccountType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AccountType -> c AccountType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AccountType -> c AccountType
$cp1Data :: Typeable AccountType
Data,(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
$cto :: forall x. Rep AccountType x -> AccountType
$cfrom :: forall x. AccountType -> Rep AccountType x
Generic)

instance NFData AccountType

-- 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
/= :: AccountAlias -> AccountAlias -> Bool
$c/= :: AccountAlias -> AccountAlias -> Bool
== :: AccountAlias -> AccountAlias -> Bool
$c== :: 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
readListPrec :: ReadPrec [AccountAlias]
$creadListPrec :: ReadPrec [AccountAlias]
readPrec :: ReadPrec AccountAlias
$creadPrec :: ReadPrec AccountAlias
readList :: ReadS [AccountAlias]
$creadList :: ReadS [AccountAlias]
readsPrec :: Int -> ReadS AccountAlias
$creadsPrec :: Int -> ReadS 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
showList :: [AccountAlias] -> ShowS
$cshowList :: [AccountAlias] -> ShowS
show :: AccountAlias -> String
$cshow :: AccountAlias -> String
showsPrec :: Int -> AccountAlias -> ShowS
$cshowsPrec :: Int -> 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
min :: AccountAlias -> AccountAlias -> AccountAlias
$cmin :: AccountAlias -> AccountAlias -> AccountAlias
max :: AccountAlias -> AccountAlias -> AccountAlias
$cmax :: AccountAlias -> AccountAlias -> AccountAlias
>= :: AccountAlias -> AccountAlias -> Bool
$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
compare :: AccountAlias -> AccountAlias -> Ordering
$ccompare :: AccountAlias -> AccountAlias -> Ordering
$cp1Ord :: Eq AccountAlias
Ord, Typeable AccountAlias
Constr
DataType
Typeable AccountAlias =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AccountAlias -> c AccountAlias)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AccountAlias)
-> (AccountAlias -> Constr)
-> (AccountAlias -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AccountAlias))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AccountAlias))
-> ((forall b. Data b => b -> b) -> AccountAlias -> AccountAlias)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AccountAlias -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AccountAlias -> r)
-> (forall u. (forall d. Data d => d -> u) -> AccountAlias -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AccountAlias -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AccountAlias -> m AccountAlias)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AccountAlias -> m AccountAlias)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AccountAlias -> m AccountAlias)
-> Data AccountAlias
AccountAlias -> Constr
AccountAlias -> DataType
(forall b. Data b => b -> b) -> AccountAlias -> AccountAlias
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AccountAlias -> c AccountAlias
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountAlias
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AccountAlias -> u
forall u. (forall d. Data d => d -> u) -> AccountAlias -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AccountAlias -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AccountAlias -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AccountAlias -> m AccountAlias
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AccountAlias -> m AccountAlias
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountAlias
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AccountAlias -> c AccountAlias
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AccountAlias)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccountAlias)
$cRegexAlias :: Constr
$cBasicAlias :: Constr
$tAccountAlias :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AccountAlias -> m AccountAlias
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AccountAlias -> m AccountAlias
gmapMp :: (forall d. Data d => d -> m d) -> AccountAlias -> m AccountAlias
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AccountAlias -> m AccountAlias
gmapM :: (forall d. Data d => d -> m d) -> AccountAlias -> m AccountAlias
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AccountAlias -> m AccountAlias
gmapQi :: Int -> (forall d. Data d => d -> u) -> AccountAlias -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AccountAlias -> u
gmapQ :: (forall d. Data d => d -> u) -> AccountAlias -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AccountAlias -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AccountAlias -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AccountAlias -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AccountAlias -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AccountAlias -> r
gmapT :: (forall b. Data b => b -> b) -> AccountAlias -> AccountAlias
$cgmapT :: (forall b. Data b => b -> b) -> AccountAlias -> AccountAlias
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccountAlias)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccountAlias)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AccountAlias)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AccountAlias)
dataTypeOf :: AccountAlias -> DataType
$cdataTypeOf :: AccountAlias -> DataType
toConstr :: AccountAlias -> Constr
$ctoConstr :: AccountAlias -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountAlias
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountAlias
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AccountAlias -> c AccountAlias
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AccountAlias -> c AccountAlias
$cp1Data :: Typeable AccountAlias
Data, (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
$cto :: forall x. Rep AccountAlias x -> AccountAlias
$cfrom :: forall x. AccountAlias -> Rep AccountAlias x
Generic, Typeable)

instance NFData AccountAlias

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
/= :: Side -> Side -> Bool
$c/= :: Side -> Side -> Bool
== :: Side -> Side -> Bool
$c== :: 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
showList :: [Side] -> ShowS
$cshowList :: [Side] -> ShowS
show :: Side -> String
$cshow :: Side -> String
showsPrec :: Int -> Side -> ShowS
$cshowsPrec :: Int -> 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
readListPrec :: ReadPrec [Side]
$creadListPrec :: ReadPrec [Side]
readPrec :: ReadPrec Side
$creadPrec :: ReadPrec Side
readList :: ReadS [Side]
$creadList :: ReadS [Side]
readsPrec :: Int -> ReadS Side
$creadsPrec :: Int -> ReadS 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
min :: Side -> Side -> Side
$cmin :: Side -> Side -> Side
max :: Side -> Side -> Side
$cmax :: Side -> Side -> Side
>= :: Side -> Side -> Bool
$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
compare :: Side -> Side -> Ordering
$ccompare :: Side -> Side -> Ordering
$cp1Ord :: Eq Side
Ord,Typeable,Typeable Side
Constr
DataType
Typeable Side =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Side -> c Side)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Side)
-> (Side -> Constr)
-> (Side -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Side))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Side))
-> ((forall b. Data b => b -> b) -> Side -> Side)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Side -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Side -> r)
-> (forall u. (forall d. Data d => d -> u) -> Side -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Side -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Side -> m Side)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Side -> m Side)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Side -> m Side)
-> Data Side
Side -> Constr
Side -> DataType
(forall b. Data b => b -> b) -> Side -> Side
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Side -> c Side
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Side
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Side -> u
forall u. (forall d. Data d => d -> u) -> Side -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Side -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Side -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Side -> m Side
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Side -> m Side
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Side
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Side -> c Side
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Side)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Side)
$cR :: Constr
$cL :: Constr
$tSide :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Side -> m Side
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Side -> m Side
gmapMp :: (forall d. Data d => d -> m d) -> Side -> m Side
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Side -> m Side
gmapM :: (forall d. Data d => d -> m d) -> Side -> m Side
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Side -> m Side
gmapQi :: Int -> (forall d. Data d => d -> u) -> Side -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Side -> u
gmapQ :: (forall d. Data d => d -> u) -> Side -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Side -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Side -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Side -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Side -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Side -> r
gmapT :: (forall b. Data b => b -> b) -> Side -> Side
$cgmapT :: (forall b. Data b => b -> b) -> Side -> Side
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Side)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Side)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Side)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Side)
dataTypeOf :: Side -> DataType
$cdataTypeOf :: Side -> DataType
toConstr :: Side -> Constr
$ctoConstr :: Side -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Side
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Side
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Side -> c Side
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Side -> c Side
$cp1Data :: Typeable Side
Data,(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
$cto :: forall x. Rep Side x -> Side
$cfrom :: forall x. Side -> Rep Side x
Generic)

instance NFData Side

-- | The basic numeric type used in amounts.
type Quantity = Decimal
deriving instance Data Quantity
-- 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 :: DecimalRaw Integer -> Markup
toMarkup = String -> Markup
forall a. ToMarkup a => a -> Markup
toMarkup (String -> Markup)
-> (DecimalRaw Integer -> String) -> DecimalRaw Integer -> Markup
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DecimalRaw Integer -> String
forall a. Show a => a -> String
show

-- | An amount's per-unit or total cost/selling price in another
-- commodity, as recorded in the journal entry eg with @ or @@.
-- Docs call this "transaction price". The amount is always positive.
data AmountPrice = UnitPrice Amount | TotalPrice Amount
  deriving (AmountPrice -> AmountPrice -> Bool
(AmountPrice -> AmountPrice -> Bool)
-> (AmountPrice -> AmountPrice -> Bool) -> Eq AmountPrice
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AmountPrice -> AmountPrice -> Bool
$c/= :: AmountPrice -> AmountPrice -> Bool
== :: AmountPrice -> AmountPrice -> Bool
$c== :: AmountPrice -> AmountPrice -> Bool
Eq,Eq AmountPrice
Eq AmountPrice =>
(AmountPrice -> AmountPrice -> Ordering)
-> (AmountPrice -> AmountPrice -> Bool)
-> (AmountPrice -> AmountPrice -> Bool)
-> (AmountPrice -> AmountPrice -> Bool)
-> (AmountPrice -> AmountPrice -> Bool)
-> (AmountPrice -> AmountPrice -> AmountPrice)
-> (AmountPrice -> AmountPrice -> AmountPrice)
-> Ord AmountPrice
AmountPrice -> AmountPrice -> Bool
AmountPrice -> AmountPrice -> Ordering
AmountPrice -> AmountPrice -> AmountPrice
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
min :: AmountPrice -> AmountPrice -> AmountPrice
$cmin :: AmountPrice -> AmountPrice -> AmountPrice
max :: AmountPrice -> AmountPrice -> AmountPrice
$cmax :: AmountPrice -> AmountPrice -> AmountPrice
>= :: AmountPrice -> AmountPrice -> Bool
$c>= :: AmountPrice -> AmountPrice -> Bool
> :: AmountPrice -> AmountPrice -> Bool
$c> :: AmountPrice -> AmountPrice -> Bool
<= :: AmountPrice -> AmountPrice -> Bool
$c<= :: AmountPrice -> AmountPrice -> Bool
< :: AmountPrice -> AmountPrice -> Bool
$c< :: AmountPrice -> AmountPrice -> Bool
compare :: AmountPrice -> AmountPrice -> Ordering
$ccompare :: AmountPrice -> AmountPrice -> Ordering
$cp1Ord :: Eq AmountPrice
Ord,Typeable,Typeable AmountPrice
Constr
DataType
Typeable AmountPrice =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AmountPrice -> c AmountPrice)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AmountPrice)
-> (AmountPrice -> Constr)
-> (AmountPrice -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AmountPrice))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AmountPrice))
-> ((forall b. Data b => b -> b) -> AmountPrice -> AmountPrice)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AmountPrice -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AmountPrice -> r)
-> (forall u. (forall d. Data d => d -> u) -> AmountPrice -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AmountPrice -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AmountPrice -> m AmountPrice)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AmountPrice -> m AmountPrice)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AmountPrice -> m AmountPrice)
-> Data AmountPrice
AmountPrice -> Constr
AmountPrice -> DataType
(forall b. Data b => b -> b) -> AmountPrice -> AmountPrice
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AmountPrice -> c AmountPrice
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AmountPrice
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AmountPrice -> u
forall u. (forall d. Data d => d -> u) -> AmountPrice -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AmountPrice -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AmountPrice -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AmountPrice -> m AmountPrice
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AmountPrice -> m AmountPrice
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AmountPrice
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AmountPrice -> c AmountPrice
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AmountPrice)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AmountPrice)
$cTotalPrice :: Constr
$cUnitPrice :: Constr
$tAmountPrice :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AmountPrice -> m AmountPrice
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AmountPrice -> m AmountPrice
gmapMp :: (forall d. Data d => d -> m d) -> AmountPrice -> m AmountPrice
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AmountPrice -> m AmountPrice
gmapM :: (forall d. Data d => d -> m d) -> AmountPrice -> m AmountPrice
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AmountPrice -> m AmountPrice
gmapQi :: Int -> (forall d. Data d => d -> u) -> AmountPrice -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AmountPrice -> u
gmapQ :: (forall d. Data d => d -> u) -> AmountPrice -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AmountPrice -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AmountPrice -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AmountPrice -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AmountPrice -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AmountPrice -> r
gmapT :: (forall b. Data b => b -> b) -> AmountPrice -> AmountPrice
$cgmapT :: (forall b. Data b => b -> b) -> AmountPrice -> AmountPrice
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AmountPrice)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AmountPrice)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AmountPrice)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AmountPrice)
dataTypeOf :: AmountPrice -> DataType
$cdataTypeOf :: AmountPrice -> DataType
toConstr :: AmountPrice -> Constr
$ctoConstr :: AmountPrice -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AmountPrice
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AmountPrice
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AmountPrice -> c AmountPrice
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AmountPrice -> c AmountPrice
$cp1Data :: Typeable AmountPrice
Data,(forall x. AmountPrice -> Rep AmountPrice x)
-> (forall x. Rep AmountPrice x -> AmountPrice)
-> Generic AmountPrice
forall x. Rep AmountPrice x -> AmountPrice
forall x. AmountPrice -> Rep AmountPrice x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AmountPrice x -> AmountPrice
$cfrom :: forall x. AmountPrice -> Rep AmountPrice x
Generic,Int -> AmountPrice -> ShowS
[AmountPrice] -> ShowS
AmountPrice -> String
(Int -> AmountPrice -> ShowS)
-> (AmountPrice -> String)
-> ([AmountPrice] -> ShowS)
-> Show AmountPrice
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AmountPrice] -> ShowS
$cshowList :: [AmountPrice] -> ShowS
show :: AmountPrice -> String
$cshow :: AmountPrice -> String
showsPrec :: Int -> AmountPrice -> ShowS
$cshowsPrec :: Int -> AmountPrice -> ShowS
Show)

instance NFData AmountPrice

-- | Display style for an amount.
data AmountStyle = AmountStyle {
      AmountStyle -> Side
ascommodityside   :: Side,                 -- ^ does the symbol appear on the left or the right ?
      AmountStyle -> Bool
ascommodityspaced :: Bool,                 -- ^ space between symbol and quantity ?
      AmountStyle -> Int
asprecision       :: !Int,                 -- ^ number of digits displayed after the decimal point
      AmountStyle -> Maybe Char
asdecimalpoint    :: Maybe Char,           -- ^ character used as decimal point: period or comma. Nothing means "unspecified, use default"
      AmountStyle -> Maybe DigitGroupStyle
asdigitgroups     :: Maybe DigitGroupStyle -- ^ style for displaying digit groups, if any
} deriving (AmountStyle -> AmountStyle -> Bool
(AmountStyle -> AmountStyle -> Bool)
-> (AmountStyle -> AmountStyle -> Bool) -> Eq AmountStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AmountStyle -> AmountStyle -> Bool
$c/= :: AmountStyle -> AmountStyle -> Bool
== :: AmountStyle -> AmountStyle -> Bool
$c== :: 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
min :: AmountStyle -> AmountStyle -> AmountStyle
$cmin :: AmountStyle -> AmountStyle -> AmountStyle
max :: AmountStyle -> AmountStyle -> AmountStyle
$cmax :: AmountStyle -> AmountStyle -> AmountStyle
>= :: AmountStyle -> AmountStyle -> Bool
$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
compare :: AmountStyle -> AmountStyle -> Ordering
$ccompare :: AmountStyle -> AmountStyle -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [AmountStyle]
$creadListPrec :: ReadPrec [AmountStyle]
readPrec :: ReadPrec AmountStyle
$creadPrec :: ReadPrec AmountStyle
readList :: ReadS [AmountStyle]
$creadList :: ReadS [AmountStyle]
readsPrec :: Int -> ReadS AmountStyle
$creadsPrec :: Int -> ReadS AmountStyle
Read,Typeable,Typeable AmountStyle
Constr
DataType
Typeable AmountStyle =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> AmountStyle -> c AmountStyle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AmountStyle)
-> (AmountStyle -> Constr)
-> (AmountStyle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AmountStyle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AmountStyle))
-> ((forall b. Data b => b -> b) -> AmountStyle -> AmountStyle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> AmountStyle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> AmountStyle -> r)
-> (forall u. (forall d. Data d => d -> u) -> AmountStyle -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AmountStyle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> AmountStyle -> m AmountStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AmountStyle -> m AmountStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> AmountStyle -> m AmountStyle)
-> Data AmountStyle
AmountStyle -> Constr
AmountStyle -> DataType
(forall b. Data b => b -> b) -> AmountStyle -> AmountStyle
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AmountStyle -> c AmountStyle
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AmountStyle
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> AmountStyle -> u
forall u. (forall d. Data d => d -> u) -> AmountStyle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AmountStyle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AmountStyle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AmountStyle -> m AmountStyle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AmountStyle -> m AmountStyle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AmountStyle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AmountStyle -> c AmountStyle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AmountStyle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AmountStyle)
$cAmountStyle :: Constr
$tAmountStyle :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> AmountStyle -> m AmountStyle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AmountStyle -> m AmountStyle
gmapMp :: (forall d. Data d => d -> m d) -> AmountStyle -> m AmountStyle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> AmountStyle -> m AmountStyle
gmapM :: (forall d. Data d => d -> m d) -> AmountStyle -> m AmountStyle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> AmountStyle -> m AmountStyle
gmapQi :: Int -> (forall d. Data d => d -> u) -> AmountStyle -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> AmountStyle -> u
gmapQ :: (forall d. Data d => d -> u) -> AmountStyle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> AmountStyle -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AmountStyle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> AmountStyle -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AmountStyle -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> AmountStyle -> r
gmapT :: (forall b. Data b => b -> b) -> AmountStyle -> AmountStyle
$cgmapT :: (forall b. Data b => b -> b) -> AmountStyle -> AmountStyle
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AmountStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AmountStyle)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AmountStyle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AmountStyle)
dataTypeOf :: AmountStyle -> DataType
$cdataTypeOf :: AmountStyle -> DataType
toConstr :: AmountStyle -> Constr
$ctoConstr :: AmountStyle -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AmountStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AmountStyle
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AmountStyle -> c AmountStyle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> AmountStyle -> c AmountStyle
$cp1Data :: Typeable AmountStyle
Data,(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
$cto :: forall x. Rep AmountStyle x -> AmountStyle
$cfrom :: forall x. AmountStyle -> Rep AmountStyle x
Generic)

instance NFData AmountStyle

instance Show AmountStyle where
  show :: AmountStyle -> String
show AmountStyle{..} =
    String -> String -> String -> String -> String -> ShowS
forall r. PrintfType r => String -> r
printf "AmountStylePP \"%s %s %s %s %s..\""
    (Side -> String
forall a. Show a => a -> String
show Side
ascommodityside)
    (Bool -> String
forall a. Show a => a -> String
show Bool
ascommodityspaced)
    (Int -> String
forall a. Show a => a -> String
show Int
asprecision)
    (Maybe Char -> String
forall a. Show a => a -> String
show Maybe Char
asdecimalpoint)
    (Maybe DigitGroupStyle -> String
forall a. Show a => a -> String
show Maybe DigitGroupStyle
asdigitgroups)

-- | 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 [Int]
  deriving (DigitGroupStyle -> DigitGroupStyle -> Bool
(DigitGroupStyle -> DigitGroupStyle -> Bool)
-> (DigitGroupStyle -> DigitGroupStyle -> Bool)
-> Eq DigitGroupStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DigitGroupStyle -> DigitGroupStyle -> Bool
$c/= :: DigitGroupStyle -> DigitGroupStyle -> Bool
== :: DigitGroupStyle -> DigitGroupStyle -> Bool
$c== :: 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
min :: DigitGroupStyle -> DigitGroupStyle -> DigitGroupStyle
$cmin :: DigitGroupStyle -> DigitGroupStyle -> DigitGroupStyle
max :: DigitGroupStyle -> DigitGroupStyle -> DigitGroupStyle
$cmax :: DigitGroupStyle -> DigitGroupStyle -> DigitGroupStyle
>= :: DigitGroupStyle -> DigitGroupStyle -> Bool
$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
compare :: DigitGroupStyle -> DigitGroupStyle -> Ordering
$ccompare :: DigitGroupStyle -> DigitGroupStyle -> Ordering
$cp1Ord :: Eq 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
readListPrec :: ReadPrec [DigitGroupStyle]
$creadListPrec :: ReadPrec [DigitGroupStyle]
readPrec :: ReadPrec DigitGroupStyle
$creadPrec :: ReadPrec DigitGroupStyle
readList :: ReadS [DigitGroupStyle]
$creadList :: ReadS [DigitGroupStyle]
readsPrec :: Int -> ReadS DigitGroupStyle
$creadsPrec :: Int -> ReadS 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
showList :: [DigitGroupStyle] -> ShowS
$cshowList :: [DigitGroupStyle] -> ShowS
show :: DigitGroupStyle -> String
$cshow :: DigitGroupStyle -> String
showsPrec :: Int -> DigitGroupStyle -> ShowS
$cshowsPrec :: Int -> DigitGroupStyle -> ShowS
Show,Typeable,Typeable DigitGroupStyle
Constr
DataType
Typeable DigitGroupStyle =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DigitGroupStyle -> c DigitGroupStyle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DigitGroupStyle)
-> (DigitGroupStyle -> Constr)
-> (DigitGroupStyle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DigitGroupStyle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DigitGroupStyle))
-> ((forall b. Data b => b -> b)
    -> DigitGroupStyle -> DigitGroupStyle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DigitGroupStyle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DigitGroupStyle -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DigitGroupStyle -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DigitGroupStyle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DigitGroupStyle -> m DigitGroupStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DigitGroupStyle -> m DigitGroupStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DigitGroupStyle -> m DigitGroupStyle)
-> Data DigitGroupStyle
DigitGroupStyle -> Constr
DigitGroupStyle -> DataType
(forall b. Data b => b -> b) -> DigitGroupStyle -> DigitGroupStyle
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DigitGroupStyle -> c DigitGroupStyle
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DigitGroupStyle
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DigitGroupStyle -> u
forall u. (forall d. Data d => d -> u) -> DigitGroupStyle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DigitGroupStyle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DigitGroupStyle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DigitGroupStyle -> m DigitGroupStyle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DigitGroupStyle -> m DigitGroupStyle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DigitGroupStyle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DigitGroupStyle -> c DigitGroupStyle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DigitGroupStyle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DigitGroupStyle)
$cDigitGroups :: Constr
$tDigitGroupStyle :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> DigitGroupStyle -> m DigitGroupStyle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DigitGroupStyle -> m DigitGroupStyle
gmapMp :: (forall d. Data d => d -> m d)
-> DigitGroupStyle -> m DigitGroupStyle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DigitGroupStyle -> m DigitGroupStyle
gmapM :: (forall d. Data d => d -> m d)
-> DigitGroupStyle -> m DigitGroupStyle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DigitGroupStyle -> m DigitGroupStyle
gmapQi :: Int -> (forall d. Data d => d -> u) -> DigitGroupStyle -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DigitGroupStyle -> u
gmapQ :: (forall d. Data d => d -> u) -> DigitGroupStyle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DigitGroupStyle -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DigitGroupStyle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DigitGroupStyle -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DigitGroupStyle -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DigitGroupStyle -> r
gmapT :: (forall b. Data b => b -> b) -> DigitGroupStyle -> DigitGroupStyle
$cgmapT :: (forall b. Data b => b -> b) -> DigitGroupStyle -> DigitGroupStyle
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DigitGroupStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DigitGroupStyle)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c DigitGroupStyle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DigitGroupStyle)
dataTypeOf :: DigitGroupStyle -> DataType
$cdataTypeOf :: DigitGroupStyle -> DataType
toConstr :: DigitGroupStyle -> Constr
$ctoConstr :: DigitGroupStyle -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DigitGroupStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DigitGroupStyle
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DigitGroupStyle -> c DigitGroupStyle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DigitGroupStyle -> c DigitGroupStyle
$cp1Data :: Typeable DigitGroupStyle
Data,(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
$cto :: forall x. Rep DigitGroupStyle x -> DigitGroupStyle
$cfrom :: forall x. DigitGroupStyle -> Rep DigitGroupStyle x
Generic)

instance NFData DigitGroupStyle

type CommoditySymbol = Text

data Commodity = Commodity {
  Commodity -> CommoditySymbol
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
showList :: [Commodity] -> ShowS
$cshowList :: [Commodity] -> ShowS
show :: Commodity -> String
$cshow :: Commodity -> String
showsPrec :: Int -> Commodity -> ShowS
$cshowsPrec :: Int -> Commodity -> ShowS
Show,Commodity -> Commodity -> Bool
(Commodity -> Commodity -> Bool)
-> (Commodity -> Commodity -> Bool) -> Eq Commodity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Commodity -> Commodity -> Bool
$c/= :: Commodity -> Commodity -> Bool
== :: Commodity -> Commodity -> Bool
$c== :: Commodity -> Commodity -> Bool
Eq,Typeable Commodity
Constr
DataType
Typeable Commodity =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Commodity -> c Commodity)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Commodity)
-> (Commodity -> Constr)
-> (Commodity -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Commodity))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Commodity))
-> ((forall b. Data b => b -> b) -> Commodity -> Commodity)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Commodity -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Commodity -> r)
-> (forall u. (forall d. Data d => d -> u) -> Commodity -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Commodity -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Commodity -> m Commodity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Commodity -> m Commodity)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Commodity -> m Commodity)
-> Data Commodity
Commodity -> Constr
Commodity -> DataType
(forall b. Data b => b -> b) -> Commodity -> Commodity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Commodity -> c Commodity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Commodity
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Commodity -> u
forall u. (forall d. Data d => d -> u) -> Commodity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Commodity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Commodity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Commodity -> m Commodity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Commodity -> m Commodity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Commodity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Commodity -> c Commodity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Commodity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Commodity)
$cCommodity :: Constr
$tCommodity :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Commodity -> m Commodity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Commodity -> m Commodity
gmapMp :: (forall d. Data d => d -> m d) -> Commodity -> m Commodity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Commodity -> m Commodity
gmapM :: (forall d. Data d => d -> m d) -> Commodity -> m Commodity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Commodity -> m Commodity
gmapQi :: Int -> (forall d. Data d => d -> u) -> Commodity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Commodity -> u
gmapQ :: (forall d. Data d => d -> u) -> Commodity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Commodity -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Commodity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Commodity -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Commodity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Commodity -> r
gmapT :: (forall b. Data b => b -> b) -> Commodity -> Commodity
$cgmapT :: (forall b. Data b => b -> b) -> Commodity -> Commodity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Commodity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Commodity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Commodity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Commodity)
dataTypeOf :: Commodity -> DataType
$cdataTypeOf :: Commodity -> DataType
toConstr :: Commodity -> Constr
$ctoConstr :: Commodity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Commodity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Commodity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Commodity -> c Commodity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Commodity -> c Commodity
$cp1Data :: Typeable Commodity
Data,(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
$cto :: forall x. Rep Commodity x -> Commodity
$cfrom :: forall x. Commodity -> Rep Commodity x
Generic) --,Ord,Typeable,Data,Generic)

instance NFData Commodity

data Amount = Amount {
      Amount -> CommoditySymbol
acommodity  :: CommoditySymbol,   -- commodity symbol, or special value "AUTO"
      Amount -> DecimalRaw Integer
aquantity   :: Quantity,          -- numeric quantity, or zero in case of "AUTO"
      Amount -> Bool
aismultiplier :: Bool,            -- ^ kludge: a flag marking this amount and posting as a multiplier
                                        --   in a TMPostingRule. In a regular Posting, should always be false.
      Amount -> AmountStyle
astyle      :: AmountStyle,
      Amount -> Maybe AmountPrice
aprice      :: Maybe AmountPrice  -- ^ the (fixed, transaction-specific) price for 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
/= :: Amount -> Amount -> Bool
$c/= :: Amount -> Amount -> Bool
== :: Amount -> Amount -> Bool
$c== :: 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
min :: Amount -> Amount -> Amount
$cmin :: Amount -> Amount -> Amount
max :: Amount -> Amount -> Amount
$cmax :: Amount -> Amount -> Amount
>= :: Amount -> Amount -> Bool
$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
compare :: Amount -> Amount -> Ordering
$ccompare :: Amount -> Amount -> Ordering
$cp1Ord :: Eq Amount
Ord,Typeable,Typeable Amount
Constr
DataType
Typeable Amount =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Amount -> c Amount)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Amount)
-> (Amount -> Constr)
-> (Amount -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Amount))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Amount))
-> ((forall b. Data b => b -> b) -> Amount -> Amount)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Amount -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Amount -> r)
-> (forall u. (forall d. Data d => d -> u) -> Amount -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Amount -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Amount -> m Amount)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Amount -> m Amount)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Amount -> m Amount)
-> Data Amount
Amount -> Constr
Amount -> DataType
(forall b. Data b => b -> b) -> Amount -> Amount
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Amount -> c Amount
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Amount
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Amount -> u
forall u. (forall d. Data d => d -> u) -> Amount -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Amount -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Amount -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Amount -> m Amount
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Amount -> m Amount
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Amount
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Amount -> c Amount
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Amount)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Amount)
$cAmount :: Constr
$tAmount :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Amount -> m Amount
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Amount -> m Amount
gmapMp :: (forall d. Data d => d -> m d) -> Amount -> m Amount
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Amount -> m Amount
gmapM :: (forall d. Data d => d -> m d) -> Amount -> m Amount
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Amount -> m Amount
gmapQi :: Int -> (forall d. Data d => d -> u) -> Amount -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Amount -> u
gmapQ :: (forall d. Data d => d -> u) -> Amount -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Amount -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Amount -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Amount -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Amount -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Amount -> r
gmapT :: (forall b. Data b => b -> b) -> Amount -> Amount
$cgmapT :: (forall b. Data b => b -> b) -> Amount -> Amount
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Amount)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Amount)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Amount)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Amount)
dataTypeOf :: Amount -> DataType
$cdataTypeOf :: Amount -> DataType
toConstr :: Amount -> Constr
$ctoConstr :: Amount -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Amount
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Amount
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Amount -> c Amount
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Amount -> c Amount
$cp1Data :: Typeable Amount
Data,(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
$cto :: forall x. Rep Amount x -> Amount
$cfrom :: forall x. Amount -> Rep Amount x
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
showList :: [Amount] -> ShowS
$cshowList :: [Amount] -> ShowS
show :: Amount -> String
$cshow :: Amount -> String
showsPrec :: Int -> Amount -> ShowS
$cshowsPrec :: Int -> Amount -> ShowS
Show)

instance NFData Amount

newtype MixedAmount = Mixed [Amount] deriving (MixedAmount -> MixedAmount -> Bool
(MixedAmount -> MixedAmount -> Bool)
-> (MixedAmount -> MixedAmount -> Bool) -> Eq MixedAmount
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MixedAmount -> MixedAmount -> Bool
$c/= :: MixedAmount -> MixedAmount -> Bool
== :: MixedAmount -> MixedAmount -> Bool
$c== :: MixedAmount -> MixedAmount -> Bool
Eq,Eq MixedAmount
Eq MixedAmount =>
(MixedAmount -> MixedAmount -> Ordering)
-> (MixedAmount -> MixedAmount -> Bool)
-> (MixedAmount -> MixedAmount -> Bool)
-> (MixedAmount -> MixedAmount -> Bool)
-> (MixedAmount -> MixedAmount -> Bool)
-> (MixedAmount -> MixedAmount -> MixedAmount)
-> (MixedAmount -> MixedAmount -> MixedAmount)
-> Ord MixedAmount
MixedAmount -> MixedAmount -> Bool
MixedAmount -> MixedAmount -> Ordering
MixedAmount -> MixedAmount -> MixedAmount
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
min :: MixedAmount -> MixedAmount -> MixedAmount
$cmin :: MixedAmount -> MixedAmount -> MixedAmount
max :: MixedAmount -> MixedAmount -> MixedAmount
$cmax :: MixedAmount -> MixedAmount -> MixedAmount
>= :: MixedAmount -> MixedAmount -> Bool
$c>= :: MixedAmount -> MixedAmount -> Bool
> :: MixedAmount -> MixedAmount -> Bool
$c> :: MixedAmount -> MixedAmount -> Bool
<= :: MixedAmount -> MixedAmount -> Bool
$c<= :: MixedAmount -> MixedAmount -> Bool
< :: MixedAmount -> MixedAmount -> Bool
$c< :: MixedAmount -> MixedAmount -> Bool
compare :: MixedAmount -> MixedAmount -> Ordering
$ccompare :: MixedAmount -> MixedAmount -> Ordering
$cp1Ord :: Eq MixedAmount
Ord,Typeable,Typeable MixedAmount
Constr
DataType
Typeable MixedAmount =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> MixedAmount -> c MixedAmount)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MixedAmount)
-> (MixedAmount -> Constr)
-> (MixedAmount -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MixedAmount))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MixedAmount))
-> ((forall b. Data b => b -> b) -> MixedAmount -> MixedAmount)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MixedAmount -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MixedAmount -> r)
-> (forall u. (forall d. Data d => d -> u) -> MixedAmount -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MixedAmount -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MixedAmount -> m MixedAmount)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MixedAmount -> m MixedAmount)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MixedAmount -> m MixedAmount)
-> Data MixedAmount
MixedAmount -> Constr
MixedAmount -> DataType
(forall b. Data b => b -> b) -> MixedAmount -> MixedAmount
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MixedAmount -> c MixedAmount
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MixedAmount
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MixedAmount -> u
forall u. (forall d. Data d => d -> u) -> MixedAmount -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MixedAmount -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MixedAmount -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MixedAmount -> m MixedAmount
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MixedAmount -> m MixedAmount
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MixedAmount
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MixedAmount -> c MixedAmount
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MixedAmount)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MixedAmount)
$cMixed :: Constr
$tMixedAmount :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> MixedAmount -> m MixedAmount
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MixedAmount -> m MixedAmount
gmapMp :: (forall d. Data d => d -> m d) -> MixedAmount -> m MixedAmount
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MixedAmount -> m MixedAmount
gmapM :: (forall d. Data d => d -> m d) -> MixedAmount -> m MixedAmount
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MixedAmount -> m MixedAmount
gmapQi :: Int -> (forall d. Data d => d -> u) -> MixedAmount -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MixedAmount -> u
gmapQ :: (forall d. Data d => d -> u) -> MixedAmount -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MixedAmount -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MixedAmount -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MixedAmount -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MixedAmount -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MixedAmount -> r
gmapT :: (forall b. Data b => b -> b) -> MixedAmount -> MixedAmount
$cgmapT :: (forall b. Data b => b -> b) -> MixedAmount -> MixedAmount
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MixedAmount)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MixedAmount)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MixedAmount)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MixedAmount)
dataTypeOf :: MixedAmount -> DataType
$cdataTypeOf :: MixedAmount -> DataType
toConstr :: MixedAmount -> Constr
$ctoConstr :: MixedAmount -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MixedAmount
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MixedAmount
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MixedAmount -> c MixedAmount
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MixedAmount -> c MixedAmount
$cp1Data :: Typeable MixedAmount
Data,(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
$cto :: forall x. Rep MixedAmount x -> MixedAmount
$cfrom :: forall x. MixedAmount -> Rep MixedAmount x
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
showList :: [MixedAmount] -> ShowS
$cshowList :: [MixedAmount] -> ShowS
show :: MixedAmount -> String
$cshow :: MixedAmount -> String
showsPrec :: Int -> MixedAmount -> ShowS
$cshowsPrec :: Int -> MixedAmount -> ShowS
Show)

instance NFData MixedAmount

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
/= :: PostingType -> PostingType -> Bool
$c/= :: PostingType -> PostingType -> Bool
== :: PostingType -> PostingType -> Bool
$c== :: 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
showList :: [PostingType] -> ShowS
$cshowList :: [PostingType] -> ShowS
show :: PostingType -> String
$cshow :: PostingType -> String
showsPrec :: Int -> PostingType -> ShowS
$cshowsPrec :: Int -> PostingType -> ShowS
Show,Typeable,Typeable PostingType
Constr
DataType
Typeable PostingType =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PostingType -> c PostingType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PostingType)
-> (PostingType -> Constr)
-> (PostingType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PostingType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PostingType))
-> ((forall b. Data b => b -> b) -> PostingType -> PostingType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PostingType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PostingType -> r)
-> (forall u. (forall d. Data d => d -> u) -> PostingType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PostingType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PostingType -> m PostingType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PostingType -> m PostingType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PostingType -> m PostingType)
-> Data PostingType
PostingType -> Constr
PostingType -> DataType
(forall b. Data b => b -> b) -> PostingType -> PostingType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PostingType -> c PostingType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PostingType
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> PostingType -> u
forall u. (forall d. Data d => d -> u) -> PostingType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PostingType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PostingType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PostingType -> m PostingType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PostingType -> m PostingType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PostingType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PostingType -> c PostingType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PostingType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PostingType)
$cBalancedVirtualPosting :: Constr
$cVirtualPosting :: Constr
$cRegularPosting :: Constr
$tPostingType :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> PostingType -> m PostingType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PostingType -> m PostingType
gmapMp :: (forall d. Data d => d -> m d) -> PostingType -> m PostingType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PostingType -> m PostingType
gmapM :: (forall d. Data d => d -> m d) -> PostingType -> m PostingType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PostingType -> m PostingType
gmapQi :: Int -> (forall d. Data d => d -> u) -> PostingType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PostingType -> u
gmapQ :: (forall d. Data d => d -> u) -> PostingType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PostingType -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PostingType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PostingType -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PostingType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PostingType -> r
gmapT :: (forall b. Data b => b -> b) -> PostingType -> PostingType
$cgmapT :: (forall b. Data b => b -> b) -> PostingType -> PostingType
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PostingType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PostingType)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PostingType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PostingType)
dataTypeOf :: PostingType -> DataType
$cdataTypeOf :: PostingType -> DataType
toConstr :: PostingType -> Constr
$ctoConstr :: PostingType -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PostingType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PostingType
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PostingType -> c PostingType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PostingType -> c PostingType
$cp1Data :: Typeable PostingType
Data,(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
$cto :: forall x. Rep PostingType x -> PostingType
$cfrom :: forall x. PostingType -> Rep PostingType x
Generic)

instance NFData PostingType

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

-- | 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
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: 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
min :: Status -> Status -> Status
$cmin :: Status -> Status -> Status
max :: Status -> Status -> Status
$cmax :: Status -> Status -> Status
>= :: Status -> Status -> Bool
$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
compare :: Status -> Status -> Ordering
$ccompare :: Status -> Status -> Ordering
$cp1Ord :: Eq Status
Ord,Status
Status -> Status -> Bounded Status
forall a. a -> a -> Bounded a
maxBound :: Status
$cmaxBound :: Status
minBound :: Status
$cminBound :: 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
enumFromThenTo :: Status -> Status -> Status -> [Status]
$cenumFromThenTo :: Status -> Status -> Status -> [Status]
enumFromTo :: Status -> Status -> [Status]
$cenumFromTo :: Status -> Status -> [Status]
enumFromThen :: Status -> Status -> [Status]
$cenumFromThen :: Status -> Status -> [Status]
enumFrom :: Status -> [Status]
$cenumFrom :: Status -> [Status]
fromEnum :: Status -> Int
$cfromEnum :: Status -> Int
toEnum :: Int -> Status
$ctoEnum :: Int -> Status
pred :: Status -> Status
$cpred :: Status -> Status
succ :: Status -> Status
$csucc :: Status -> Status
Enum,Typeable,Typeable Status
Constr
DataType
Typeable Status =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Status -> c Status)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Status)
-> (Status -> Constr)
-> (Status -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Status))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Status))
-> ((forall b. Data b => b -> b) -> Status -> Status)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Status -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Status -> r)
-> (forall u. (forall d. Data d => d -> u) -> Status -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Status -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Status -> m Status)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Status -> m Status)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Status -> m Status)
-> Data Status
Status -> Constr
Status -> DataType
(forall b. Data b => b -> b) -> Status -> Status
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Status -> c Status
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Status
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Status -> u
forall u. (forall d. Data d => d -> u) -> Status -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Status -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Status -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Status -> m Status
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Status -> m Status
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Status
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Status -> c Status
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Status)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Status)
$cCleared :: Constr
$cPending :: Constr
$cUnmarked :: Constr
$tStatus :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Status -> m Status
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Status -> m Status
gmapMp :: (forall d. Data d => d -> m d) -> Status -> m Status
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Status -> m Status
gmapM :: (forall d. Data d => d -> m d) -> Status -> m Status
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Status -> m Status
gmapQi :: Int -> (forall d. Data d => d -> u) -> Status -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Status -> u
gmapQ :: (forall d. Data d => d -> u) -> Status -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Status -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Status -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Status -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Status -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Status -> r
gmapT :: (forall b. Data b => b -> b) -> Status -> Status
$cgmapT :: (forall b. Data b => b -> b) -> Status -> Status
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Status)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Status)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Status)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Status)
dataTypeOf :: Status -> DataType
$cdataTypeOf :: Status -> DataType
toConstr :: Status -> Constr
$ctoConstr :: Status -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Status
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Status
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Status -> c Status
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Status -> c Status
$cp1Data :: Typeable Status
Data,(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
$cto :: forall x. Rep Status x -> Status
$cfrom :: forall x. Status -> Rep Status x
Generic)

instance NFData Status

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

-- | 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.
--
-- The 'BalanceAssertion' type is also used to represent balance assignments,
-- which instruct hledger what an account's balance should become at a certain
-- point.
--
-- Different kinds of balance assertions are discussed eg on #290.
-- Variables include:
--
-- - which postings are to be summed (real/virtual; unmarked/pending/cleared; this account/this account including subs)
--
-- - which commodities within the balance are to be checked
--
-- - whether to do a partial or a total check (disallowing other commodities)
--
-- I suspect we want:
--
-- 1. partial, subaccount-exclusive, Ledger-compatible assertions. Because
--    they're what we've always had, and removing them would break some
--    journals unnecessarily.  Implemented with = syntax.
--
-- 2. total assertions. Because otherwise assertions are a bit leaky.
--    Implemented with == syntax.
--
-- 3. subaccount-inclusive assertions. Because that's something folks need.
--    Not implemented.
--
-- 4. flexible assertions allowing custom criteria (perhaps arbitrary
--    queries). Because power users have diverse needs and want to try out
--    different schemes (assert cleared balances, assert balance from real or
--    virtual postings, etc.). Not implemented.
--
-- 5. multicommodity assertions, asserting the balance of multiple commodities
--    at once. Not implemented, requires #934.
--
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 -> GenericSourcePos
baposition  :: GenericSourcePos    -- ^ 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
/= :: BalanceAssertion -> BalanceAssertion -> Bool
$c/= :: BalanceAssertion -> BalanceAssertion -> Bool
== :: BalanceAssertion -> BalanceAssertion -> Bool
$c== :: BalanceAssertion -> BalanceAssertion -> Bool
Eq,Typeable,Typeable BalanceAssertion
Constr
DataType
Typeable BalanceAssertion =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> BalanceAssertion -> c BalanceAssertion)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c BalanceAssertion)
-> (BalanceAssertion -> Constr)
-> (BalanceAssertion -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c BalanceAssertion))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c BalanceAssertion))
-> ((forall b. Data b => b -> b)
    -> BalanceAssertion -> BalanceAssertion)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> BalanceAssertion -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> BalanceAssertion -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> BalanceAssertion -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> BalanceAssertion -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> BalanceAssertion -> m BalanceAssertion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> BalanceAssertion -> m BalanceAssertion)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> BalanceAssertion -> m BalanceAssertion)
-> Data BalanceAssertion
BalanceAssertion -> Constr
BalanceAssertion -> DataType
(forall b. Data b => b -> b)
-> BalanceAssertion -> BalanceAssertion
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BalanceAssertion -> c BalanceAssertion
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BalanceAssertion
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> BalanceAssertion -> u
forall u. (forall d. Data d => d -> u) -> BalanceAssertion -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BalanceAssertion -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BalanceAssertion -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BalanceAssertion -> m BalanceAssertion
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BalanceAssertion -> m BalanceAssertion
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BalanceAssertion
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BalanceAssertion -> c BalanceAssertion
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BalanceAssertion)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BalanceAssertion)
$cBalanceAssertion :: Constr
$tBalanceAssertion :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> BalanceAssertion -> m BalanceAssertion
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BalanceAssertion -> m BalanceAssertion
gmapMp :: (forall d. Data d => d -> m d)
-> BalanceAssertion -> m BalanceAssertion
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> BalanceAssertion -> m BalanceAssertion
gmapM :: (forall d. Data d => d -> m d)
-> BalanceAssertion -> m BalanceAssertion
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> BalanceAssertion -> m BalanceAssertion
gmapQi :: Int -> (forall d. Data d => d -> u) -> BalanceAssertion -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> BalanceAssertion -> u
gmapQ :: (forall d. Data d => d -> u) -> BalanceAssertion -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> BalanceAssertion -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BalanceAssertion -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> BalanceAssertion -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BalanceAssertion -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> BalanceAssertion -> r
gmapT :: (forall b. Data b => b -> b)
-> BalanceAssertion -> BalanceAssertion
$cgmapT :: (forall b. Data b => b -> b)
-> BalanceAssertion -> BalanceAssertion
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BalanceAssertion)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c BalanceAssertion)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c BalanceAssertion)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c BalanceAssertion)
dataTypeOf :: BalanceAssertion -> DataType
$cdataTypeOf :: BalanceAssertion -> DataType
toConstr :: BalanceAssertion -> Constr
$ctoConstr :: BalanceAssertion -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BalanceAssertion
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c BalanceAssertion
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BalanceAssertion -> c BalanceAssertion
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> BalanceAssertion -> c BalanceAssertion
$cp1Data :: Typeable BalanceAssertion
Data,(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
$cto :: forall x. Rep BalanceAssertion x -> BalanceAssertion
$cfrom :: forall x. BalanceAssertion -> Rep BalanceAssertion x
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
showList :: [BalanceAssertion] -> ShowS
$cshowList :: [BalanceAssertion] -> ShowS
show :: BalanceAssertion -> String
$cshow :: BalanceAssertion -> String
showsPrec :: Int -> BalanceAssertion -> ShowS
$cshowsPrec :: Int -> BalanceAssertion -> ShowS
Show)

instance NFData BalanceAssertion

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 -> CommoditySymbol
paccount          :: AccountName,
      Posting -> MixedAmount
pamount           :: MixedAmount,
      Posting -> CommoditySymbol
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 comment
      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 price 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 (Typeable,Typeable Posting
Constr
DataType
Typeable Posting =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Posting -> c Posting)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Posting)
-> (Posting -> Constr)
-> (Posting -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Posting))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Posting))
-> ((forall b. Data b => b -> b) -> Posting -> Posting)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Posting -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Posting -> r)
-> (forall u. (forall d. Data d => d -> u) -> Posting -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Posting -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Posting -> m Posting)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Posting -> m Posting)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Posting -> m Posting)
-> Data Posting
Posting -> Constr
Posting -> DataType
(forall b. Data b => b -> b) -> Posting -> Posting
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Posting -> c Posting
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Posting
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Posting -> u
forall u. (forall d. Data d => d -> u) -> Posting -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Posting -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Posting -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Posting -> m Posting
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Posting -> m Posting
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Posting
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Posting -> c Posting
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Posting)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Posting)
$cPosting :: Constr
$tPosting :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Posting -> m Posting
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Posting -> m Posting
gmapMp :: (forall d. Data d => d -> m d) -> Posting -> m Posting
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Posting -> m Posting
gmapM :: (forall d. Data d => d -> m d) -> Posting -> m Posting
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Posting -> m Posting
gmapQi :: Int -> (forall d. Data d => d -> u) -> Posting -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Posting -> u
gmapQ :: (forall d. Data d => d -> u) -> Posting -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Posting -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Posting -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Posting -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Posting -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Posting -> r
gmapT :: (forall b. Data b => b -> b) -> Posting -> Posting
$cgmapT :: (forall b. Data b => b -> b) -> Posting -> Posting
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Posting)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Posting)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Posting)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Posting)
dataTypeOf :: Posting -> DataType
$cdataTypeOf :: Posting -> DataType
toConstr :: Posting -> Constr
$ctoConstr :: Posting -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Posting
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Posting
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Posting -> c Posting
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Posting -> c Posting
$cp1Data :: Typeable Posting
Data,(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
$cto :: forall x. Rep Posting x -> Posting
$cfrom :: forall x. Posting -> Rep Posting x
Generic)

instance NFData Posting

-- 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 a1 :: Maybe Day
a1 b1 :: Maybe Day
b1 c1 :: Status
c1 d1 :: CommoditySymbol
d1 e1 :: MixedAmount
e1 f1 :: CommoditySymbol
f1 g1 :: PostingType
g1 h1 :: [Tag]
h1 i1 :: Maybe BalanceAssertion
i1 _ _) (Posting a2 :: Maybe Day
a2 b2 :: Maybe Day
b2 c2 :: Status
c2 d2 :: CommoditySymbol
d2 e2 :: MixedAmount
e2 f2 :: CommoditySymbol
f2 g2 :: PostingType
g2 h2 :: [Tag]
h2 i2 :: Maybe BalanceAssertion
i2 _ _) =  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
&& CommoditySymbol
d1CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
==CommoditySymbol
d2 Bool -> Bool -> Bool
&& MixedAmount
e1MixedAmount -> MixedAmount -> Bool
forall a. Eq a => a -> a -> Bool
==MixedAmount
e2 Bool -> Bool -> Bool
&& CommoditySymbol
f1CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
==CommoditySymbol
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{..} = "PostingPP {" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " [
     "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)
    ,"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)
    ,"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)
    ,"paccount="          String -> ShowS
forall a. [a] -> [a] -> [a]
++ CommoditySymbol -> String
forall a. Show a => a -> String
show CommoditySymbol
paccount
    ,"pamount="           String -> ShowS
forall a. [a] -> [a] -> [a]
++ MixedAmount -> String
forall a. Show a => a -> String
show MixedAmount
pamount
    ,"pcomment="          String -> ShowS
forall a. [a] -> [a] -> [a]
++ CommoditySymbol -> String
forall a. Show a => a -> String
show CommoditySymbol
pcomment
    ,"ptype="             String -> ShowS
forall a. [a] -> [a] -> [a]
++ PostingType -> String
forall a. Show a => a -> String
show PostingType
ptype
    ,"ptags="             String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Tag] -> String
forall a. Show a => a -> String
show [Tag]
ptags
    ,"pbalanceassertion=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Maybe BalanceAssertion -> String
forall a. Show a => a -> String
show Maybe BalanceAssertion
pbalanceassertion
    ,"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
$> "txn")
    ,"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]
++ "}"

-- TODO: needs renaming, or removal if no longer needed. See also TextPosition in Hledger.UI.Editor
-- | The position of parse errors (eg), like parsec's SourcePos but generic.
data GenericSourcePos = GenericSourcePos FilePath Int Int    -- ^ file path, 1-based line number and 1-based column number.
                      | JournalSourcePos FilePath (Int, Int) -- ^ file path, inclusive range of 1-based line numbers (first, last).
  deriving (GenericSourcePos -> GenericSourcePos -> Bool
(GenericSourcePos -> GenericSourcePos -> Bool)
-> (GenericSourcePos -> GenericSourcePos -> Bool)
-> Eq GenericSourcePos
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GenericSourcePos -> GenericSourcePos -> Bool
$c/= :: GenericSourcePos -> GenericSourcePos -> Bool
== :: GenericSourcePos -> GenericSourcePos -> Bool
$c== :: GenericSourcePos -> GenericSourcePos -> Bool
Eq, ReadPrec [GenericSourcePos]
ReadPrec GenericSourcePos
Int -> ReadS GenericSourcePos
ReadS [GenericSourcePos]
(Int -> ReadS GenericSourcePos)
-> ReadS [GenericSourcePos]
-> ReadPrec GenericSourcePos
-> ReadPrec [GenericSourcePos]
-> Read GenericSourcePos
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GenericSourcePos]
$creadListPrec :: ReadPrec [GenericSourcePos]
readPrec :: ReadPrec GenericSourcePos
$creadPrec :: ReadPrec GenericSourcePos
readList :: ReadS [GenericSourcePos]
$creadList :: ReadS [GenericSourcePos]
readsPrec :: Int -> ReadS GenericSourcePos
$creadsPrec :: Int -> ReadS GenericSourcePos
Read, Int -> GenericSourcePos -> ShowS
[GenericSourcePos] -> ShowS
GenericSourcePos -> String
(Int -> GenericSourcePos -> ShowS)
-> (GenericSourcePos -> String)
-> ([GenericSourcePos] -> ShowS)
-> Show GenericSourcePos
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenericSourcePos] -> ShowS
$cshowList :: [GenericSourcePos] -> ShowS
show :: GenericSourcePos -> String
$cshow :: GenericSourcePos -> String
showsPrec :: Int -> GenericSourcePos -> ShowS
$cshowsPrec :: Int -> GenericSourcePos -> ShowS
Show, Eq GenericSourcePos
Eq GenericSourcePos =>
(GenericSourcePos -> GenericSourcePos -> Ordering)
-> (GenericSourcePos -> GenericSourcePos -> Bool)
-> (GenericSourcePos -> GenericSourcePos -> Bool)
-> (GenericSourcePos -> GenericSourcePos -> Bool)
-> (GenericSourcePos -> GenericSourcePos -> Bool)
-> (GenericSourcePos -> GenericSourcePos -> GenericSourcePos)
-> (GenericSourcePos -> GenericSourcePos -> GenericSourcePos)
-> Ord GenericSourcePos
GenericSourcePos -> GenericSourcePos -> Bool
GenericSourcePos -> GenericSourcePos -> Ordering
GenericSourcePos -> GenericSourcePos -> GenericSourcePos
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
min :: GenericSourcePos -> GenericSourcePos -> GenericSourcePos
$cmin :: GenericSourcePos -> GenericSourcePos -> GenericSourcePos
max :: GenericSourcePos -> GenericSourcePos -> GenericSourcePos
$cmax :: GenericSourcePos -> GenericSourcePos -> GenericSourcePos
>= :: GenericSourcePos -> GenericSourcePos -> Bool
$c>= :: GenericSourcePos -> GenericSourcePos -> Bool
> :: GenericSourcePos -> GenericSourcePos -> Bool
$c> :: GenericSourcePos -> GenericSourcePos -> Bool
<= :: GenericSourcePos -> GenericSourcePos -> Bool
$c<= :: GenericSourcePos -> GenericSourcePos -> Bool
< :: GenericSourcePos -> GenericSourcePos -> Bool
$c< :: GenericSourcePos -> GenericSourcePos -> Bool
compare :: GenericSourcePos -> GenericSourcePos -> Ordering
$ccompare :: GenericSourcePos -> GenericSourcePos -> Ordering
$cp1Ord :: Eq GenericSourcePos
Ord, Typeable GenericSourcePos
Constr
DataType
Typeable GenericSourcePos =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> GenericSourcePos -> c GenericSourcePos)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c GenericSourcePos)
-> (GenericSourcePos -> Constr)
-> (GenericSourcePos -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c GenericSourcePos))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c GenericSourcePos))
-> ((forall b. Data b => b -> b)
    -> GenericSourcePos -> GenericSourcePos)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> GenericSourcePos -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> GenericSourcePos -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> GenericSourcePos -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> GenericSourcePos -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> GenericSourcePos -> m GenericSourcePos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GenericSourcePos -> m GenericSourcePos)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> GenericSourcePos -> m GenericSourcePos)
-> Data GenericSourcePos
GenericSourcePos -> Constr
GenericSourcePos -> DataType
(forall b. Data b => b -> b)
-> GenericSourcePos -> GenericSourcePos
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenericSourcePos -> c GenericSourcePos
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericSourcePos
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> GenericSourcePos -> u
forall u. (forall d. Data d => d -> u) -> GenericSourcePos -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenericSourcePos -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenericSourcePos -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GenericSourcePos -> m GenericSourcePos
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenericSourcePos -> m GenericSourcePos
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericSourcePos
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenericSourcePos -> c GenericSourcePos
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenericSourcePos)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericSourcePos)
$cJournalSourcePos :: Constr
$cGenericSourcePos :: Constr
$tGenericSourcePos :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> GenericSourcePos -> m GenericSourcePos
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenericSourcePos -> m GenericSourcePos
gmapMp :: (forall d. Data d => d -> m d)
-> GenericSourcePos -> m GenericSourcePos
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> GenericSourcePos -> m GenericSourcePos
gmapM :: (forall d. Data d => d -> m d)
-> GenericSourcePos -> m GenericSourcePos
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> GenericSourcePos -> m GenericSourcePos
gmapQi :: Int -> (forall d. Data d => d -> u) -> GenericSourcePos -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> GenericSourcePos -> u
gmapQ :: (forall d. Data d => d -> u) -> GenericSourcePos -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> GenericSourcePos -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenericSourcePos -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> GenericSourcePos -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenericSourcePos -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> GenericSourcePos -> r
gmapT :: (forall b. Data b => b -> b)
-> GenericSourcePos -> GenericSourcePos
$cgmapT :: (forall b. Data b => b -> b)
-> GenericSourcePos -> GenericSourcePos
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericSourcePos)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c GenericSourcePos)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c GenericSourcePos)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c GenericSourcePos)
dataTypeOf :: GenericSourcePos -> DataType
$cdataTypeOf :: GenericSourcePos -> DataType
toConstr :: GenericSourcePos -> Constr
$ctoConstr :: GenericSourcePos -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericSourcePos
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c GenericSourcePos
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenericSourcePos -> c GenericSourcePos
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> GenericSourcePos -> c GenericSourcePos
$cp1Data :: Typeable GenericSourcePos
Data, (forall x. GenericSourcePos -> Rep GenericSourcePos x)
-> (forall x. Rep GenericSourcePos x -> GenericSourcePos)
-> Generic GenericSourcePos
forall x. Rep GenericSourcePos x -> GenericSourcePos
forall x. GenericSourcePos -> Rep GenericSourcePos x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GenericSourcePos x -> GenericSourcePos
$cfrom :: forall x. GenericSourcePos -> Rep GenericSourcePos x
Generic, Typeable)

instance NFData GenericSourcePos

--{-# ANN Transaction "HLint: ignore" #-}
--    Ambiguous type variable ‘p0’ arising from an annotation
--    prevents the constraint ‘(Data p0)’ from being solved.
--    Probable fix: use a type annotation to specify what ‘p0’ should be.
data Transaction = Transaction {
      Transaction -> Integer
tindex                   :: Integer,   -- ^ this transaction's 1-based position in the transaction stream, or 0 when not available
      Transaction -> CommoditySymbol
tprecedingcomment        :: Text,      -- ^ any comment lines immediately preceding this transaction
      Transaction -> GenericSourcePos
tsourcepos               :: GenericSourcePos,  -- ^ the file position where the date starts
      Transaction -> Day
tdate                    :: Day,
      Transaction -> Maybe Day
tdate2                   :: Maybe Day,
      Transaction -> Status
tstatus                  :: Status,
      Transaction -> CommoditySymbol
tcode                    :: Text,
      Transaction -> CommoditySymbol
tdescription             :: Text,
      Transaction -> CommoditySymbol
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
/= :: Transaction -> Transaction -> Bool
$c/= :: Transaction -> Transaction -> Bool
== :: Transaction -> Transaction -> Bool
$c== :: Transaction -> Transaction -> Bool
Eq,Typeable,Typeable Transaction
Constr
DataType
Typeable Transaction =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Transaction -> c Transaction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Transaction)
-> (Transaction -> Constr)
-> (Transaction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Transaction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Transaction))
-> ((forall b. Data b => b -> b) -> Transaction -> Transaction)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Transaction -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Transaction -> r)
-> (forall u. (forall d. Data d => d -> u) -> Transaction -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Transaction -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Transaction -> m Transaction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Transaction -> m Transaction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Transaction -> m Transaction)
-> Data Transaction
Transaction -> Constr
Transaction -> DataType
(forall b. Data b => b -> b) -> Transaction -> Transaction
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Transaction -> c Transaction
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Transaction
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Transaction -> u
forall u. (forall d. Data d => d -> u) -> Transaction -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Transaction -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Transaction -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Transaction -> m Transaction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Transaction -> m Transaction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Transaction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Transaction -> c Transaction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Transaction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Transaction)
$cTransaction :: Constr
$tTransaction :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Transaction -> m Transaction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Transaction -> m Transaction
gmapMp :: (forall d. Data d => d -> m d) -> Transaction -> m Transaction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Transaction -> m Transaction
gmapM :: (forall d. Data d => d -> m d) -> Transaction -> m Transaction
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Transaction -> m Transaction
gmapQi :: Int -> (forall d. Data d => d -> u) -> Transaction -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Transaction -> u
gmapQ :: (forall d. Data d => d -> u) -> Transaction -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Transaction -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Transaction -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Transaction -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Transaction -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Transaction -> r
gmapT :: (forall b. Data b => b -> b) -> Transaction -> Transaction
$cgmapT :: (forall b. Data b => b -> b) -> Transaction -> Transaction
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Transaction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Transaction)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Transaction)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Transaction)
dataTypeOf :: Transaction -> DataType
$cdataTypeOf :: Transaction -> DataType
toConstr :: Transaction -> Constr
$ctoConstr :: Transaction -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Transaction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Transaction
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Transaction -> c Transaction
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Transaction -> c Transaction
$cp1Data :: Typeable Transaction
Data,(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
$cto :: forall x. Rep Transaction x -> Transaction
$cfrom :: forall x. Transaction -> Rep Transaction x
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
showList :: [Transaction] -> ShowS
$cshowList :: [Transaction] -> ShowS
show :: Transaction -> String
$cshow :: Transaction -> String
showsPrec :: Int -> Transaction -> ShowS
$cshowsPrec :: Int -> Transaction -> ShowS
Show)

instance NFData Transaction

-- | 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 -> CommoditySymbol
tmquerytxt :: Text,
      TransactionModifier -> [Posting]
tmpostingrules :: [TMPostingRule]
    } deriving (TransactionModifier -> TransactionModifier -> Bool
(TransactionModifier -> TransactionModifier -> Bool)
-> (TransactionModifier -> TransactionModifier -> Bool)
-> Eq TransactionModifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransactionModifier -> TransactionModifier -> Bool
$c/= :: TransactionModifier -> TransactionModifier -> Bool
== :: TransactionModifier -> TransactionModifier -> Bool
$c== :: TransactionModifier -> TransactionModifier -> Bool
Eq,Typeable,Typeable TransactionModifier
Constr
DataType
Typeable TransactionModifier =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> TransactionModifier
 -> c TransactionModifier)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TransactionModifier)
-> (TransactionModifier -> Constr)
-> (TransactionModifier -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TransactionModifier))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TransactionModifier))
-> ((forall b. Data b => b -> b)
    -> TransactionModifier -> TransactionModifier)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TransactionModifier -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TransactionModifier -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TransactionModifier -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TransactionModifier -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TransactionModifier -> m TransactionModifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TransactionModifier -> m TransactionModifier)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TransactionModifier -> m TransactionModifier)
-> Data TransactionModifier
TransactionModifier -> Constr
TransactionModifier -> DataType
(forall b. Data b => b -> b)
-> TransactionModifier -> TransactionModifier
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TransactionModifier
-> c TransactionModifier
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TransactionModifier
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TransactionModifier -> u
forall u.
(forall d. Data d => d -> u) -> TransactionModifier -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TransactionModifier -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TransactionModifier -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TransactionModifier -> m TransactionModifier
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TransactionModifier -> m TransactionModifier
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TransactionModifier
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TransactionModifier
-> c TransactionModifier
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TransactionModifier)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TransactionModifier)
$cTransactionModifier :: Constr
$tTransactionModifier :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> TransactionModifier -> m TransactionModifier
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TransactionModifier -> m TransactionModifier
gmapMp :: (forall d. Data d => d -> m d)
-> TransactionModifier -> m TransactionModifier
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TransactionModifier -> m TransactionModifier
gmapM :: (forall d. Data d => d -> m d)
-> TransactionModifier -> m TransactionModifier
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TransactionModifier -> m TransactionModifier
gmapQi :: Int -> (forall d. Data d => d -> u) -> TransactionModifier -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TransactionModifier -> u
gmapQ :: (forall d. Data d => d -> u) -> TransactionModifier -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> TransactionModifier -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TransactionModifier -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TransactionModifier -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TransactionModifier -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TransactionModifier -> r
gmapT :: (forall b. Data b => b -> b)
-> TransactionModifier -> TransactionModifier
$cgmapT :: (forall b. Data b => b -> b)
-> TransactionModifier -> TransactionModifier
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TransactionModifier)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TransactionModifier)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TransactionModifier)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TransactionModifier)
dataTypeOf :: TransactionModifier -> DataType
$cdataTypeOf :: TransactionModifier -> DataType
toConstr :: TransactionModifier -> Constr
$ctoConstr :: TransactionModifier -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TransactionModifier
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TransactionModifier
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TransactionModifier
-> c TransactionModifier
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> TransactionModifier
-> c TransactionModifier
$cp1Data :: Typeable TransactionModifier
Data,(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
$cto :: forall x. Rep TransactionModifier x -> TransactionModifier
$cfrom :: forall x. TransactionModifier -> Rep TransactionModifier x
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
showList :: [TransactionModifier] -> ShowS
$cshowList :: [TransactionModifier] -> ShowS
show :: TransactionModifier -> String
$cshow :: TransactionModifier -> String
showsPrec :: Int -> TransactionModifier -> ShowS
$cshowsPrec :: Int -> TransactionModifier -> ShowS
Show)

instance NFData TransactionModifier

nulltransactionmodifier :: TransactionModifier
nulltransactionmodifier = TransactionModifier :: CommoditySymbol -> [Posting] -> TransactionModifier
TransactionModifier{
  tmquerytxt :: CommoditySymbol
tmquerytxt = ""
 ,tmpostingrules :: [Posting]
tmpostingrules = []
}

-- | A transaction modifier transformation, which adds an extra posting
-- to the matched posting's transaction.
-- Can be like a regular posting, or the amount can have the aismultiplier flag set,
-- indicating that it's a multiplier for the matched posting's amount.
type TMPostingRule = Posting

-- | A periodic transaction rule, describing a transaction that recurs.
data PeriodicTransaction = PeriodicTransaction {
      PeriodicTransaction -> CommoditySymbol
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 -> Status
ptstatus       :: Status,   -- ^ some of Transaction's fields
      PeriodicTransaction -> CommoditySymbol
ptcode         :: Text,
      PeriodicTransaction -> CommoditySymbol
ptdescription  :: Text,
      PeriodicTransaction -> CommoditySymbol
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
/= :: PeriodicTransaction -> PeriodicTransaction -> Bool
$c/= :: PeriodicTransaction -> PeriodicTransaction -> Bool
== :: PeriodicTransaction -> PeriodicTransaction -> Bool
$c== :: PeriodicTransaction -> PeriodicTransaction -> Bool
Eq,Typeable,Typeable PeriodicTransaction
Constr
DataType
Typeable PeriodicTransaction =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> PeriodicTransaction
 -> c PeriodicTransaction)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PeriodicTransaction)
-> (PeriodicTransaction -> Constr)
-> (PeriodicTransaction -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PeriodicTransaction))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PeriodicTransaction))
-> ((forall b. Data b => b -> b)
    -> PeriodicTransaction -> PeriodicTransaction)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PeriodicTransaction -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PeriodicTransaction -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> PeriodicTransaction -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PeriodicTransaction -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> PeriodicTransaction -> m PeriodicTransaction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PeriodicTransaction -> m PeriodicTransaction)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PeriodicTransaction -> m PeriodicTransaction)
-> Data PeriodicTransaction
PeriodicTransaction -> Constr
PeriodicTransaction -> DataType
(forall b. Data b => b -> b)
-> PeriodicTransaction -> PeriodicTransaction
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PeriodicTransaction
-> c PeriodicTransaction
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PeriodicTransaction
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PeriodicTransaction -> u
forall u.
(forall d. Data d => d -> u) -> PeriodicTransaction -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PeriodicTransaction -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PeriodicTransaction -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PeriodicTransaction -> m PeriodicTransaction
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PeriodicTransaction -> m PeriodicTransaction
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PeriodicTransaction
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PeriodicTransaction
-> c PeriodicTransaction
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PeriodicTransaction)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PeriodicTransaction)
$cPeriodicTransaction :: Constr
$tPeriodicTransaction :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> PeriodicTransaction -> m PeriodicTransaction
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PeriodicTransaction -> m PeriodicTransaction
gmapMp :: (forall d. Data d => d -> m d)
-> PeriodicTransaction -> m PeriodicTransaction
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PeriodicTransaction -> m PeriodicTransaction
gmapM :: (forall d. Data d => d -> m d)
-> PeriodicTransaction -> m PeriodicTransaction
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PeriodicTransaction -> m PeriodicTransaction
gmapQi :: Int -> (forall d. Data d => d -> u) -> PeriodicTransaction -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PeriodicTransaction -> u
gmapQ :: (forall d. Data d => d -> u) -> PeriodicTransaction -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> PeriodicTransaction -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PeriodicTransaction -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PeriodicTransaction -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PeriodicTransaction -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PeriodicTransaction -> r
gmapT :: (forall b. Data b => b -> b)
-> PeriodicTransaction -> PeriodicTransaction
$cgmapT :: (forall b. Data b => b -> b)
-> PeriodicTransaction -> PeriodicTransaction
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PeriodicTransaction)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PeriodicTransaction)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PeriodicTransaction)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PeriodicTransaction)
dataTypeOf :: PeriodicTransaction -> DataType
$cdataTypeOf :: PeriodicTransaction -> DataType
toConstr :: PeriodicTransaction -> Constr
$ctoConstr :: PeriodicTransaction -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PeriodicTransaction
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PeriodicTransaction
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PeriodicTransaction
-> c PeriodicTransaction
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> PeriodicTransaction
-> c PeriodicTransaction
$cp1Data :: Typeable PeriodicTransaction
Data,(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
$cto :: forall x. Rep PeriodicTransaction x -> PeriodicTransaction
$cfrom :: forall x. PeriodicTransaction -> Rep PeriodicTransaction x
Generic) -- , Show in PeriodicTransaction.hs

nullperiodictransaction :: PeriodicTransaction
nullperiodictransaction = PeriodicTransaction :: CommoditySymbol
-> Interval
-> DateSpan
-> Status
-> CommoditySymbol
-> CommoditySymbol
-> CommoditySymbol
-> [Tag]
-> [Posting]
-> PeriodicTransaction
PeriodicTransaction{
      ptperiodexpr :: CommoditySymbol
ptperiodexpr   = ""
     ,ptinterval :: Interval
ptinterval     = Interval
forall a. Default a => a
def
     ,ptspan :: DateSpan
ptspan         = DateSpan
forall a. Default a => a
def
     ,ptstatus :: Status
ptstatus       = Status
Unmarked
     ,ptcode :: CommoditySymbol
ptcode         = ""
     ,ptdescription :: CommoditySymbol
ptdescription  = ""
     ,ptcomment :: CommoditySymbol
ptcomment      = ""
     ,pttags :: [Tag]
pttags         = []
     ,ptpostings :: [Posting]
ptpostings     = []
}

instance NFData PeriodicTransaction

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
/= :: TimeclockCode -> TimeclockCode -> Bool
$c/= :: TimeclockCode -> TimeclockCode -> Bool
== :: TimeclockCode -> TimeclockCode -> Bool
$c== :: 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
min :: TimeclockCode -> TimeclockCode -> TimeclockCode
$cmin :: TimeclockCode -> TimeclockCode -> TimeclockCode
max :: TimeclockCode -> TimeclockCode -> TimeclockCode
$cmax :: TimeclockCode -> TimeclockCode -> TimeclockCode
>= :: TimeclockCode -> TimeclockCode -> Bool
$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
compare :: TimeclockCode -> TimeclockCode -> Ordering
$ccompare :: TimeclockCode -> TimeclockCode -> Ordering
$cp1Ord :: Eq TimeclockCode
Ord,Typeable,Typeable TimeclockCode
Constr
DataType
Typeable TimeclockCode =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> TimeclockCode -> c TimeclockCode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TimeclockCode)
-> (TimeclockCode -> Constr)
-> (TimeclockCode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TimeclockCode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TimeclockCode))
-> ((forall b. Data b => b -> b) -> TimeclockCode -> TimeclockCode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TimeclockCode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TimeclockCode -> r)
-> (forall u. (forall d. Data d => d -> u) -> TimeclockCode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TimeclockCode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TimeclockCode -> m TimeclockCode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TimeclockCode -> m TimeclockCode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TimeclockCode -> m TimeclockCode)
-> Data TimeclockCode
TimeclockCode -> Constr
TimeclockCode -> DataType
(forall b. Data b => b -> b) -> TimeclockCode -> TimeclockCode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeclockCode -> c TimeclockCode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeclockCode
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TimeclockCode -> u
forall u. (forall d. Data d => d -> u) -> TimeclockCode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockCode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockCode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimeclockCode -> m TimeclockCode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeclockCode -> m TimeclockCode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeclockCode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeclockCode -> c TimeclockCode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeclockCode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimeclockCode)
$cFinalOut :: Constr
$cOut :: Constr
$cIn :: Constr
$cSetRequiredHours :: Constr
$cSetBalance :: Constr
$tTimeclockCode :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> TimeclockCode -> m TimeclockCode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeclockCode -> m TimeclockCode
gmapMp :: (forall d. Data d => d -> m d) -> TimeclockCode -> m TimeclockCode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeclockCode -> m TimeclockCode
gmapM :: (forall d. Data d => d -> m d) -> TimeclockCode -> m TimeclockCode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimeclockCode -> m TimeclockCode
gmapQi :: Int -> (forall d. Data d => d -> u) -> TimeclockCode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TimeclockCode -> u
gmapQ :: (forall d. Data d => d -> u) -> TimeclockCode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TimeclockCode -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockCode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockCode -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockCode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockCode -> r
gmapT :: (forall b. Data b => b -> b) -> TimeclockCode -> TimeclockCode
$cgmapT :: (forall b. Data b => b -> b) -> TimeclockCode -> TimeclockCode
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimeclockCode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimeclockCode)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TimeclockCode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeclockCode)
dataTypeOf :: TimeclockCode -> DataType
$cdataTypeOf :: TimeclockCode -> DataType
toConstr :: TimeclockCode -> Constr
$ctoConstr :: TimeclockCode -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeclockCode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeclockCode
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeclockCode -> c TimeclockCode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeclockCode -> c TimeclockCode
$cp1Data :: Typeable TimeclockCode
Data,(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
$cto :: forall x. Rep TimeclockCode x -> TimeclockCode
$cfrom :: forall x. TimeclockCode -> Rep TimeclockCode x
Generic)

instance NFData TimeclockCode

data TimeclockEntry = TimeclockEntry {
      TimeclockEntry -> GenericSourcePos
tlsourcepos   :: GenericSourcePos,
      TimeclockEntry -> TimeclockCode
tlcode        :: TimeclockCode,
      TimeclockEntry -> LocalTime
tldatetime    :: LocalTime,
      TimeclockEntry -> CommoditySymbol
tlaccount     :: AccountName,
      TimeclockEntry -> CommoditySymbol
tldescription :: Text
    } deriving (TimeclockEntry -> TimeclockEntry -> Bool
(TimeclockEntry -> TimeclockEntry -> Bool)
-> (TimeclockEntry -> TimeclockEntry -> Bool) -> Eq TimeclockEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeclockEntry -> TimeclockEntry -> Bool
$c/= :: TimeclockEntry -> TimeclockEntry -> Bool
== :: TimeclockEntry -> TimeclockEntry -> Bool
$c== :: 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
min :: TimeclockEntry -> TimeclockEntry -> TimeclockEntry
$cmin :: TimeclockEntry -> TimeclockEntry -> TimeclockEntry
max :: TimeclockEntry -> TimeclockEntry -> TimeclockEntry
$cmax :: TimeclockEntry -> TimeclockEntry -> TimeclockEntry
>= :: TimeclockEntry -> TimeclockEntry -> Bool
$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
compare :: TimeclockEntry -> TimeclockEntry -> Ordering
$ccompare :: TimeclockEntry -> TimeclockEntry -> Ordering
$cp1Ord :: Eq TimeclockEntry
Ord,Typeable,Typeable TimeclockEntry
Constr
DataType
Typeable TimeclockEntry =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> TimeclockEntry -> c TimeclockEntry)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TimeclockEntry)
-> (TimeclockEntry -> Constr)
-> (TimeclockEntry -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TimeclockEntry))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TimeclockEntry))
-> ((forall b. Data b => b -> b)
    -> TimeclockEntry -> TimeclockEntry)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TimeclockEntry -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TimeclockEntry -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> TimeclockEntry -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TimeclockEntry -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> TimeclockEntry -> m TimeclockEntry)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TimeclockEntry -> m TimeclockEntry)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> TimeclockEntry -> m TimeclockEntry)
-> Data TimeclockEntry
TimeclockEntry -> Constr
TimeclockEntry -> DataType
(forall b. Data b => b -> b) -> TimeclockEntry -> TimeclockEntry
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeclockEntry -> c TimeclockEntry
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeclockEntry
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> TimeclockEntry -> u
forall u. (forall d. Data d => d -> u) -> TimeclockEntry -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockEntry -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockEntry -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TimeclockEntry -> m TimeclockEntry
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TimeclockEntry -> m TimeclockEntry
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeclockEntry
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeclockEntry -> c TimeclockEntry
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeclockEntry)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimeclockEntry)
$cTimeclockEntry :: Constr
$tTimeclockEntry :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> TimeclockEntry -> m TimeclockEntry
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TimeclockEntry -> m TimeclockEntry
gmapMp :: (forall d. Data d => d -> m d)
-> TimeclockEntry -> m TimeclockEntry
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> TimeclockEntry -> m TimeclockEntry
gmapM :: (forall d. Data d => d -> m d)
-> TimeclockEntry -> m TimeclockEntry
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> TimeclockEntry -> m TimeclockEntry
gmapQi :: Int -> (forall d. Data d => d -> u) -> TimeclockEntry -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> TimeclockEntry -> u
gmapQ :: (forall d. Data d => d -> u) -> TimeclockEntry -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TimeclockEntry -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockEntry -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockEntry -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockEntry -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeclockEntry -> r
gmapT :: (forall b. Data b => b -> b) -> TimeclockEntry -> TimeclockEntry
$cgmapT :: (forall b. Data b => b -> b) -> TimeclockEntry -> TimeclockEntry
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimeclockEntry)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TimeclockEntry)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TimeclockEntry)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeclockEntry)
dataTypeOf :: TimeclockEntry -> DataType
$cdataTypeOf :: TimeclockEntry -> DataType
toConstr :: TimeclockEntry -> Constr
$ctoConstr :: TimeclockEntry -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeclockEntry
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeclockEntry
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeclockEntry -> c TimeclockEntry
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeclockEntry -> c TimeclockEntry
$cp1Data :: Typeable TimeclockEntry
Data,(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
$cto :: forall x. Rep TimeclockEntry x -> TimeclockEntry
$cfrom :: forall x. TimeclockEntry -> Rep TimeclockEntry x
Generic)

instance NFData TimeclockEntry

-- | 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 -> Day
pddate      :: Day
  ,PriceDirective -> CommoditySymbol
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
/= :: PriceDirective -> PriceDirective -> Bool
$c/= :: PriceDirective -> PriceDirective -> Bool
== :: PriceDirective -> PriceDirective -> Bool
$c== :: 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
min :: PriceDirective -> PriceDirective -> PriceDirective
$cmin :: PriceDirective -> PriceDirective -> PriceDirective
max :: PriceDirective -> PriceDirective -> PriceDirective
$cmax :: PriceDirective -> PriceDirective -> PriceDirective
>= :: PriceDirective -> PriceDirective -> Bool
$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
compare :: PriceDirective -> PriceDirective -> Ordering
$ccompare :: PriceDirective -> PriceDirective -> Ordering
$cp1Ord :: Eq PriceDirective
Ord,Typeable,Typeable PriceDirective
Constr
DataType
Typeable PriceDirective =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> PriceDirective -> c PriceDirective)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PriceDirective)
-> (PriceDirective -> Constr)
-> (PriceDirective -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PriceDirective))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c PriceDirective))
-> ((forall b. Data b => b -> b)
    -> PriceDirective -> PriceDirective)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PriceDirective -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PriceDirective -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> PriceDirective -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PriceDirective -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> PriceDirective -> m PriceDirective)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PriceDirective -> m PriceDirective)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> PriceDirective -> m PriceDirective)
-> Data PriceDirective
PriceDirective -> Constr
PriceDirective -> DataType
(forall b. Data b => b -> b) -> PriceDirective -> PriceDirective
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PriceDirective -> c PriceDirective
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PriceDirective
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> PriceDirective -> u
forall u. (forall d. Data d => d -> u) -> PriceDirective -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PriceDirective -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PriceDirective -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PriceDirective -> m PriceDirective
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PriceDirective -> m PriceDirective
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PriceDirective
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PriceDirective -> c PriceDirective
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PriceDirective)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PriceDirective)
$cPriceDirective :: Constr
$tPriceDirective :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> PriceDirective -> m PriceDirective
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PriceDirective -> m PriceDirective
gmapMp :: (forall d. Data d => d -> m d)
-> PriceDirective -> m PriceDirective
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> PriceDirective -> m PriceDirective
gmapM :: (forall d. Data d => d -> m d)
-> PriceDirective -> m PriceDirective
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> PriceDirective -> m PriceDirective
gmapQi :: Int -> (forall d. Data d => d -> u) -> PriceDirective -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> PriceDirective -> u
gmapQ :: (forall d. Data d => d -> u) -> PriceDirective -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PriceDirective -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PriceDirective -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PriceDirective -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PriceDirective -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PriceDirective -> r
gmapT :: (forall b. Data b => b -> b) -> PriceDirective -> PriceDirective
$cgmapT :: (forall b. Data b => b -> b) -> PriceDirective -> PriceDirective
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PriceDirective)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c PriceDirective)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c PriceDirective)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PriceDirective)
dataTypeOf :: PriceDirective -> DataType
$cdataTypeOf :: PriceDirective -> DataType
toConstr :: PriceDirective -> Constr
$ctoConstr :: PriceDirective -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PriceDirective
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PriceDirective
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PriceDirective -> c PriceDirective
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PriceDirective -> c PriceDirective
$cp1Data :: Typeable PriceDirective
Data,(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
$cto :: forall x. Rep PriceDirective x -> PriceDirective
$cfrom :: forall x. PriceDirective -> Rep PriceDirective x
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
showList :: [PriceDirective] -> ShowS
$cshowList :: [PriceDirective] -> ShowS
show :: PriceDirective -> String
$cshow :: PriceDirective -> String
showsPrec :: Int -> PriceDirective -> ShowS
$cshowsPrec :: Int -> PriceDirective -> ShowS
Show)
        -- Show instance derived in Amount.hs (XXX why ?)

instance NFData PriceDirective

-- | 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 -> CommoditySymbol
mpfrom :: CommoditySymbol    -- ^ The commodity being converted from.
  ,MarketPrice -> CommoditySymbol
mpto   :: CommoditySymbol    -- ^ The commodity being converted to.
  ,MarketPrice -> DecimalRaw Integer
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
/= :: MarketPrice -> MarketPrice -> Bool
$c/= :: MarketPrice -> MarketPrice -> Bool
== :: MarketPrice -> MarketPrice -> Bool
$c== :: 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
min :: MarketPrice -> MarketPrice -> MarketPrice
$cmin :: MarketPrice -> MarketPrice -> MarketPrice
max :: MarketPrice -> MarketPrice -> MarketPrice
$cmax :: MarketPrice -> MarketPrice -> MarketPrice
>= :: MarketPrice -> MarketPrice -> Bool
$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
compare :: MarketPrice -> MarketPrice -> Ordering
$ccompare :: MarketPrice -> MarketPrice -> Ordering
$cp1Ord :: Eq MarketPrice
Ord,Typeable,Typeable MarketPrice
Constr
DataType
Typeable MarketPrice =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> MarketPrice -> c MarketPrice)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MarketPrice)
-> (MarketPrice -> Constr)
-> (MarketPrice -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c MarketPrice))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c MarketPrice))
-> ((forall b. Data b => b -> b) -> MarketPrice -> MarketPrice)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> MarketPrice -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> MarketPrice -> r)
-> (forall u. (forall d. Data d => d -> u) -> MarketPrice -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MarketPrice -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> MarketPrice -> m MarketPrice)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MarketPrice -> m MarketPrice)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MarketPrice -> m MarketPrice)
-> Data MarketPrice
MarketPrice -> Constr
MarketPrice -> DataType
(forall b. Data b => b -> b) -> MarketPrice -> MarketPrice
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MarketPrice -> c MarketPrice
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MarketPrice
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MarketPrice -> u
forall u. (forall d. Data d => d -> u) -> MarketPrice -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MarketPrice -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MarketPrice -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MarketPrice -> m MarketPrice
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MarketPrice -> m MarketPrice
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MarketPrice
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MarketPrice -> c MarketPrice
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MarketPrice)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MarketPrice)
$cMarketPrice :: Constr
$tMarketPrice :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> MarketPrice -> m MarketPrice
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MarketPrice -> m MarketPrice
gmapMp :: (forall d. Data d => d -> m d) -> MarketPrice -> m MarketPrice
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MarketPrice -> m MarketPrice
gmapM :: (forall d. Data d => d -> m d) -> MarketPrice -> m MarketPrice
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MarketPrice -> m MarketPrice
gmapQi :: Int -> (forall d. Data d => d -> u) -> MarketPrice -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MarketPrice -> u
gmapQ :: (forall d. Data d => d -> u) -> MarketPrice -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MarketPrice -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MarketPrice -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MarketPrice -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MarketPrice -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MarketPrice -> r
gmapT :: (forall b. Data b => b -> b) -> MarketPrice -> MarketPrice
$cgmapT :: (forall b. Data b => b -> b) -> MarketPrice -> MarketPrice
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MarketPrice)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c MarketPrice)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c MarketPrice)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MarketPrice)
dataTypeOf :: MarketPrice -> DataType
$cdataTypeOf :: MarketPrice -> DataType
toConstr :: MarketPrice -> Constr
$ctoConstr :: MarketPrice -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MarketPrice
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MarketPrice
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MarketPrice -> c MarketPrice
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MarketPrice -> c MarketPrice
$cp1Data :: Typeable MarketPrice
Data,(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
$cto :: forall x. Rep MarketPrice x -> MarketPrice
$cfrom :: forall x. MarketPrice -> Rep MarketPrice x
Generic)
        -- Show instance derived in Amount.hs (XXX why ?)

instance NFData MarketPrice

-- additional valuation-related types in Valuation.hs

-- | A Journal, containing transactions and various other things.
-- The basic data model for hledger.
--
-- This is used during parsing (as the type alias ParsedJournal), and
-- then finalised/validated for use as a Journal. Some extra
-- parsing-related fields are included for convenience, at least for
-- now. In a ParsedJournal these are updated as parsing proceeds, in a
-- Journal they represent the final state at end of parsing (used eg
-- by the add command).
--
data Journal = Journal {
  -- parsing-related data
   Journal -> Maybe Integer
jparsedefaultyear      :: Maybe Year                            -- ^ the current default year, specified by the most recent Y directive (or current date)
  ,Journal -> Maybe (CommoditySymbol, AmountStyle)
jparsedefaultcommodity :: Maybe (CommoditySymbol,AmountStyle)   -- ^ the current default commodity and its format, specified by the most recent D directive
  ,Journal -> [CommoditySymbol]
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 -> [(CommoditySymbol, AccountDeclarationInfo)]
jdeclaredaccounts      :: [(AccountName,AccountDeclarationInfo)] -- ^ Accounts declared by account directives, in parse order (after journal finalisation)
  ,Journal -> Map AccountType [CommoditySymbol]
jdeclaredaccounttypes  :: M.Map AccountType [AccountName]        -- ^ Accounts whose type has been declared in account directives (usually 5 top-level accounts)
  ,Journal -> Map CommoditySymbol Commodity
jcommodities           :: M.Map CommoditySymbol Commodity        -- ^ commodities and formats declared by commodity directives
  ,Journal -> Map CommoditySymbol AmountStyle
jinferredcommodities   :: M.Map CommoditySymbol AmountStyle      -- ^ commodities and formats inferred from journal amounts  TODO misnamed, should be eg jusedstyles
  ,Journal -> [PriceDirective]
jpricedirectives       :: [PriceDirective]                       -- ^ Declarations of market prices by P directives, in parse order (after journal finalisation)
  ,Journal -> [MarketPrice]
jinferredmarketprices  :: [MarketPrice]                          -- ^ Market prices implied by transactions, in parse order (after journal finalisation)
  ,Journal -> [TransactionModifier]
jtxnmodifiers          :: [TransactionModifier]
  ,Journal -> [PeriodicTransaction]
jperiodictxns          :: [PeriodicTransaction]
  ,Journal -> [Transaction]
jtxns                  :: [Transaction]
  ,Journal -> CommoditySymbol
jfinalcommentlines     :: Text                                   -- ^ any final trailing comments in the (main) journal file
  ,Journal -> [(String, CommoditySymbol)]
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.
  ,Journal -> ClockTime
jlastreadtime          :: ClockTime                              -- ^ when this journal was last read from its file(s)
  } deriving (Journal -> Journal -> Bool
(Journal -> Journal -> Bool)
-> (Journal -> Journal -> Bool) -> Eq Journal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Journal -> Journal -> Bool
$c/= :: Journal -> Journal -> Bool
== :: Journal -> Journal -> Bool
$c== :: Journal -> Journal -> Bool
Eq, Typeable, Typeable Journal
Constr
DataType
Typeable Journal =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Journal -> c Journal)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Journal)
-> (Journal -> Constr)
-> (Journal -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Journal))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Journal))
-> ((forall b. Data b => b -> b) -> Journal -> Journal)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Journal -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Journal -> r)
-> (forall u. (forall d. Data d => d -> u) -> Journal -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Journal -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Journal -> m Journal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Journal -> m Journal)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Journal -> m Journal)
-> Data Journal
Journal -> Constr
Journal -> DataType
(forall b. Data b => b -> b) -> Journal -> Journal
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Journal -> c Journal
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Journal
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Journal -> u
forall u. (forall d. Data d => d -> u) -> Journal -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Journal -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Journal -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Journal -> m Journal
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Journal -> m Journal
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Journal
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Journal -> c Journal
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Journal)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Journal)
$cJournal :: Constr
$tJournal :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Journal -> m Journal
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Journal -> m Journal
gmapMp :: (forall d. Data d => d -> m d) -> Journal -> m Journal
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Journal -> m Journal
gmapM :: (forall d. Data d => d -> m d) -> Journal -> m Journal
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Journal -> m Journal
gmapQi :: Int -> (forall d. Data d => d -> u) -> Journal -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Journal -> u
gmapQ :: (forall d. Data d => d -> u) -> Journal -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Journal -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Journal -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Journal -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Journal -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Journal -> r
gmapT :: (forall b. Data b => b -> b) -> Journal -> Journal
$cgmapT :: (forall b. Data b => b -> b) -> Journal -> Journal
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Journal)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Journal)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Journal)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Journal)
dataTypeOf :: Journal -> DataType
$cdataTypeOf :: Journal -> DataType
toConstr :: Journal -> Constr
$ctoConstr :: Journal -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Journal
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Journal
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Journal -> c Journal
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Journal -> c Journal
$cp1Data :: Typeable Journal
Data, (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
$cto :: forall x. Rep Journal x -> Journal
$cfrom :: forall x. Journal -> Rep Journal x
Generic)

deriving instance Data ClockTime
deriving instance Typeable ClockTime
deriving instance Generic ClockTime
instance NFData ClockTime
instance NFData Journal

-- | 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

-- | The id of a data format understood by hledger, eg @journal@ or @csv@.
-- The --output-format option selects one of these for output.
type StorageFormat = String

-- | Extra information about an account that can be derived from
-- its account directive (and the other account directives).
data AccountDeclarationInfo = AccountDeclarationInfo {
   AccountDeclarationInfo -> CommoditySymbol
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..)
} deriving (AccountDeclarationInfo -> AccountDeclarationInfo -> Bool
(AccountDeclarationInfo -> AccountDeclarationInfo -> Bool)
-> (AccountDeclarationInfo -> AccountDeclarationInfo -> Bool)
-> Eq AccountDeclarationInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AccountDeclarationInfo -> AccountDeclarationInfo -> Bool
$c/= :: AccountDeclarationInfo -> AccountDeclarationInfo -> Bool
== :: AccountDeclarationInfo -> AccountDeclarationInfo -> Bool
$c== :: 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
showList :: [AccountDeclarationInfo] -> ShowS
$cshowList :: [AccountDeclarationInfo] -> ShowS
show :: AccountDeclarationInfo -> String
$cshow :: AccountDeclarationInfo -> String
showsPrec :: Int -> AccountDeclarationInfo -> ShowS
$cshowsPrec :: Int -> AccountDeclarationInfo -> ShowS
Show,Typeable AccountDeclarationInfo
Constr
DataType
Typeable AccountDeclarationInfo =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g)
 -> AccountDeclarationInfo
 -> c AccountDeclarationInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c AccountDeclarationInfo)
-> (AccountDeclarationInfo -> Constr)
-> (AccountDeclarationInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c AccountDeclarationInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c AccountDeclarationInfo))
-> ((forall b. Data b => b -> b)
    -> AccountDeclarationInfo -> AccountDeclarationInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AccountDeclarationInfo
    -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r
    -> (forall d. Data d => d -> r')
    -> AccountDeclarationInfo
    -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> AccountDeclarationInfo -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> AccountDeclarationInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> AccountDeclarationInfo -> m AccountDeclarationInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AccountDeclarationInfo -> m AccountDeclarationInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> AccountDeclarationInfo -> m AccountDeclarationInfo)
-> Data AccountDeclarationInfo
AccountDeclarationInfo -> Constr
AccountDeclarationInfo -> DataType
(forall b. Data b => b -> b)
-> AccountDeclarationInfo -> AccountDeclarationInfo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AccountDeclarationInfo
-> c AccountDeclarationInfo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountDeclarationInfo
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> AccountDeclarationInfo -> u
forall u.
(forall d. Data d => d -> u) -> AccountDeclarationInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccountDeclarationInfo
-> r
forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccountDeclarationInfo
-> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AccountDeclarationInfo -> m AccountDeclarationInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccountDeclarationInfo -> m AccountDeclarationInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountDeclarationInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AccountDeclarationInfo
-> c AccountDeclarationInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AccountDeclarationInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccountDeclarationInfo)
$cAccountDeclarationInfo :: Constr
$tAccountDeclarationInfo :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> AccountDeclarationInfo -> m AccountDeclarationInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccountDeclarationInfo -> m AccountDeclarationInfo
gmapMp :: (forall d. Data d => d -> m d)
-> AccountDeclarationInfo -> m AccountDeclarationInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> AccountDeclarationInfo -> m AccountDeclarationInfo
gmapM :: (forall d. Data d => d -> m d)
-> AccountDeclarationInfo -> m AccountDeclarationInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> AccountDeclarationInfo -> m AccountDeclarationInfo
gmapQi :: Int -> (forall d. Data d => d -> u) -> AccountDeclarationInfo -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> AccountDeclarationInfo -> u
gmapQ :: (forall d. Data d => d -> u) -> AccountDeclarationInfo -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> AccountDeclarationInfo -> [u]
gmapQr :: (r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccountDeclarationInfo
-> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccountDeclarationInfo
-> r
gmapQl :: (r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccountDeclarationInfo
-> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r
-> (forall d. Data d => d -> r')
-> AccountDeclarationInfo
-> r
gmapT :: (forall b. Data b => b -> b)
-> AccountDeclarationInfo -> AccountDeclarationInfo
$cgmapT :: (forall b. Data b => b -> b)
-> AccountDeclarationInfo -> AccountDeclarationInfo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccountDeclarationInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c AccountDeclarationInfo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c AccountDeclarationInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c AccountDeclarationInfo)
dataTypeOf :: AccountDeclarationInfo -> DataType
$cdataTypeOf :: AccountDeclarationInfo -> DataType
toConstr :: AccountDeclarationInfo -> Constr
$ctoConstr :: AccountDeclarationInfo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountDeclarationInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c AccountDeclarationInfo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AccountDeclarationInfo
-> c AccountDeclarationInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> AccountDeclarationInfo
-> c AccountDeclarationInfo
$cp1Data :: Typeable AccountDeclarationInfo
Data,(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
$cto :: forall x. Rep AccountDeclarationInfo x -> AccountDeclarationInfo
$cfrom :: forall x. AccountDeclarationInfo -> Rep AccountDeclarationInfo x
Generic)

instance NFData AccountDeclarationInfo

nullaccountdeclarationinfo :: AccountDeclarationInfo
nullaccountdeclarationinfo = AccountDeclarationInfo :: CommoditySymbol -> [Tag] -> Int -> AccountDeclarationInfo
AccountDeclarationInfo {
   adicomment :: CommoditySymbol
adicomment          = ""
  ,aditags :: [Tag]
aditags             = []
  ,adideclarationorder :: Int
adideclarationorder = 0
}

-- | 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 -> CommoditySymbol
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 (Typeable, Typeable Account
Constr
DataType
Typeable Account =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Account -> c Account)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Account)
-> (Account -> Constr)
-> (Account -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Account))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Account))
-> ((forall b. Data b => b -> b) -> Account -> Account)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Account -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Account -> r)
-> (forall u. (forall d. Data d => d -> u) -> Account -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Account -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Account -> m Account)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Account -> m Account)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Account -> m Account)
-> Data Account
Account -> Constr
Account -> DataType
(forall b. Data b => b -> b) -> Account -> Account
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Account -> c Account
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Account
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Account -> u
forall u. (forall d. Data d => d -> u) -> Account -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Account -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Account -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Account -> m Account
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Account -> m Account
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Account
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Account -> c Account
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Account)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Account)
$cAccount :: Constr
$tAccount :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Account -> m Account
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Account -> m Account
gmapMp :: (forall d. Data d => d -> m d) -> Account -> m Account
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Account -> m Account
gmapM :: (forall d. Data d => d -> m d) -> Account -> m Account
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Account -> m Account
gmapQi :: Int -> (forall d. Data d => d -> u) -> Account -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Account -> u
gmapQ :: (forall d. Data d => d -> u) -> Account -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Account -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Account -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Account -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Account -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Account -> r
gmapT :: (forall b. Data b => b -> b) -> Account -> Account
$cgmapT :: (forall b. Data b => b -> b) -> Account -> Account
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Account)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Account)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Account)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Account)
dataTypeOf :: Account -> DataType
$cdataTypeOf :: Account -> DataType
toConstr :: Account -> Constr
$ctoConstr :: Account -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Account
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Account
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Account -> c Account
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Account -> c Account
$cp1Data :: Typeable Account
Data, (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
$cto :: forall x. Rep Account x -> Account
$cfrom :: forall x. Account -> Rep Account x
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
showList :: [NormalSign] -> ShowS
$cshowList :: [NormalSign] -> ShowS
show :: NormalSign -> String
$cshow :: NormalSign -> String
showsPrec :: Int -> NormalSign -> ShowS
$cshowsPrec :: Int -> NormalSign -> ShowS
Show, Typeable NormalSign
Constr
DataType
Typeable NormalSign =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> NormalSign -> c NormalSign)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NormalSign)
-> (NormalSign -> Constr)
-> (NormalSign -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NormalSign))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c NormalSign))
-> ((forall b. Data b => b -> b) -> NormalSign -> NormalSign)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> NormalSign -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> NormalSign -> r)
-> (forall u. (forall d. Data d => d -> u) -> NormalSign -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> NormalSign -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> NormalSign -> m NormalSign)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NormalSign -> m NormalSign)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NormalSign -> m NormalSign)
-> Data NormalSign
NormalSign -> Constr
NormalSign -> DataType
(forall b. Data b => b -> b) -> NormalSign -> NormalSign
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NormalSign -> c NormalSign
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NormalSign
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> NormalSign -> u
forall u. (forall d. Data d => d -> u) -> NormalSign -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NormalSign -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NormalSign -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NormalSign -> m NormalSign
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NormalSign -> m NormalSign
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NormalSign
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NormalSign -> c NormalSign
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NormalSign)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NormalSign)
$cNormallyNegative :: Constr
$cNormallyPositive :: Constr
$tNormalSign :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> NormalSign -> m NormalSign
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NormalSign -> m NormalSign
gmapMp :: (forall d. Data d => d -> m d) -> NormalSign -> m NormalSign
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NormalSign -> m NormalSign
gmapM :: (forall d. Data d => d -> m d) -> NormalSign -> m NormalSign
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NormalSign -> m NormalSign
gmapQi :: Int -> (forall d. Data d => d -> u) -> NormalSign -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NormalSign -> u
gmapQ :: (forall d. Data d => d -> u) -> NormalSign -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NormalSign -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NormalSign -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NormalSign -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NormalSign -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NormalSign -> r
gmapT :: (forall b. Data b => b -> b) -> NormalSign -> NormalSign
$cgmapT :: (forall b. Data b => b -> b) -> NormalSign -> NormalSign
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NormalSign)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NormalSign)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c NormalSign)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NormalSign)
dataTypeOf :: NormalSign -> DataType
$cdataTypeOf :: NormalSign -> DataType
toConstr :: NormalSign -> Constr
$ctoConstr :: NormalSign -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NormalSign
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NormalSign
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NormalSign -> c NormalSign
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NormalSign -> c NormalSign
$cp1Data :: Typeable NormalSign
Data, NormalSign -> NormalSign -> Bool
(NormalSign -> NormalSign -> Bool)
-> (NormalSign -> NormalSign -> Bool) -> Eq NormalSign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NormalSign -> NormalSign -> Bool
$c/= :: NormalSign -> NormalSign -> Bool
== :: NormalSign -> NormalSign -> Bool
$c== :: 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]
}