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

import           Control.DeepSeq (NFData(..))
import           Data.Data (Data)
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 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