{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.Journal where

import           Control.DeepSeq (NFData(..))
import           Data.Foldable (Foldable(..))
import           Data.Functor (Functor(..))
import           Data.Data
import           Data.Typeable ()
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Monoid (Monoid(..))
import           Prelude (($), Eq(..), Show(..), flip)

import           Hcompta.Date (Date)
import           Hcompta.Lib.Consable (Consable(..))
import           Hcompta.Transaction

-- * Class 'Journal_Transaction'

class Transaction t => Journal_Transaction t

-- * Type 'Journal'

newtype Journal t
 =      Journal (Map Date [t])
 deriving (Data, Eq, Show, Typeable)

instance Functor Journal where
	fmap f (Journal t) = Journal (fmap (fmap f) t)
instance Foldable Journal where
	foldMap f (Journal t) = foldMap (foldMap f) t
instance Monoid (Journal t) where
	mempty = Journal mempty
	mappend (Journal x) (Journal y) =
		Journal $ Map.unionWith (flip mappend) x y
instance NFData t => NFData (Journal t) where
	rnf (Journal t) = rnf t
instance Journal_Transaction t
 => Consable t (Journal t) where
	mcons = journal_cons

-- | Return the given 'Journal'
--   updated by the given 'Journal_Transaction'.
--
-- NOTE: to reduce memory consumption when 'cons'ing iteratively,
--       the given 'Journal' is matched strictly.
journal_cons :: Journal_Transaction t => t -> Journal t -> Journal t
journal_cons t (Journal !ts) =
	Journal $
	Map.insertWith (flip mappend)
	 (transaction_date t) [t] ts

journal_transactions :: Journal_Transaction t => Journal t -> Map Date [t]
journal_transactions (Journal ts) = ts