{-# 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 :: Monoid (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, Monoid (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, Monoid (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 :: Monoid (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 :: Monoid (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 :: Monoid (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, Monoid (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 :: Monoid (ts t) => Journal (ts t) -> Journal (ts t)
flatten jnl =
	jnl
	 { journal_includes = []
	 , journal_transactions = flat journal_transactions jnl
	 }
	where
		flat :: Monoid (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)