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

-- import           Control.Applicative ((<$>))
import           Data.Data
import qualified Data.Foldable (foldMap)
import qualified Data.List
import qualified Data.Map.Strict as Data.Map
import           Data.Map.Strict (Map)
import qualified Data.Monoid (getFirst, First(..))
import           Data.Monoid (Monoid, mappend)
import qualified Data.Time.Clock       as Time
import qualified Data.Time.Clock.POSIX as Time
import           Data.Typeable ()

import qualified Hcompta.Model as Model
import qualified Hcompta.Model.Amount as Amount
import qualified Hcompta.Model.Journal as Model.Journal
import qualified Hcompta.Model.Transaction as Transaction

data Journal
 =   Journal
 { file :: FilePath
 , includes :: [Journal]
 -- , historical_prices :: [Amount.Price.Historical]
 , last_read_time :: Time.UTCTime
 , transactions :: Transaction.By_Date
 -- , transaction_periodics :: [Transaction.Periodic]
 -- , transaction_modifiers :: [Transaction.Modifier]
 , unit_styles :: Map Amount.Unit Amount.Style
 } deriving (Data, Eq, Read, Show, Typeable)

nil :: Journal
nil =
	Journal
	 { file = ""
	 , includes = []
	 , last_read_time = Time.posixSecondsToUTCTime 0
	 , transactions = Data.Map.empty
	 , unit_styles = Data.Map.empty
	 }

-- | Return the given accumulator folded over
--   the given 'Journal' and its 'includes' 'Journal's.
fold :: (Journal -> a -> a) -> Journal -> a -> a
fold f j@Journal{includes} a =
	Data.List.foldl (flip (Hcompta.Format.Ledger.Journal.fold f))
	 (f j a)
	 includes

-- | Return the first non-'Nothing' value returned by the given function
--   when applied to the given 'Journal' or its 'includes' 'Journal's,
--   with the parent 'Journal's.
find :: (Journal -> Maybe a) -> Journal -> Maybe (a, [Journal])
find f =
	(\case
	 Nothing -> Nothing
	 Just (a, path) -> Just (a, Data.List.reverse path))
	. find_ []
	where
		find_ path j@Journal{includes} =
			case f j of
			 Just a -> Just (a, path)
			 Nothing ->
				Data.Monoid.getFirst $
				Data.Foldable.foldMap (Data.Monoid.First . (find_ (j:path))) $
				includes

-- | Return the given 'Journal' and its 'includes' 'Journal's
--   mapped by the given function.
traverse :: (Journal -> Journal) -> Journal -> Journal
traverse f =
	(\case j@Journal{includes} ->
		j{includes=Data.List.map (traverse f) includes})
	. f

-- | Return the given accumulator folded with the given function
--   over the given 'Journal' and its 'includes' 'Journal's.
fold_map :: Monoid a => (Journal -> a -> a) -> Journal -> a -> a
fold_map f j@(Journal{includes}) =
	(f j) `mappend` Data.Foldable.foldMap (fold_map f) includes

-- | Return the Model.'Model.Journal' derived from the given 'Journal'.
to_Model :: Journal -> Model.Journal
to_Model jour =
	Model.Journal.Journal
	 { Model.Journal.transactions =
		Data.Map.unionsWith (++) $
		flatten transactions $ jour
	 }
	where
		flatten :: (Journal -> a) -> Journal -> [a]
		flatten g j = g j:Data.List.concatMap (flatten g) (includes j)