]> Git — Sourcephile - comptalang.git/blob - lib/Hcompta/Journal.hs
Ajout : Filter : simplify et context.
[comptalang.git] / lib / Hcompta / Journal.hs
1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE MultiParamTypeClasses #-}
4 {-# OPTIONS_GHC -fno-warn-orphans #-}
5 module Hcompta.Journal where
6
7 import Data.Map.Strict (Map)
8 import qualified Data.Map.Strict as Data.Map
9
10 import Hcompta.Date (Date)
11 import Hcompta.Lib.Consable (Consable(..))
12
13 class Transaction t where
14 transaction_date :: t -> Date
15
16 newtype Journal t
17 = Journal (Map Date [t])
18 deriving (Eq, Show)
19
20 instance Foldable Journal where
21 foldMap f (Journal t) = foldMap (foldMap f) t
22
23 instance Transaction t => Monoid (Journal t) where
24 mempty = Journal mempty
25 mappend (Journal x) (Journal y) =
26 Journal $ Data.Map.unionWith mappend x y
27
28 instance Transaction t
29 => Consable () (Journal) t where
30 mcons () = cons
31 instance Consable () [] transaction where
32 mcons () t !j = (:) t j
33
34 -- | Return the given 'Journal'
35 -- updated by the given 'Transaction'.
36 --
37 -- NOTE: to reduce memory consumption when 'cons'ing iteratively,
38 -- the given 'Journal' is matched strictly.
39 cons :: Transaction t => t -> Journal t -> Journal t
40 cons t (Journal !ts) =
41 Journal $
42 Data.Map.insertWith mappend
43 (transaction_date t) [t] ts
44
45 transactions :: Transaction t => Journal t -> Map Date [t]
46 transactions (Journal ts) = ts