{-# 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.Map.Strict as Data.Map
import qualified Data.Monoid (getFirst, First(..))
-- import           Data.Monoid (Monoid, mappend)
import           Prelude hiding (traverse)
import           Data.Typeable ()

import qualified Hcompta.Format.Ledger as Ledger
import           Hcompta.Format.Ledger (Journal(..))

-- * Extractors

-- | Return the given accumulator folded over
--   the given 'Journal' and its 'journal_includes' 'Journal's.
fold :: (Journal -> a -> a) -> Journal -> 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 => (Journal -> a -> m a) -> Journal -> 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 => (Journal -> a -> a) -> Journal -> 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 :: (Journal -> Maybe a) -> Journal -> Maybe (a, [Journal])
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 :: (Journal -> Journal) -> Journal -> Journal
traverse f =
	(\x -> case x of
	 j@Journal{journal_includes} ->
		j{journal_includes = Data.List.map (traverse f) journal_includes})
	. f

-- * Constructors

union :: Journal -> Journal -> Journal
union
 Journal{ journal_transactions=t0 }
 j@Journal{ journal_transactions=t1 } =
	j{ journal_transactions = Data.Map.unionWith (++) t0 t1 }

unions :: Foldable t => t Journal -> Journal
unions = Data.Foldable.foldl' union Ledger.journal

-- | Return the 'Journal' with its 'journal_transactions'
--   recursively completed by the 'journal_transactions'
--   of its 'journal_includes', now empty.
flatten :: Journal -> Journal
flatten jnl =
	Ledger.journal
	 { journal_transactions =
		Data.Map.unionsWith (++) $
		flat journal_transactions jnl
	 , journal_includes = []
	 }
	where
		flat :: (Journal -> a) -> Journal -> [a]
		flat g j = g j:Data.List.concatMap (flat g) (journal_includes j)