{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
module Hcompta.Transaction where

import           Control.DeepSeq (NFData)
import           Data.Data
import           Data.Eq (Eq)
import           Data.Function (($), (.), const)
import           Data.Monoid (Monoid(..))
import           Data.Ord (Ord)
import           Data.Text (Text)
import           Data.Typeable ()
import           Text.Show (Show)
import           Data.Tuple (fst, snd)

import           Hcompta.Anchor
import           Hcompta.Date (Date)
import           Hcompta.Lib.Consable (Consable(..))
import           Hcompta.Posting (Posting)
import           Hcompta.Tag

-- * Class 'Transaction'

class
    Posting (Transaction_Posting t)
 => Transaction t where
	type Transaction_Posting  t
	type Transaction_Postings t
	transaction_date        :: t -> Date
	transaction_description :: t -> Description
	transaction_postings    :: t -> Transaction_Postings t
	transaction_tags        :: t -> Transaction_Tags

instance Posting posting => Transaction (Date, [posting]) where
	type Transaction_Posting  (Date, [posting]) = posting
	type Transaction_Postings (Date, [posting]) = [posting]
	transaction_date        = fst
	transaction_description = const mempty
	transaction_postings    = snd
	transaction_tags        = const mempty

-- ** Type 'Description'

type Description = Text

-- * Type 'Transaction_Anchor'
newtype Transaction_Anchor
 =      Transaction_Anchor Anchor
 deriving (Data, Eq, NFData, Ord, Show, Typeable)
newtype Transaction_Anchors
 =      Transaction_Anchors Anchors
 deriving (Data, Eq, Monoid, NFData, Show, Typeable)

instance Consable Anchor Transaction_Anchors where
	mcons a (Transaction_Anchors anchors) =
		Transaction_Anchors $ mcons a anchors

transaction_anchor :: Anchor_Path -> Transaction_Anchor
transaction_anchor = Transaction_Anchor . anchor

-- | Return the given 'Transaction_Anchors'
-- with the given 'Transaction_Anchor' incorporated.
transaction_anchor_cons :: Transaction_Anchor -> Transaction_Anchors -> Transaction_Anchors
transaction_anchor_cons (Transaction_Anchor t) (Transaction_Anchors ts) =
	Transaction_Anchors $ anchor_cons t ts

-- * Type 'Transaction_Tag'

newtype Transaction_Tag
 =      Transaction_Tag Tag
 deriving (Data, Eq, NFData, Ord, Show, Typeable)
newtype Transaction_Tags
 =      Transaction_Tags Tags
 deriving (Data, Eq, Monoid, NFData, Show, Typeable)

instance Consable Tag Transaction_Tags where
	mcons t (Transaction_Tags tags) =
		Transaction_Tags $ mcons t tags

transaction_tag :: Tag_Path -> Tag_Value -> Transaction_Tag
transaction_tag p v = Transaction_Tag $ tag p v

-- | Return the given 'Transaction_Tags' with the given 'Transaction_Tag' incorporated.
transaction_tag_cons :: Transaction_Tag -> Transaction_Tags -> Transaction_Tags
transaction_tag_cons (Transaction_Tag t) (Transaction_Tags ts) =
	Transaction_Tags $ tag_cons t ts