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