]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Format/Ledger.hs
Ajout : syntax/ledger.vim : ledgerChart.
[comptalang.git] / lib / Hcompta / Format / Ledger.hs
1 {-# LANGUAGE DeriveDataTypeable #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE MultiParamTypeClasses #-}
4 {-# LANGUAGE NamedFieldPuns #-}
5 {-# LANGUAGE OverloadedStrings #-}
6 {-# LANGUAGE TupleSections #-}
7 {-# LANGUAGE TypeFamilies #-}
8 module Hcompta.Format.Ledger where
9
10 -- import Control.Applicative (Const(..))
11 import Data.Bool
12 import Data.Data (Data(..))
13 import Data.Eq (Eq(..))
14 import Data.Functor.Compose (Compose(..))
15 import Data.List
16 import Data.Map.Strict (Map)
17 import qualified Data.Map.Strict as Data.Map
18 import Data.Maybe (Maybe(..))
19 import Data.Monoid (Monoid(..))
20 import Data.Text (Text)
21 import Data.Tuple (fst)
22 import Data.Typeable (Typeable)
23 import Prelude (($), (.), FilePath, Num(..), flip, undefined)
24 import Text.Parsec.Pos (SourcePos, initialPos)
25 import Text.Show (Show)
26
27 import Hcompta.Account (Account)
28 import Hcompta.Amount (Amount)
29 import qualified Hcompta.Amount as Amount
30 -- import Hcompta.Balance (Balance(..))
31 import qualified Hcompta.Balance as Balance
32 import Hcompta.Date (Date)
33 import qualified Hcompta.Date as Date
34 import qualified Hcompta.Filter as Filter
35 -- import Hcompta.GL (GL(..))
36 import qualified Hcompta.GL as GL
37 import qualified Hcompta.Journal as Journal
38 -- import Hcompta.Lib.Consable
39 import Hcompta.Lib.Parsec ()
40 import qualified Hcompta.Stats as Stats
41 import qualified Hcompta.Tag as Tag
42
43 type Code = Text
44 type Description = Text
45 type Status = Bool
46 type Comment = Text
47
48 -- * The 'Journal' type
49
50 data Monoid ts => Journal ts
51 = Journal
52 { journal_file :: FilePath
53 , journal_includes :: [Journal ts]
54 , journal_last_read_time :: Date
55 , journal_transactions :: !ts
56 , journal_unit_styles :: Map Amount.Unit Amount.Style
57 } deriving (Data, Eq, Show, Typeable)
58
59 journal :: Monoid ts => Journal ts
60 journal =
61 Journal
62 { journal_file = mempty
63 , journal_includes = mempty
64 , journal_last_read_time = Date.nil
65 , journal_transactions = mempty
66 , journal_unit_styles = mempty
67 }
68
69 -- * The 'Transaction' type
70
71 data Transaction
72 = Transaction
73 { transaction_code :: Code
74 , transaction_comments_before :: [Comment]
75 , transaction_comments_after :: [Comment]
76 , transaction_dates :: (Date, [Date])
77 , transaction_description :: Description
78 , transaction_postings :: Map Account [Posting]
79 , transaction_virtual_postings :: Map Account [Posting]
80 , transaction_balanced_virtual_postings :: Map Account [Posting]
81 , transaction_sourcepos :: SourcePos
82 , transaction_status :: Status
83 , transaction_tags :: Map Tag.Path [Tag.Value]
84 } deriving (Data, Eq, Show, Typeable)
85
86 transaction :: Transaction
87 transaction =
88 Transaction
89 { transaction_code = ""
90 , transaction_comments_before = []
91 , transaction_comments_after = []
92 , transaction_dates = (Date.nil, [])
93 , transaction_description = ""
94 , transaction_postings = mempty
95 , transaction_virtual_postings = mempty
96 , transaction_balanced_virtual_postings = mempty
97 , transaction_sourcepos = initialPos ""
98 , transaction_status = False
99 , transaction_tags = mempty
100 }
101
102 instance Filter.Transaction Transaction where
103 type Transaction_Posting Transaction = Posting
104 type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
105 transaction_date = fst . transaction_dates
106 transaction_description = transaction_description
107 transaction_postings t =
108 Compose
109 [ Compose $ transaction_postings t
110 ]
111 transaction_postings_virtual t =
112 Compose
113 [ Compose $ transaction_virtual_postings t
114 , Compose $ transaction_balanced_virtual_postings t
115 ]
116 transaction_tags = transaction_tags
117
118 instance Journal.Transaction Transaction where
119 transaction_date = fst . transaction_dates
120
121 instance Stats.Transaction Transaction where
122 type Transaction_Posting Transaction = Posting
123 type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
124 transaction_date = fst . transaction_dates
125 transaction_postings t =
126 Compose
127 [ Compose $ transaction_postings t
128 , Compose $ transaction_virtual_postings t
129 , Compose $ transaction_balanced_virtual_postings t
130 ]
131 transaction_postings_size t =
132 Data.Map.size (transaction_postings t) +
133 Data.Map.size (transaction_virtual_postings t) +
134 Data.Map.size (transaction_balanced_virtual_postings t)
135 transaction_tags =
136 transaction_tags
137
138 instance GL.Transaction Transaction where
139 type Transaction_Posting Transaction = Posting
140 type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
141 transaction_date = fst . transaction_dates
142 transaction_postings t =
143 Compose
144 [ Compose $ transaction_postings t
145 , Compose $ transaction_virtual_postings t
146 , Compose $ transaction_balanced_virtual_postings t
147 ]
148 transaction_postings_filter f t =
149 t{ transaction_postings =
150 Data.Map.mapMaybe
151 (\p -> case filter f p of
152 [] -> Nothing
153 ps -> Just ps)
154 (transaction_postings t)
155 , transaction_virtual_postings =
156 Data.Map.mapMaybe
157 (\p -> case filter f p of
158 [] -> Nothing
159 ps -> Just ps)
160 (transaction_virtual_postings t)
161 , transaction_balanced_virtual_postings =
162 Data.Map.mapMaybe
163 (\p -> case filter f p of
164 [] -> Nothing
165 ps -> Just ps)
166 (transaction_balanced_virtual_postings t)
167 }
168
169 -- | Return a 'Data.Map.Map' associating
170 -- the given 'Transaction's with their respective 'Date'.
171 transaction_by_Date :: [Transaction] -> (Compose (Map Date) []) Transaction
172 transaction_by_Date =
173 Compose .
174 Data.Map.fromListWith (flip (++)) .
175 Data.List.map (\t -> (fst $ transaction_dates t, [t]))
176
177 -- * The 'Posting' type
178
179 data Posting
180 = Posting
181 { posting_account :: Account
182 , posting_amounts :: Map Amount.Unit Amount
183 , posting_comments :: [Comment]
184 , posting_dates :: [Date]
185 , posting_sourcepos :: SourcePos
186 , posting_status :: Bool
187 , posting_tags :: Map Tag.Path [Tag.Value]
188 } deriving (Data, Eq, Show, Typeable)
189
190 posting :: Account -> Posting
191 posting acct =
192 Posting
193 { posting_account = acct
194 , posting_amounts = mempty
195 , posting_comments = mempty
196 , posting_dates = mempty
197 , posting_status = False
198 , posting_sourcepos = initialPos ""
199 , posting_tags = mempty
200 }
201
202 instance Balance.Posting Posting where
203 type Posting_Amount Posting = Amount.Sum Amount
204 posting_account = posting_account
205 posting_amounts = Data.Map.map Amount.sum . posting_amounts
206 posting_set_amounts amounts p =
207 p { posting_amounts=Data.Map.map Amount.sum_balance amounts }
208
209 instance Filter.Posting Posting where
210 type Posting_Amount Posting = Amount
211 posting_account = posting_account
212 posting_amounts = posting_amounts
213 posting_type = undefined
214 -- NOTE: the posting_type will be given to Filter.test
215 -- through instance Posting p => Posting (Posting_Type, p)
216 -- by Filter.transaction_postings
217 -- and Filter.transaction_postings_virtual
218
219 instance GL.Posting Posting where
220 type Posting_Amount Posting = Amount.Sum (Map Amount.Unit Amount)
221 posting_account = posting_account
222 posting_amount = Amount.sum . posting_amounts
223
224 instance Stats.Posting Posting where
225 type Posting_Amount Posting = Amount
226 posting_account = posting_account
227 posting_amounts = posting_amounts
228
229 -- ** The 'Posting' mappings
230
231 type Posting_by_Account
232 = Map Account [Posting]
233
234 type Posting_by_Amount_and_Account
235 = Map Amount.By_Unit Posting_by_Account
236
237 type Posting_by_Signs_and_Account
238 = Map Amount.Signs Posting_by_Account
239
240 -- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
241 posting_by_Account :: [Posting] -> Posting_by_Account
242 posting_by_Account =
243 Data.Map.fromListWith (flip (++)) .
244 Data.List.map
245 (\p -> (posting_account p, [p]))
246
247 posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
248 posting_by_Amount_and_Account =
249 Data.Map.foldlWithKey
250 (flip (\acct ->
251 Data.List.foldl'
252 (flip (\p ->
253 Data.Map.insertWith
254 (Data.Map.unionWith (++))
255 (posting_amounts p)
256 (Data.Map.singleton acct [p])))))
257 mempty
258
259 posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
260 posting_by_Signs_and_Account =
261 Data.Map.foldlWithKey
262 (flip (\acct ->
263 Data.List.foldl'
264 (flip (\p ->
265 Data.Map.insertWith
266 (Data.Map.unionWith (++))
267 (Amount.signs $ posting_amounts p)
268 (Data.Map.singleton acct [p])))))
269 mempty