{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Hcompta.Posting where

import           Control.DeepSeq (NFData)
import           Data.Data
import           Data.Eq (Eq)
-- import           Data.Foldable (Foldable(..))
import           Data.Function (($), (.))
import           Data.Map.Strict (Map)
import           Data.Monoid (Monoid)
import           Data.Ord (Ord)
import           Data.Tuple (fst, snd)
import           Data.Typeable ()
import           Text.Show (Show)
import qualified Data.MonoTraversable as MT

import           Hcompta.Account
import           Hcompta.Amount
import           Hcompta.Anchor
import           Hcompta.Tag

-- * Class 'Posting'

class
 ( Account (Posting_Account p)
 , Amount  (Posting_Amount  p)
 , MT.MonoFoldable (Posting_Amounts p)
 ) => Posting p where
	type Posting_Account p
	type Posting_Amount  p
	type Posting_Amounts p
	posting_account :: p -> Posting_Account p
	posting_amounts :: p -> Posting_Amounts p

-- Type (account, Map unit quantity)
instance -- Posting
 ( Account account
 , Amount (unit, quantity)
 -- , Amount (MT.Element amounts)
 -- , MT.MonoFoldable amounts
 ) => Posting (account, Map unit quantity) where
	type Posting_Account (account, Map unit quantity) = account
	type Posting_Amount  (account, Map unit quantity) = (unit, quantity) -- MT.Element amounts
	type Posting_Amounts (account, Map unit quantity) = Map unit quantity
	posting_account = fst
	posting_amounts = snd

-- * Type 'Posting_Anchor'

newtype Posting_Anchor
 =      Posting_Anchor Anchor
 deriving (Data, Eq, NFData, Ord, Show, Typeable)
newtype Posting_Anchors
 =      Posting_Anchors Anchors
 deriving (Data, Eq, Monoid, NFData, Show, Typeable)

posting_anchor :: Anchor_Path -> Posting_Anchor
posting_anchor = Posting_Anchor . anchor

-- | Return the given 'Posting_Anchors' with the given 'Posting_Anchor' incorporated.
posting_anchor_cons :: Posting_Anchor -> Posting_Anchors -> Posting_Anchors
posting_anchor_cons (Posting_Anchor t) (Posting_Anchors ts) =
	Posting_Anchors $ anchor_cons t ts

-- * Type 'Posting_Tag'

newtype Posting_Tag
 =      Posting_Tag Tag
 deriving (Data, Eq, NFData, Ord, Show, Typeable)
newtype Posting_Tags
 =      Posting_Tags Tags
 deriving (Data, Eq, Monoid, NFData, Show, Typeable)

posting_tag :: Tag_Path -> Tag_Value -> Posting_Tag
posting_tag p v = Posting_Tag $ tag p v

-- | Return the given 'Posting_Tags' with the given 'Posting_Tag' incorporated.
posting_tag_cons :: Posting_Tag -> Posting_Tags -> Posting_Tags
posting_tag_cons (Posting_Tag t) (Posting_Tags ts) =
	Posting_Tags $ tag_cons t ts