{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
module Hcompta.LCC.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 as Monoid
import Data.Typeable (Typeable)
import Prelude (seq, min)
import System.IO (FilePath)
import Text.Show (Show(..))

import qualified Hcompta as H
import Hcompta.LCC.Account
import Hcompta.LCC.Amount
import Hcompta.LCC.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 = H.date_epoch
	 }

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{..} =
		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 =
			case f j of
			 Just a -> Just (a, path)
			 Nothing ->
				Monoid.getFirst $
				foldMap (Monoid.First . (find_ (j:path))) $
				journal_includes j

-- | 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 = [] }