{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
module Hcompta.JCC.Chart where

import           Control.DeepSeq (NFData(..))
import           Data.Data
import           Data.Eq (Eq)
import           Data.Foldable (Foldable)
import           Data.Function (on, (.))
import           Data.Functor (Functor)
import           Data.Map.Strict (Map)
import           Data.Monoid (Monoid(..))
import           Data.Ord (Ord(..))
import           Data.Traversable (Traversable)
import           Data.TreeMap.Strict (TreeMap)
import           Data.Typeable ()
import           Prelude (seq)
import           Text.Show (Show)

import qualified Hcompta.Account as H
import           Hcompta.JCC.Account

-- * Type 'Chart'

data Chart
 =   Chart
 {   chart_accounts :: TreeMap (H.Account_Section Account) H.Account_Tags
 ,   chart_anchors  :: Map H.Account_Anchor Account
 } deriving (Data, Eq, Show, Typeable)
instance NFData Chart where
	rnf Chart{..} =
		rnf chart_accounts `seq`
		rnf chart_anchors
instance Monoid Chart where
	mempty = Chart
	 { chart_accounts = mempty
	 , chart_anchors  = mempty
	 }
	mappend x y =
		Chart
		 { chart_accounts = chart_accounts x `mappend` chart_accounts y
		 , chart_anchors  = chart_anchors  x `mappend` chart_anchors  y
		 }

-- * Type 'Charted'

data Charted a
 =   Charted
 {   chart   :: Chart
 ,   charted :: a
 } deriving (Data, Eq, Foldable, Functor, Show, Traversable, Typeable)

instance Ord a => Ord (Charted a) where
	compare = compare `on` charted
instance H.Account (Charted Account) where
	type Account_Section (Charted Account) = H.Account_Section Account
	account_path = H.account_path . charted