lib/Hcompta/Journal.hs

   1 {-# LANGUAGE BangPatterns #-}
   2 {-# LANGUAGE FlexibleInstances #-}
   3 {-# LANGUAGE MultiParamTypeClasses #-}
   4 module Hcompta.Journal where
   5
   6 import           Data.Map.Strict (Map)
   7 import qualified Data.Map.Strict as Data.Map
   8
   9 import           Hcompta.Date (Date)
  10 import           Hcompta.Lib.Consable (Consable(..))
  11
  12 class Transaction t where
  13         transaction_date :: t -> Date
  14
  15 newtype Journal t
  16  =      Journal (Map Date [t])
  17  deriving (Eq, Show)
  18
  19 instance Foldable Journal where
  20         foldMap f (Journal t) = foldMap (foldMap f) t
  21
  22 instance Transaction t => Monoid (Journal t) where
  23         mempty = Journal mempty
  24         mappend (Journal x) (Journal y) =
  25                 Journal $ Data.Map.unionWith mappend x y
  26
  27 instance Transaction t => Consable (Journal) t where
  28         mcons t (Journal !ts) =
  29                 Journal $
  30                 Data.Map.insertWith mappend
  31                  (transaction_date t) [t] ts
  32
  33 journal :: Transaction t => t -> Journal t -> Journal t
  34 journal = mcons
  35
  36 transactions :: Transaction t => Journal t -> Map Date [t]
  37 transactions (Journal ts) = ts