{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NamedFieldPuns #-}
module Hcompta.Format.Ledger.Journal where

-- import           Control.Applicative ((<$>))
import qualified Control.Monad
import           Data.Foldable hiding (fold)
import qualified Data.List
import qualified Data.Monoid (getFirst, First(..))
-- import           Data.Monoid (Monoid, mappend)
import qualified Data.Map.Strict as Data.Map
import           Prelude hiding (traverse)
import           Data.Typeable ()

import qualified Hcompta.Amount.Style as Amount.Style
import           Hcompta.Format.Ledger (Journal(..))
import qualified Hcompta.Format.Ledger as Ledger
import           Hcompta.Lib.Consable (Consable(..))

-- * Extractors

-- | Return the given accumulator folded over
--   the given 'Journal' and its 'journal_includes' 'Journal's.
fold :: Consable ts t => (Journal ts t -> a -> a) -> Journal ts t -> a -> a
fold f j@Journal{journal_includes} a =
	Data.List.foldl'
	 (flip (fold f)) (f j a)
	 journal_includes

-- | Return the given accumulator folded over
--   the given 'Journal' and its 'journal_includes' 'Journal's.
foldM :: (Monad m, Consable ts t) => (Journal ts t -> a -> m a) -> Journal ts t -> a -> m a
foldM f j@Journal{journal_includes} a = do
	ma <- f j a
	Control.Monad.foldM
	 (flip (foldM f)) ma
	 journal_includes

-- | Return the given accumulator folded with the given function
--   over the given 'Journal' and its 'journal_includes' 'Journal's.
fold_map :: (Monoid a, Consable ts t) => (Journal ts t -> a -> a) -> Journal ts t -> a -> a
fold_map f j@(Journal{journal_includes}) =
	(f j) `mappend` foldMap (fold_map f) journal_includes

-- | Return the first non-'Nothing' value returned by the given function
--   when applied to the given 'Journal' or its 'journal_includes' 'Journal's,
--   with the parent 'Journal's.
find :: Consable ts t => (Journal ts t -> Maybe a) -> Journal ts t -> Maybe (a, [Journal ts t])
find f =
	(\x -> case x of
	 Nothing -> Nothing
	 Just (a, path) -> Just (a, reverse path))
	. find_ []
	where
		find_ path j@Journal{journal_includes} =
			case f j of
			 Just a -> Just (a, path)
			 Nothing ->
				Data.Monoid.getFirst $
				foldMap (Data.Monoid.First . (find_ (j:path))) $
				journal_includes

-- | Return the given 'Journal' and its 'journal_includes' 'Journal's
--   mapped by the given function.
traverse :: Consable ts t => (Journal ts t -> Journal ts t) -> Journal ts t -> Journal ts t
traverse f =
	(\x -> case x of
	 j@Journal{journal_includes} ->
		j{journal_includes = Data.List.map (traverse f) journal_includes})
	. f

-- * Constructors

union :: Consable ts t => Journal ts t -> Journal ts t -> Journal ts t
union j0 j1 =
	j1{ journal_transactions = mappend (journal_transactions j0) (journal_transactions j1)
	 ,  journal_unit_styles  = Data.Map.unionWith Amount.Style.union (journal_unit_styles j0) (journal_unit_styles j1)
	 ,  journal_last_read_time = min (journal_last_read_time j0) (journal_last_read_time j1)
	 }

unions :: (Foldable f, Consable ts t) => f (Journal ts t) -> Journal ts t
unions = Data.Foldable.foldl' (flip union) Ledger.journal

-- | Return the 'Journal' with its 'journal_transactions'
--   recursively completed by the 'journal_transactions'
--   of its 'journal_includes', now empty.
flatten :: Consable ts t => Journal ts t -> Journal ts t
flatten jnl =
	jnl
	 { journal_includes = []
	 , journal_transactions = flat journal_transactions jnl
	 }
	where
		flat :: Consable ts t => (Journal ts t -> ts t) -> Journal ts t -> ts t
		flat g j = mconcat $ g j : Data.List.map (flat g) (journal_includes j)