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

import           Control.DeepSeq (NFData)
import           Data.Data
import           Data.Eq (Eq)
import           Data.Function (($), (.), const)
import           Data.Map.Strict (Map)
import           Data.Monoid (Monoid(..))
import qualified Data.MonoTraversable as MT
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
import           Hcompta.Tag
import           Hcompta.Has

-- * Class 'Transaction'
class
 ( HasI Date t
 , HasI Postings t
 ) => Transaction t

-- * Class 'Transactions'
class Transaction (MT.Element ts) => Transactions ts

{-
-- * Class 'Transaction'
class
 ( Date     (Transaction_Date t)
 , Postings (Transaction_Postings t)
 ) => Transaction t where
	type Transaction_Date     t
	type Transaction_Postings t
	type Transaction_Wording  t
	transaction_date     :: t -> Transaction_Date t
	transaction_postings :: t -> Transaction_Postings t
	transaction_wording  :: t -> Transaction_Wording t
	-- transaction_tags        :: t -> Transaction_Tags

instance
 ( Date date
 , Postings ps
 ) => Transaction (date, ps) where
	type Transaction_Date     (date, ps) = date
	type Transaction_Postings (date, ps) = ps
	type Transaction_Wording  (date, ps) = ()
	transaction_date     = fst
	transaction_postings = snd
	transaction_wording  = const ()
	-- transaction_tags        = const mempty

-- * Class 'Transactions'
class Transaction (Transactions_Transaction ts) => Transactions ts where
	type Transactions_Transaction ts
instance
 Transaction t =>
 Transactions [t] where
	type Transactions_Transaction [t] = t
instance
 Transactions ts =>
 Transactions (Map date ts) where
	type Transactions_Transaction (Map date ts) = Transactions_Transaction ts
-}
{-
-- ** 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
-}