]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Format/Ledger.hs
Ajout : CLI.Lib.Shakespeare.Leijen : et demain L’Internationale...
[comptalang.git] / lib / Hcompta / Format / Ledger.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE NamedFieldPuns #-}
3 {-# LANGUAGE OverloadedStrings #-}
4 {-# LANGUAGE TypeFamilies #-}
5 module Hcompta.Format.Ledger where
6
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
14
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)
24
25 type Code = Text
26 type Description = Text
27 type Status = Bool
28 type Comment = Text
29
30 -- * The 'Journal' type
31
32 data Journal
33 = Journal
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)
40
41 journal :: Journal
42 journal =
43 Journal
44 { journal_file = ""
45 , journal_includes = []
46 , journal_last_read_time = Time.posixSecondsToUTCTime 0
47 , journal_transactions = Data.Map.empty
48 , journal_unit_styles = Data.Map.empty
49 }
50
51
52 -- * The 'Transaction' type
53
54 data Transaction
55 = Transaction
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_virtual_postings :: Posting_by_Account
63 , transaction_balanced_virtual_postings :: Posting_by_Account
64 , transaction_sourcepos :: SourcePos
65 , transaction_status :: Status
66 , transaction_tags :: Tag_by_Name
67 } deriving (Data, Eq, Show, Typeable)
68
69 transaction :: Transaction
70 transaction =
71 Transaction
72 { transaction_code = ""
73 , transaction_comments_before = []
74 , transaction_comments_after = []
75 , transaction_dates = (Date.nil, [])
76 , transaction_description = ""
77 , transaction_postings = Data.Map.empty
78 , transaction_virtual_postings = Data.Map.empty
79 , transaction_balanced_virtual_postings = Data.Map.empty
80 , transaction_sourcepos = initialPos ""
81 , transaction_status = False
82 , transaction_tags = Data.Map.empty
83 }
84
85 -- ** The 'Transaction_by_Date' mapping
86
87 type Transaction_by_Date
88 = Data.Map.Map Date.UTC [Transaction]
89
90 -- | Return a Data.'Data.Map.Map' associating
91 -- the given 'Transaction's with their respective 'Date'.
92 transaction_by_Date :: [Transaction] -> Transaction_by_Date
93 transaction_by_Date =
94 Data.Map.fromListWith (flip (++)) .
95 Data.List.map (\t -> (Date.to_UTC $ fst $ transaction_dates t, [t]))
96
97 -- * The 'Posting' type
98
99 data Posting
100 = Posting
101 { posting_account :: Account
102 , posting_amounts :: Amount.By_Unit
103 , posting_comments :: [Comment]
104 , posting_dates :: [Date]
105 , posting_sourcepos :: SourcePos
106 , posting_status :: Bool
107 , posting_tags :: Tag_by_Name
108 } deriving (Data, Eq, Show, Typeable)
109
110 data Posting_Type
111 = Posting_Type_Regular
112 | Posting_Type_Virtual
113 | Posting_Type_Virtual_Balanced
114 deriving (Data, Eq, Read, Show, Typeable)
115
116 posting :: Account -> Posting
117 posting acct =
118 Posting
119 { posting_account = acct
120 , posting_amounts = Data.Map.empty
121 , posting_comments = []
122 , posting_dates = []
123 , posting_status = False
124 , posting_sourcepos = initialPos ""
125 , posting_tags = Data.Map.empty
126 }
127
128 instance Calc.Balance.Posting Posting
129 where
130 type Posting_Amount Posting = Amount
131 type Posting_Unit Posting = Amount.Unit
132 posting_account = posting_account
133 posting_amounts = posting_amounts
134 posting_make acct amounts = (posting acct) { posting_amounts=amounts }
135
136 -- ** The 'Posting' mappings
137
138 type Posting_by_Account
139 = Data.Map.Map Account [Posting]
140
141 type Posting_by_Amount_and_Account
142 = Data.Map.Map Amount.By_Unit Posting_by_Account
143
144 type Posting_by_Signs_and_Account
145 = Data.Map.Map Amount.Signs Posting_by_Account
146
147 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
148 posting_by_Account :: [Posting] -> Posting_by_Account
149 posting_by_Account =
150 Data.Map.fromListWith (flip (++)) .
151 Data.List.map
152 (\p -> (posting_account p, [p]))
153
154 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
155 posting_by_Amount_and_Account =
156 Data.Map.foldlWithKey
157 (flip (\acct ->
158 Data.List.foldl
159 (flip (\p ->
160 Data.Map.insertWith
161 (Data.Map.unionWith (++))
162 (posting_amounts p)
163 (Data.Map.singleton acct [p])))))
164 Data.Map.empty
165
166 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
167 posting_by_Signs_and_Account =
168 Data.Map.foldlWithKey
169 (flip (\acct ->
170 Data.List.foldl
171 (flip (\p ->
172 Data.Map.insertWith
173 (Data.Map.unionWith (++))
174 (Amount.signs $ posting_amounts p)
175 (Data.Map.singleton acct [p])))))
176 Data.Map.empty
177
178 -- * The 'Tag' type
179
180 type Tag = (Tag_Name, Tag_Value)
181 type Tag_Name = Text
182 type Tag_Value = Text
183
184 type Tag_by_Name = Data.Map.Map Tag_Name [Tag_Value]
185
186 -- | Return a 'Data.Map.Map' associating the 'Value's of the given 'Tag's with their respective 'Name'.
187 tag_by_Name :: [Tag] -> Tag_by_Name
188 tag_by_Name =
189 Data.Map.fromListWith (flip (++)) .
190 Data.List.map (\(n, v) -> (n, [v]))