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

import           Control.DeepSeq (NFData(..))
import           Control.Monad (Monad(..), foldM)
import           Data.Data (Data(..))
import           Data.Eq (Eq(..))
import           Data.Foldable (Foldable(..))
import           Data.Function (($), (.), flip)
import           Data.Functor (Functor(..), (<$>))
import           Data.List (reverse)
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import qualified Data.Monoid (getFirst, First(..))
import           Data.Typeable (Typeable)
import           Text.Show (Show(..))
import           Prelude (seq, min)
import           System.IO (FilePath)

import           Hcompta.Date (Date)
import qualified Hcompta.Date as Date
import           Hcompta.Format.Ledger.Amount
import           Hcompta.Format.Ledger.Chart

-- * Type 'Journal'

data Journal j
 = Journal
 { journal_amount_styles  :: !Amount_Styles
 , journal_chart          :: Chart
 , journal_content        :: !j
 , journal_files          :: [FilePath]
 , journal_includes       :: [Journal j]
 , journal_last_read_time :: Date
 } deriving (Data, Eq, Show, Typeable)

instance Functor Journal where
	fmap f j@Journal{journal_includes, journal_content} =
		j{ journal_content  = f journal_content
		 , journal_includes = fmap (fmap f) journal_includes
		 }

journal :: Monoid j => Journal j
journal =
	Journal
	 { journal_amount_styles  = mempty
	 , journal_chart          = mempty
	 , journal_content        = mempty
	 , journal_files          = mempty
	 , journal_includes       = mempty
	 , journal_last_read_time = Date.nil
	 }

instance Monoid j => Monoid (Journal j) where
	mempty = journal
	mappend x y =
		Journal
		 { journal_amount_styles  = journal_amount_styles  x `mappend` journal_amount_styles  y
		 , journal_chart          = journal_chart          x `mappend` journal_chart          y
		 , journal_content        = journal_content        x `mappend` journal_content        y
		 , journal_files          = journal_files          x `mappend` journal_files          y
		 , journal_includes       = journal_includes       x `mappend` journal_includes       y
		 , journal_last_read_time = journal_last_read_time x `min`     journal_last_read_time y
		 }
instance NFData j => NFData (Journal j) where
	rnf
	 Journal
	 { journal_amount_styles
	 , journal_chart
	 , journal_content
	 , journal_files
	 , journal_includes
	 , journal_last_read_time
	 } =
		rnf journal_amount_styles `seq`
		rnf journal_chart `seq`
		rnf journal_content `seq`
		rnf journal_files `seq`
		rnf journal_includes `seq`
		rnf journal_last_read_time

-- * Extractors

-- | Return the given accumulator folded over
--   the given 'Journal' and its 'journal_includes' 'Journal's.
journal_fold :: (Journal j -> a -> a) -> Journal j -> a -> a
journal_fold f j@Journal{journal_includes} a =
	foldl'
	 (flip (journal_fold f)) (f j a)
	 journal_includes

-- | Return the given accumulator folded over
--   the given 'Journal' and its 'journal_includes' 'Journal's.
journal_foldM :: Monad m => (Journal j -> a -> m a) -> Journal j -> a -> m a
journal_foldM f j@Journal{journal_includes} a = do
	ma <- f j a
	foldM
	 (flip (journal_foldM f)) ma
	 journal_includes

-- | Return the given accumulator folded with the given function
--   over the given 'Journal' and its 'journal_includes' 'Journal's.
journal_fold_map :: Monoid a => (Journal j -> a -> a) -> Journal j -> a -> a
journal_fold_map f j@(Journal{journal_includes}) =
	(f j) `mappend` foldMap (journal_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.
journal_find :: (Journal j -> Maybe a) -> Journal j -> Maybe (a, [Journal j])
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.
journal_traverse :: (Journal j -> Journal j) -> Journal j -> Journal j
journal_traverse f =
	(\x -> case x of
	 j@Journal{journal_includes} ->
		j{journal_includes = fmap (journal_traverse f) journal_includes})
	. f

-- * Constructors

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

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