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

-- import           Control.Applicative ((<$>))
import qualified Data.Foldable (foldMap)
import           Data.Foldable (Foldable(..))
import qualified Data.List
import qualified Data.Map.Strict as Data.Map
import qualified Data.Monoid (getFirst, First(..))
import           Data.Monoid (Monoid, mappend)
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 (Hcompta.Format.Ledger.Journal.fold f))
	 (f j a)
	 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` Data.Foldable.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, Data.List.reverse path))
	. find_ []
	where
		find_ path j@Journal{journal_includes} =
			case f j of
			 Just a -> Just (a, path)
			 Nothing ->
				Data.Monoid.getFirst $
				Data.Foldable.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)