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

import           Control.DeepSeq (NFData)
import           Data.Data
import           Data.Eq (Eq)
import qualified Data.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 (Anchor, Anchors)
import qualified Hcompta.Anchor as Anchor
import           Hcompta.Lib.Consable (Consable(..))
import           Hcompta.Tag (Tag, Tags)
import qualified Hcompta.Tag as Tag
import qualified Hcompta.Lib.NonEmpty as NonEmpty

-- * 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.
path :: section -> [section] -> Account_Path section
path = (:|)

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

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

-- | Apply the given function to all the prefixes
-- of the given 'Account_Path' (including itself).
foldr :: Account_Path s -> (Account_Path s -> a -> a) -> a -> a
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.
from_List :: [s] -> Account_Path s
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

anchor :: Anchor.Path -> Account_Anchor
anchor = Account_Anchor . Anchor.anchor

-- | Return the given 'Account_Anchors' with the given 'Account_Anchor' incorporated.
anchor_cons :: Account_Anchor -> Account_Anchors -> Account_Anchors
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

tag :: Tag.Path -> Tag.Value -> Account_Tag
tag p v = Account_Tag $ Tag.tag p v

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