{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Hcompta.LCC.Transaction where

import Control.DeepSeq (NFData(..))
import Data.Data (Data(..))
import Data.Eq (Eq(..))
import Data.Function (($), (.))
import Data.Functor.Compose (Compose(..))
import Data.Map.Strict (Map)
import Data.Monoid (Monoid(..))
import Data.NonNull (NonNull)
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (IsString)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Prelude (flip, seq)
import Text.Show (Show)
import qualified Data.List as List
import qualified Data.Map.Strict as Map
import qualified Data.MonoTraversable as MT
import qualified Data.NonNull as NonNull

import Language.Symantic.Grammar (Source(..))
import qualified Hcompta as H

import Hcompta.LCC.Tag
import Hcompta.LCC.Posting

-- * Type 'Transaction'
data Transaction src
 =   Transaction
 {   transaction_comments  :: [Comment]
 ,   transaction_dates     :: NonNull [Date]
 ,   transaction_postings  :: Postings src
 ,   transaction_sourcepos :: src
 ,   transaction_tags      :: Transaction_Tags
 ,   transaction_wording   :: Wording
 } deriving (Data, Eq, Ord, Show, Typeable)
transaction_date :: Transaction src -> Date
transaction_date = NonNull.head . transaction_dates
-- instance H.Transaction Transaction
instance NFData src => NFData (Transaction src) where
	rnf Transaction{..} =
		rnf transaction_comments `seq`
		rnf transaction_dates `seq`
		rnf transaction_postings `seq`
		rnf transaction_sourcepos `seq`
		rnf transaction_tags `seq`
		rnf transaction_wording
type instance MT.Element (Transaction src) = Posting src
instance MT.MonoFunctor (Transaction src) where
	omap f t = t{transaction_postings = f `MT.omap` transaction_postings t}
instance MT.MonoFoldable (Transaction src) where
	ofoldMap f   = MT.ofoldMap f   . transaction_postings
	ofoldr f a   = MT.ofoldr f a   . transaction_postings
	ofoldl' f a  = MT.ofoldl' f a  . transaction_postings
	ofoldr1Ex f  = MT.ofoldr1Ex f  . transaction_postings
	ofoldl1Ex' f = MT.ofoldl1Ex' f . transaction_postings

-- type instance H.Postings H.:@ Transaction = Postings
instance H.Get (Postings src) (Transaction src) where
	get = transaction_postings

{-
type instance H.Date H.:@ Transaction = Date
instance H.GetI H.Date Transaction where
	getI = NonNull.head . transaction_dates
instance H.SetI H.Date Transaction where
	setI d t = t{transaction_dates =
		NonNull.ncons d $ NonNull.tail $ transaction_dates t}

type instance H.Postings H.:@ Transaction = Postings
instance H.GetI H.Postings Transaction where
	getI = transaction_postings
instance H.SetI H.Postings Transaction where
	setI transaction_postings t = t{transaction_postings}
-}

transaction :: Source src => Transaction src
transaction =
	Transaction
	 { transaction_comments  = []
	 , transaction_dates     = NonNull.ncons H.epoch []
	 , transaction_postings  = mempty
	 , transaction_sourcepos = noSource
	 , transaction_tags      = mempty
	 , transaction_wording   = ""
	 }

{-
-- ** Type 'Transaction_Anchor'
newtype Transaction_Anchor = Transaction_Anchor Anchor
 deriving (Data, Eq, NFData, Ord, Show, Typeable)
-- ** Type 'Transaction_Anchors'
newtype Transaction_Anchors = Transaction_Anchors Anchors
 deriving (Data, Eq, Monoid, NFData, Ord, Show, Typeable)
type instance MT.Element Transaction_Anchors = Transaction_Anchor
-}

-- ** Type 'Transaction_Tag'
newtype Transaction_Tag = Transaction_Tag Tag
 deriving (Data, Eq, NFData, Ord, Show, Typeable)
-- ** Type 'Transaction_Tags'
newtype Transaction_Tags = Transaction_Tags Tags
 deriving (Data, Eq, Monoid, NFData, Ord, Show, Typeable)
type instance MT.Element Transaction_Tags = Transaction_Tag

-- ** Type 'Transactions'
newtype Transactions src = Transactions (Map Date [Transaction src])
 deriving (Data, Eq, NFData, Ord, Show, Typeable)
instance Semigroup (Transactions src) where
	Transactions x <> Transactions y = Transactions $
		Map.unionWith (flip (<>)) x y
instance Monoid (Transactions src) where
	mempty  = Transactions mempty
	mappend = (<>)
instance H.Zeroable (Transactions src) where
	zero = Transactions mempty

type instance MT.Element (Transactions src) = Transaction src
-- instance H.Transactions Transactions

-- ** Type 'Wording'
newtype Wording = Wording Text
 deriving (Data, Eq, IsString, NFData, Ord, Show, Typeable)







{-

-- Transaction
instance H.Transaction      Transaction where
	type Transaction_Posting  Transaction = Posting
	type Transaction_Postings Transaction = Compose (Map Account) [] Posting
	transaction_date        = fst . transaction_dates
	transaction_description = transaction_wording
	transaction_postings    = Compose . transaction_postings
	transaction_tags        = transaction_tags
instance H.Transaction      (Charted Transaction) where
	type Transaction_Posting  (Charted Transaction) = H.Transaction_Posting  Transaction
	type Transaction_Postings (Charted Transaction) = H.Transaction_Postings Transaction
	transaction_date        = H.transaction_date . charted
	transaction_description = H.transaction_description . charted
	transaction_postings    = H.transaction_postings . charted
	transaction_tags        = H.transaction_tags . charted

-- Journal
instance H.Journal_Transaction Transaction
instance H.Journal_Transaction (Charted Transaction)

-- Stats
instance H.Stats_Transaction Transaction where
	stats_transaction_postings_count = Map.size . transaction_postings
instance H.Stats_Transaction (Charted Transaction) where
	stats_transaction_postings_count = H.stats_transaction_postings_count . charted

-- GL
instance H.GL_Transaction  Transaction where
	type GL_Transaction_Line Transaction = Transaction
	gl_transaction_line = id
	{-
	gl_transaction_postings_filter f t =
		t{ transaction_postings =
			Map.mapMaybe
			 (\post -> case List.filter f post of
				 [] -> Nothing
				 posts -> Just posts)
			 (transaction_postings t)
		 }
	-}
instance H.GL_Transaction  (Charted Transaction) where
	type GL_Transaction_Line (Charted Transaction) = H.GL_Transaction_Line Transaction
	gl_transaction_line = H.gl_transaction_line . charted
	{-
	gl_transaction_postings_filter f (Charted c t) =
		Charted c
		 t{ transaction_postings =
			Map.mapMaybe
			 (\post -> case List.filter f $ ({-Charted c <$>-} post) of
				 [] -> Nothing
				 posts -> Just $ {-charted <$>-} posts)
			 (transaction_postings t)
		 }
	-}

{-
instance Filter.Transaction (Charted Transaction) where
	type Transaction_Posting  (Charted Transaction) = Charted Posting
	type Transaction_Postings (Charted Transaction) = Compose (Map Account) []
	transaction_date = fst . transaction_dates . Chart.charted
	transaction_wording = transaction_wording . Chart.charted
	transaction_postings (Chart.Charted c t)  =
		fmap (Chart.Charted c) $
		Compose $ transaction_postings t
	{-
	transaction_postings_virtual (Chart.Charted c t) =
		fmap (Chart.Charted c) $
		Compose
		 [ Compose $ transaction_virtual_postings t
		 , Compose $ transaction_balanced_virtual_postings t
		 ]
	-}
	transaction_tags = transaction_tags . Chart.charted
-}
-}
-- | Return a 'Map' associating
--   the given 'Transaction's with their respective 'Date'.
transaction_by_date :: [Transaction src] -> (Compose (Map Date) []) (Transaction src)
transaction_by_date =
	Compose .
	Map.fromListWith (flip mappend) .
	List.map (\t -> (NonNull.head $ transaction_dates t, [t]))