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

import qualified Control.Monad
import           Control.Monad (Monad(..))
import           Data.Foldable hiding (fold)
import           Data.List (reverse, foldl', map)
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import qualified Data.Monoid (getFirst, First(..))
import           Data.Ord (Ord(..))
import           Data.Typeable ()
import           Prelude (($), (.), flip)

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_sections       = journal_sections j0 `mappend` journal_sections j1
	 ,  journal_amount_styles  = mappend (journal_amount_styles j0) (journal_amount_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_sections'
--   recursively completed by the 'journal_sections'
--   of its 'journal_includes', now empty.
flatten :: Monoid (ts t) => Journal (ts t) -> Journal (ts t)
flatten jnl =
	jnl
	 { journal_includes = []
	 , journal_sections = flat journal_sections 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)