1 {-# LANGUAGE BangPatterns #-}
2 {-# LANGUAGE FlexibleInstances #-}
3 {-# LANGUAGE MultiParamTypeClasses #-}
4 {-# OPTIONS_GHC -fno-warn-orphans #-}
5 module Hcompta.Journal where
7 import Data.Map.Strict (Map)
8 import qualified Data.Map.Strict as Data.Map
10 import Hcompta.Date (Date)
11 import Hcompta.Lib.Consable (Consable(..))
13 class Transaction t where
14 transaction_date :: t -> Date
17 = Journal (Map Date [t])
20 instance Foldable Journal where
21 foldMap f (Journal t) = foldMap (foldMap f) t
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
28 instance Transaction t
29 => Consable () (Journal) t where
31 instance Consable () [] transaction where
32 mcons () t !j = (:) t j
34 -- | Return the given 'Journal'
35 -- updated by the given 'Transaction'.
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) =
42 Data.Map.insertWith mappend
43 (transaction_date t) [t] ts
45 transactions :: Transaction t => Journal t -> Map Date [t]
46 transactions (Journal ts) = ts