{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE RecordWildCards #-}
module Hcompta.LCC.Chart where

import Control.DeepSeq (NFData(..))
import Data.Data
import Data.Eq (Eq)
import Data.Function (($), (.))
import Data.Map.Strict (Map)
import Data.Monoid (Monoid(..))
import Data.Semigroup (Semigroup(..))
import Data.Strict.Maybe as Strict
import Data.TreeMap.Strict (TreeMap)
import Data.Typeable ()
import Prelude (seq)
import Text.Show (Show)
import qualified Data.Map.Strict as Map
import qualified Data.TreeMap.Strict        as TreeMap
import qualified Data.TreeMap.Strict.Zipper as TreeMap

import Hcompta.Quantity
import Hcompta.LCC.Account
import Hcompta.LCC.Tag

-- * Type 'Chart'
data Chart
 =   Chart
 {   chart_accounts :: !(TreeMap NameAccount Account_Tags)
 ,   chart_tags     :: !(Map Tag_Path (Map Account ()))
 } deriving (Data, Eq, Show, Typeable)
instance NFData Chart where
	rnf Chart{..} =
		rnf chart_accounts `seq`
		rnf chart_tags
instance Semigroup Chart where
	x <> y =
		Chart
		 { chart_accounts = TreeMap.union (<>) (chart_accounts x) (chart_accounts y)
		 , chart_tags     = Map.unionWith (<>) (chart_tags x) (chart_tags y)
		 }
instance Monoid Chart where
	mempty = Chart
	 { chart_accounts = mempty
	 , chart_tags     = mempty
	 }
	mappend = (<>)
instance Zeroable Chart where
	zero = mempty
instance Nullable Chart where
	null = null . chart_accounts

-- * Zipper

type Zipper_Chart = TreeMap.Zipper NameAccount Account_Tags
type Zipper_Account_Tags = TreeMap.Zipper Tag_Path_Section [Tag_Data]
type Chart_Select = Zipper_Chart -> [Zipper_Chart]
type Zipper_Select k a = TreeMap.Zipper k a -> [TreeMap.Zipper k a]
type Zipper_SelectF f k a = TreeMap.Zipper k a -> f (TreeMap.Zipper k a)

zipper_chart :: Chart -> Zipper_Chart
zipper_chart = TreeMap.zipper . chart_accounts

zipper_accounts_tags :: Zipper_Chart -> Zipper_Account_Tags
zipper_accounts_tags z =
	case TreeMap.node_value $ TreeMap.axis_self z of
	 Strict.Just (Account_Tags (Tags tags)) -> TreeMap.zipper tags
	 _ -> TreeMap.zipper TreeMap.empty

{-
-- * 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)
-- /child::A
account_step account_child (\a -> "A" == a_name a)
-- /child::A/child::B
account_step account_child (\a -> "A" == a_name a) >=>
account_step account_child (\a -> "B" == a_name a)
-}