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

import           Control.DeepSeq (NFData)
import           Data.Data
import           Data.Eq (Eq)
import qualified Data.Foldable as Foldable
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NonEmpty
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import           Data.Ord (Ord)
import           Prelude (($), (.), Integer, Num(..), const, id)
import           Text.Show (Show(..))

import           Hcompta.Anchor
import           Hcompta.Lib.Consable (Consable(..))
import qualified Hcompta.Lib.NonEmpty as NonEmpty
import           Hcompta.Tag

-- * Class 'Account'
class
 ( Ord  a
 , Data a
 , Data   (Account_Section a)
 , NFData (Account_Section a)
 , Ord    (Account_Section a)
 , Show   (Account_Section a)
 , Show a
 ) => Account a where
	type Account_Section  a
	account_path :: a -> Account_Path (Account_Section a)
type Account_Path = NonEmpty
instance (Data s, NFData s, Ord s, Show s) => Account (NonEmpty s) where
	type Account_Section (NonEmpty s) = s
	account_path = id

-- | Return the 'Account' formed by the given 'Account_Section' and 'Account_Section's.
account :: section -> [section] -> Account_Path section
account = (:|)

-- | Return the number of 'Account_Section's in the given 'Account_Path'.
account_depth :: Account a => a -> Integer
account_depth = Foldable.foldl' (\d -> const $ d + 1) 0 . account_path

-- | Return the given 'Account' without its last 'Account_Section' if any.
account_parent :: Account_Path a -> Maybe (Account_Path a)
account_parent = NonEmpty.parent

-- | Apply the given function to all the prefixes
-- of the given 'Account_Path' (including itself).
account_foldr :: Account_Path s -> (Account_Path s -> a -> a) -> a -> a
account_foldr (n0:|n0s) = go [] n0s
	where
		go s [] f acc = f (n0:|s) acc
		go s (n:ns) f acc =
			go (s `mappend` [n]) ns f (f (n0:|s) acc)

-- | Return an 'Account_Path' from the given list.
account_from_List :: [s] -> Account_Path s
account_from_List = NonEmpty.fromList

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

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

account_anchor :: Anchor_Path -> Account_Anchor
account_anchor = Account_Anchor . anchor

-- | Return the given 'Account_Anchors' with the given 'Account_Anchor' incorporated.
account_anchor_cons :: Account_Anchor -> Account_Anchors -> Account_Anchors
account_anchor_cons (Account_Anchor t) (Account_Anchors ts) =
	Account_Anchors $ anchor_cons t ts

-- * Type 'Account_Tag'
newtype Account_Tag
 =      Account_Tag Tag
 deriving (Data, Eq, NFData, Ord, Show, Typeable)
newtype Account_Tags
 =      Account_Tags Tags
 deriving (Data, Eq, Monoid, NFData, Show, Typeable)

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

account_tag :: Tag_Path -> Tag_Value -> Account_Tag
account_tag p v = Account_Tag $ tag p v

-- | Return the given 'Account_Tags' with the given 'Account_Tag' incorporated.
account_tag_cons :: Account_Tag -> Account_Tags -> Account_Tags
account_tag_cons (Account_Tag t) (Account_Tags ts) =
	Account_Tags $ tag_cons t ts