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.Foldable (Foldable(..))
   8 import           Data.Map.Strict (Map)
   9 import qualified Data.Map.Strict as Data.Map
  10 import           Data.Monoid (Monoid(..))
  11 import           Prelude (($), Eq(..), Show(..), flip)
  12
  13 import           Hcompta.Date (Date)
  14 import           Hcompta.Lib.Consable (Consable(..))
  15
  16 class Transaction t where
  17         transaction_date :: t -> Date
  18
  19 newtype Journal t
  20  =      Journal (Map Date [t])
  21  deriving (Eq, Show)
  22
  23 instance Foldable Journal where
  24         foldMap f (Journal t) = foldMap (foldMap f) t
  25
  26 instance Transaction t => Monoid (Journal t) where
  27         mempty = Journal mempty
  28         mappend (Journal x) (Journal y) =
  29                 Journal $ Data.Map.unionWith (flip mappend) x y
  30
  31 instance Transaction t
  32  => Consable () (Journal) t where
  33         mcons () = cons
  34 instance Consable () [] transaction where
  35         mcons () t !j = (:) t j
  36
  37 -- | Return the given 'Journal'
  38 --   updated by the given 'Transaction'.
  39 --
  40 -- NOTE: to reduce memory consumption when 'cons'ing iteratively,
  41 --       the given 'Journal' is matched strictly.
  42 cons :: Transaction t => t -> Journal t -> Journal t
  43 cons t (Journal !ts) =
  44         Journal $
  45         Data.Map.insertWith (flip mappend)
  46          (transaction_date t) [t] ts
  47
  48 transactions :: Transaction t => Journal t -> Map Date [t]
  49 transactions (Journal ts) = ts