1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE NamedFieldPuns #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE TypeFamilies #-}
5 module Hcompta.Format.Ledger where
7 import Data.Data (Data(..))
8 import Data.Typeable (Typeable)
9 import Text.Parsec.Pos (SourcePos, initialPos)
10 import qualified Data.Map.Strict as Data.Map
11 import qualified Data.List as Data.List
12 import qualified Data.Time.Clock as Time
13 import qualified Data.Time.Clock.POSIX as Time
15 import Hcompta.Lib.Parsec ()
16 import qualified Hcompta.Calc.Balance as Calc.Balance
17 import Hcompta.Model.Date (Date)
18 import qualified Hcompta.Model.Date as Date
19 import Hcompta.Model.Account (Account)
20 -- import qualified Hcompta.Model.Account as Account
21 import Hcompta.Model.Amount (Amount)
22 import qualified Hcompta.Model.Amount as Amount
23 import Data.Text (Text)
26 type Description = Text
30 -- * The 'Journal' type
34 { journal_file :: FilePath
35 , journal_includes :: [Journal]
36 , journal_last_read_time :: Time.UTCTime
37 , journal_transactions :: Transaction_by_Date
38 , journal_unit_styles :: Data.Map.Map Amount.Unit Amount.Style
39 } deriving (Data, Eq, Show, Typeable)
45 , journal_includes = []
46 , journal_last_read_time = Time.posixSecondsToUTCTime 0
47 , journal_transactions = Data.Map.empty
48 , journal_unit_styles = Data.Map.empty
52 -- * The 'Transaction' type
56 { transaction_code :: Code
57 , transaction_comments_before :: [Comment]
58 , transaction_comments_after :: [Comment]
59 , transaction_dates :: (Date, [Date])
60 , transaction_description :: Description
61 , transaction_postings :: Posting_by_Account
62 , transaction_postings_balance :: Calc.Balance.Balance Amount Amount.Unit
63 , transaction_virtual_postings :: Posting_by_Account
64 , transaction_balanced_virtual_postings :: Posting_by_Account
65 , transaction_balanced_virtual_postings_balance :: Calc.Balance.Balance Amount Amount.Unit
66 , transaction_sourcepos :: SourcePos
67 , transaction_status :: Status
68 , transaction_tags :: Tag_by_Name
69 } deriving (Data, Eq, Show, Typeable)
71 transaction :: Transaction
74 { transaction_code = ""
75 , transaction_comments_before = []
76 , transaction_comments_after = []
77 , transaction_dates = (Date.nil, [])
78 , transaction_description = ""
79 , transaction_postings = Data.Map.empty
80 , transaction_postings_balance = Calc.Balance.balance
81 , transaction_virtual_postings = Data.Map.empty
82 , transaction_balanced_virtual_postings = Data.Map.empty
83 , transaction_balanced_virtual_postings_balance = Calc.Balance.balance
84 , transaction_sourcepos = initialPos ""
85 , transaction_status = False
86 , transaction_tags = Data.Map.empty
89 type Transaction_by_Date
90 = Data.Map.Map Date.UTC [Transaction]
92 -- | Return a 'Data.Map.Map' associating
93 -- the given 'Transaction's with their respective 'Date'.
94 transaction_by_Date :: [Transaction] -> Transaction_by_Date
96 Data.Map.fromListWith (flip (++)) .
97 Data.List.map (\t -> (Date.to_UTC $ fst $ transaction_dates t, [t]))
99 -- * The 'Posting' type
103 { posting_account :: Account
104 , posting_amounts :: Amount.By_Unit
105 , posting_comments :: [Comment]
106 , posting_dates :: [Date]
107 , posting_sourcepos :: SourcePos
108 , posting_status :: Bool
109 , posting_tags :: Tag_by_Name
110 } deriving (Data, Eq, Show, Typeable)
113 = Posting_Type_Regular
114 | Posting_Type_Virtual
115 | Posting_Type_Virtual_Balanced
116 deriving (Data, Eq, Read, Show, Typeable)
118 posting :: Account -> Posting
121 { posting_account = acct
122 , posting_amounts = Data.Map.empty
123 , posting_comments = []
125 , posting_status = False
126 , posting_sourcepos = initialPos ""
127 , posting_tags = Data.Map.empty
130 instance Calc.Balance.Posting Posting
132 type Posting_Amount Posting = Amount
133 type Posting_Unit Posting = Amount.Unit
134 posting_account = posting_account
135 posting_amounts = posting_amounts
136 posting_set_amounts amounts p = p { posting_amounts=amounts }
138 -- ** The 'Posting' mappings
140 type Posting_by_Account
141 = Data.Map.Map Account [Posting]
143 type Posting_by_Amount_and_Account
144 = Data.Map.Map Amount.By_Unit Posting_by_Account
146 type Posting_by_Signs_and_Account
147 = Data.Map.Map Amount.Signs Posting_by_Account
149 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
150 posting_by_Account :: [Posting] -> Posting_by_Account
152 Data.Map.fromListWith (flip (++)) .
154 (\p -> (posting_account p, [p]))
156 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
157 posting_by_Amount_and_Account =
158 Data.Map.foldlWithKey
163 (Data.Map.unionWith (++))
165 (Data.Map.singleton acct [p])))))
168 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
169 posting_by_Signs_and_Account =
170 Data.Map.foldlWithKey
175 (Data.Map.unionWith (++))
176 (Amount.signs $ posting_amounts p)
177 (Data.Map.singleton acct [p])))))
182 type Tag = (Tag_Name, Tag_Value)
184 type Tag_Value = Text
186 type Tag_by_Name = Data.Map.Map Tag_Name [Tag_Value]
188 -- | Return a 'Data.Map.Map' associating the 'Value's of the given 'Tag's with their respective 'Name'.
189 tag_by_Name :: [Tag] -> Tag_by_Name
191 Data.Map.fromListWith (flip (++)) .
192 Data.List.map (\(n, v) -> (n, [v]))