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

import Control.Applicative (Applicative(..), Alternative(..))
import Control.DeepSeq (NFData(..))
import Data.Bool
import Data.Data
import Data.Eq (Eq)
import Data.Int (Int)
import Data.Foldable (Foldable)
import Data.Function (($), (.), on)
import Data.Functor (Functor)
import qualified Data.List as List
import Data.Map.Strict (Map)
import Data.Maybe (Maybe, maybeToList)
import Data.Strict.Maybe as Strict
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Traversable (Traversable)
import Data.TreeMap.Strict (TreeMap)
import qualified Data.TreeMap.Strict        as TreeMap
import qualified Data.TreeMap.Strict.Zipper as TreeMap
import Data.Typeable ()
import Prelude (seq)
import Text.Show (Show)

import qualified Hcompta.Account as H
import Hcompta.LCC.Account
import Hcompta.LCC.Tag

-- * Type 'Chart'
data Chart
 =   Chart
 {   chart_accounts :: TreeMap Account_Section Chart_Item
 ,   chart_anchors  :: Map Account_Anchor Account
 } deriving (Data, Eq, Show, Typeable)
type Chart_Item = Account_Tags
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)

type Zipper_Chart = TreeMap.Zipper Account_Section Chart_Item
type Zipper_Account_Tags = TreeMap.Zipper Tag_Path_Section [Tag_Value]
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
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.zipper_self z of
	 Strict.Just (Account_Tags (Tags tags)) -> TreeMap.zipper tags
	 _ -> TreeMap.zipper TreeMap.empty

{-
-- /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)
-}