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

import           Control.DeepSeq (NFData(..))
import           Data.Bool
import           Data.Data (Data(..))
import           Data.Eq (Eq(..))
import           Data.Function (($), (.), id)
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.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 as H

import           Hcompta.Ledger.Account
import           Hcompta.Ledger.Posting
import           Hcompta.Ledger.Chart

-- * Type 'Transaction'

data Transaction
 =   Transaction
 {   transaction_code            :: Code
 ,   transaction_comments_before :: [Comment]
 ,   transaction_comments_after  :: [Comment]
 ,   transaction_dates           :: (H.Date, [H.Date])
 ,   transaction_postings        :: Map Account [Posting]
 ,   transaction_sourcepos       :: SourcePos
 ,   transaction_status          :: Status
 ,   transaction_tags            :: H.Transaction_Tags
 ,   transaction_wording         :: Wording
 } deriving (Data, Eq, Show, Typeable)

transaction :: Transaction
transaction =
	Transaction
	 { transaction_code            = ""
	 , transaction_comments_after  = []
	 , transaction_comments_before = []
	 , transaction_dates           = (H.date_epoch, [])
	 , transaction_postings        = mempty
	 , transaction_sourcepos       = initialPos ""
	 , transaction_status          = False
	 , transaction_tags            = mempty
	 , transaction_wording         = ""
	 }

instance NFData Transaction where
	rnf Transaction{..} =
		rnf transaction_code `seq`
		rnf transaction_comments_before `seq`
		rnf transaction_comments_after `seq`
		rnf transaction_dates `seq`
		rnf transaction_postings `seq`
		-- rnf transaction_sourcepos `seq`
		rnf transaction_status `seq`
		rnf transaction_tags `seq`
		rnf transaction_wording

-- 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
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

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

-- ** Type 'Wording'

type Wording = Text

-- ** Type 'Date'

type Date = H.Date

-- ** Type 'Code'

type Code = Text

-- ** Type 'Status'
type Status = Bool