{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
module Hcompta.Format.JCC.Transaction where

import           Control.DeepSeq (NFData(..))
import           Data.Data (Data(..))
import           Data.Eq (Eq(..))
import           Data.Function (($), (.), id)
import           Data.Functor (Functor(..))
import           Data.Functor.Compose (Compose(..))
import qualified Data.List as List
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import           Data.Text (Text)
import           Data.Tuple (fst)
import           Data.Typeable (Typeable)
import           Prelude (flip, seq)
import           Text.Parsec.Pos (SourcePos, initialPos)
import           Text.Show (Show)

import qualified Hcompta.Chart as Chart
import           Hcompta.Date (Date)
import qualified Hcompta.Date as Date
import qualified Hcompta.Filter as Filter
import qualified Hcompta.GL as GL
import qualified Hcompta.Journal as Journal
import           Hcompta.Lib.Parsec ()
import qualified Hcompta.Stats as Stats
import           Hcompta.Transaction ( Transaction_Tags(..)
                                     , Transaction_Anchors(..) )

import           Hcompta.Format.JCC.Account
import           Hcompta.Format.JCC.Posting
import           Hcompta.Format.JCC.Chart

type Wording = Text

-- * Type 'Transaction'

data Transaction
 =   Transaction
 { transaction_anchors   :: Transaction_Anchors
 , transaction_comments  :: [Comment]
 , transaction_dates     :: (Date, [Date])
 , transaction_postings  :: Map Account [Posting]
 , transaction_sourcepos :: SourcePos
 , transaction_tags      :: Transaction_Tags
 , transaction_wording   :: Wording
 } deriving (Data, Eq, Show, Typeable)
instance NFData Transaction where
	rnf
	 Transaction
	 { transaction_anchors
	 , transaction_comments
	 , transaction_dates
	 , transaction_postings
	 -- , transaction_sourcepos
	 , transaction_tags
	 , transaction_wording
	 } =
		rnf transaction_anchors `seq`
		rnf transaction_comments `seq`
		rnf transaction_dates `seq`
		rnf transaction_postings `seq`
		-- rnf transaction_sourcepos `seq`
		rnf transaction_tags `seq`
		rnf transaction_wording

transaction :: Transaction
transaction =
	Transaction
	 { transaction_anchors   = mempty
	 , transaction_comments  = []
	 , transaction_dates     = (Date.nil, [])
	 , transaction_postings  = mempty
	 , transaction_sourcepos = initialPos ""
	 , transaction_tags      = mempty
	 , transaction_wording   = ""
	 }

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

instance Journal.Transaction Transaction where
	transaction_date = fst . transaction_dates
instance Journal.Transaction (Charted Transaction) where
	transaction_date = Journal.transaction_date . Chart.charted

instance Stats.Transaction  Transaction where
	type Transaction_Posting  Transaction = Posting
	type Transaction_Postings Transaction = Compose (Map Account) []
	transaction_date = fst . transaction_dates
	transaction_postings = Compose . transaction_postings
	transaction_postings_size = Map.size . transaction_postings
	transaction_tags = transaction_tags
instance Stats.Transaction  (Charted Transaction) where
	type Transaction_Posting  (Charted Transaction) = Stats.Transaction_Posting  Transaction
	type Transaction_Postings (Charted Transaction) = Stats.Transaction_Postings Transaction
	transaction_date = Stats.transaction_date . Chart.charted
	transaction_postings = Stats.transaction_postings . Chart.charted
	transaction_postings_size = Stats.transaction_postings_size . Chart.charted
	transaction_tags = Stats.transaction_tags . Chart.charted

instance GL.Transaction     Transaction where
	type Transaction_Line     Transaction = Transaction
	type Transaction_Posting  Transaction = Posting
	type Transaction_Postings Transaction = Compose (Map Account) []
	transaction_line = id
	transaction_date = fst . transaction_dates
	transaction_postings = Compose . transaction_postings
	transaction_postings_filter f t =
		t{ transaction_postings =
			Map.mapMaybe
			 (\p -> case List.filter f p of
				 [] -> Nothing
				 ps -> Just ps)
			 (transaction_postings t)
		 }
instance GL.Transaction     (Charted Transaction) where
	type Transaction_Line     (Charted Transaction) = Transaction
	type Transaction_Posting  (Charted Transaction) = (Charted (GL.Transaction_Posting Transaction))
	type Transaction_Postings (Charted Transaction) = GL.Transaction_Postings Transaction
	transaction_line = Chart.charted
	transaction_date = GL.transaction_date . Chart.charted
	transaction_postings (Chart.Charted c t) =
		fmap (Chart.Charted c) $
		GL.transaction_postings t
	transaction_postings_filter f (Chart.Charted c t) =
		Chart.Charted c
		 t{ transaction_postings =
			Map.mapMaybe
			 (\p -> case List.filter f $ fmap (Chart.Charted c) p of
				 [] -> Nothing
				 ps -> Just $ fmap Chart.charted ps)
			 (transaction_postings t)
		 }

-- | Return a 'Map' associating
--   the given 'Transaction's with their respective 'Date'.
transaction_by_date :: [Transaction] -> (Compose (Map Date) []) Transaction
transaction_by_date =
	Compose .
	Map.fromListWith (flip mappend) .
	List.map (\t -> (fst $ transaction_dates t, [t]))