{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.LCC.Journal where

-- import Data.NonNull (NonNull)
-- import Data.Text (Text)
-- import qualified Data.NonNull as NonNull
-- import qualified Data.Text as Text
import Control.DeepSeq (NFData(..))
import Data.Data (Data(..))
import Data.Eq (Eq(..))
import Data.Foldable (Foldable(..))
import Data.Function (($), (.))
import Data.Functor (Functor(..), (<$>))
import Data.Functor.Compose (Compose(..))
import Data.Map.Strict (Map)
-- import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
-- import Data.String (IsString(..))
import Data.Traversable (Traversable(..))
import Data.TreeMap.Strict (TreeMap)
import Data.Typeable (Typeable)
import Prelude (seq)
import Text.Show (Show(..))
import qualified Data.MonoTraversable as MT
-- import qualified System.FilePath.Posix as FP

{-
import Data.Tree
import Control.Monad (Monad(..), foldM)
import Data.List (reverse)
import Data.Maybe (Maybe(..))
import qualified Data.Monoid as Monoid
import Data.Semigroup (Semigroup(..))
-}

import qualified Hcompta as H
-- import Hcompta.LCC.Account
-- import Hcompta.LCC.Amount
-- import Hcompta.LCC.Chart
import Hcompta.LCC.IO
import Hcompta.LCC.Posting
-- import Hcompta.LCC.Transaction

-- * Type 'Journal'
data Journal j
 =   Journal
 {   journal_file           :: !PathFile
 ,   journal_last_read_time :: !Date
 ,   journal_content        :: !j
 ,   journal_includes       :: ![CanonFile]
 } deriving (Data, Eq, Show, Typeable)

type instance MT.Element (Journal j) = j
instance Functor Journal where
	fmap f j@Journal{journal_content{- DELME: , journal_includes-}} =
		j{ journal_content = f journal_content
		 {- DELME: , journal_includes = fmap f <$> journal_includes-}
		 }
instance MT.MonoFunctor (Journal j)
instance Foldable Journal where
	foldMap f Journal{journal_content{- DELME: , journal_includes-}} =
		f journal_content {- DELME: `mappend`
		(foldMap f `foldMap` journal_includes)-}
instance MT.MonoFoldable (Journal j)
instance Traversable Journal where
	traverse f j = (\c -> j{journal_content=c}) <$> f (journal_content j)
instance NFData j => NFData (Journal j) where
	rnf Journal{..} =
		rnf journal_file `seq`
		rnf journal_last_read_time `seq`
		rnf journal_content `seq`
		rnf journal_includes

journal :: j -> Journal j
journal j =
	Journal
	 { journal_file           = ""
	 , journal_last_read_time = H.epoch
	 , journal_content        = j
	 , journal_includes       = []
	 }

{-
instance Semigroup j => Semigroup (Journal j) where
	(<>) = journal_union
instance (Monoid j, Semigroup j) => Monoid (Journal j) where
	mempty  = journal
	mappend = journal_union

journal_union :: Semigroup j => Journal j -> Journal j -> Journal j
journal_union x y =
	Journal
	 { journal_last_read_time = journal_last_read_time x `min` journal_last_read_time y
	 , journal_content        = journal_content        x <>    journal_content        y
	 , journal_includes       = journal_includes       x <>    journal_includes       y
	 }

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

{-
-- | 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_foldMap :: Monoid a => (Journal j -> a -> a) -> Journal j -> a -> a
journal_foldMap f j@(Journal{journal_includes}) =
	f j `mappend` foldMap (journal_foldMap 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 = journal_traverse f <$> journal_includes})
	. f

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

-- * Type 'Journals'
newtype Journals j = Journals (Map CanonFile (Journal j))
 deriving (Data, Eq, Show, Typeable)
type instance MT.Element (Journals j) = Journal j

instance MT.MonoFunctor (Journals j) where
	omap f (Journals m) = Journals $ f `MT.omap` m
instance MT.MonoFoldable (Journals j) where
	ofoldMap f   (Journals m) = MT.ofoldMap f m
	ofoldr f a   (Journals m) = MT.ofoldr f a m
	ofoldl' f a  (Journals m) = MT.ofoldl' f a m
	ofoldr1Ex f  (Journals m) = MT.ofoldr1Ex f m
	ofoldl1Ex' f (Journals m) = MT.ofoldl1Ex' f m
instance MT.MonoTraversable (Journals j) where
	otraverse f (Journals m) = Journals <$> MT.otraverse f m

instance Functor Journals where
	fmap f (Journals m) = Journals $ fmap f <$> m
instance Foldable Journals where
	foldMap f (Journals m) = f `foldMap` Compose m
instance Traversable Journals where
	traverse f (Journals m) =
		Journals . getCompose <$> (f `traverse` Compose m)




{-
-- ** Type 'JournalFile'
newtype JournalFile = JournalFile PathFile
 deriving (Data, Eq, NFData, Ord, Show, Typeable)
unJournalFile :: JournalFile -> PathFile
unJournalFile (JournalFile fp) = fp

-- ** Type 'JournalFileCanon'
newtype JournalFileCanon = JournalFileCanon JournalFile
 deriving (Data, Eq, NFData, Ord, Show, Typeable)
unJournalFileCanon :: JournalFileCanon -> JournalFile
unJournalFileCanon (JournalFileCanon jf) = jf

journalFileCanon :: JournalFile -> IO JournalFileCanon
journalFileCanon (JournalFile (PathFile fp)) =
	JournalFileCanon . JournalFile . fromString
	 <$> IO.canonicalizePath fp

newtype Journals j = Journals (Forest (Journal j))
 deriving (Data, Eq, Show, Typeable)
type instance MT.Element (Journals j) = Journal j
instance MT.MonoFunctor (Journals j) where
	omap f (Journals m) = Journals $ f `MT.omap` m
instance MT.MonoFoldable (Journals j) where
	ofoldMap f   (Journals m) = MT.ofoldMap f m
	ofoldr f a   (Journals m) = MT.ofoldr f a m
	ofoldl' f a  (Journals m) = MT.ofoldl' f a m
	ofoldr1Ex f  (Journals m) = MT.ofoldr1Ex f m
	ofoldl1Ex' f (Journals m) = MT.ofoldl1Ex' f m
instance MT.MonoTraversable (Journals j) where
	otraverse f (Journals m) = Journals <$> MT.otraverse f m


instance Functor Journals where
	fmap f (Journals m) = Journals $
		getCompose $ getCompose . fmap f $ Compose (Compose m)
instance Foldable Journals where
	foldMap f (Journals m) = foldMap f $ Compose (Compose m)
instance Traversable Journals where
	traverse f (Journals m) =
		Journals . getCompose . getCompose
		 <$> traverse f (Compose (Compose m))

instance Functor Journals where
	fmap f (Journals m) = Journals $ fmap f <$> m
instance Foldable Journals where
	foldMap f (Journals m) = f `foldMap` Compose m
instance Traversable Journals where
	traverse f (Journals m) =
		Journals . getCompose <$> (f `traverse` Compose m)

journals_flatten :: Journals j -> Journal j
journals_flatten js@(Journals m)
	Map.fold
	MT.ofoldr1Ex (\j) js
-- | Return the 'Journal' recursively 'mappend'-ed
--   with its 'journal_includes', now empty.
journal_flatten :: (Monoid j, Semigroup j) => Journal j -> Journal j
journal_flatten jnl =
	(mconcat $ (:) jnl $ journal_flatten <$>
		journal_includes jnl) { journal_includes = [] }
-}

type instance MT.Element (TreeMap k a) = a
instance Ord k => MT.MonoFunctor     (TreeMap k a)
instance Ord k => MT.MonoFoldable    (TreeMap k a)
instance Ord k => MT.MonoTraversable (TreeMap k a)