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

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

import           Hcompta.Format.JCC (Journal(..))
import qualified Hcompta.Format.JCC as JCC
-- import           Hcompta.Lib.Consable (Consable(..))

-- * Extractors

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

-- * Constructors

unions :: (Foldable f, Monoid j) => f (Journal j) -> Journal j
unions = foldl' (flip mappend) JCC.journal

-- | Return the 'Journal' recursively 'mappend'-ed
--   with its 'journal_includes', now empty.
flatten :: Monoid j => Journal j -> Journal j
flatten jnl =
	(mconcat $ (:) jnl $ fmap flatten $ journal_includes jnl)
	 { journal_includes = []
	 }