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 => Consable (Journal) t where
  29         mcons t (Journal !ts) =
  30                 Journal $
  31                 Data.Map.insertWith mappend
  32                  (transaction_date t) [t] ts
  33 instance Consable [] transaction where
  34         mcons t !j = (:) t j
  35
  36 cons :: Transaction t => t -> Journal t -> Journal t
  37 cons = mcons
  38
  39 transactions :: Transaction t => Journal t -> Map Date [t]
  40 transactions (Journal ts) = ts