{-# LANGUAGE FlexibleContexts #-}
-- {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE NamedFieldPuns #-}
-- {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
-- {-# OPTIONS_GHC -fno-warn-deprecations #-}
 -- FIXME: to be removed when dropping GHC-7.6 support
module Hcompta.Chart where

import Data.Data
import Data.Typeable
import Text.Show (Show(..))

import Hcompta.Account

class Chart c where
	chart_account_tags   :: c -> account -> Account_Tags
	chart_anchor_account :: c -> Account_Anchor -> account

{-
import           Control.DeepSeq (NFData(..))
import           Data.Data (Data)
import           Data.Eq (Eq(..))
import           Data.Function (($), (.), on)
import           Data.Functor (Functor(..))
-- import           Data.List (concat)
-- import           Data.List.NonEmpty (NonEmpty(..))
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Monoid (Monoid(..))
import           Data.Ord (Ord(..))
import           Data.TreeMap.Strict (TreeMap)
import qualified Data.TreeMap.Strict as TreeMap
import           Data.Typeable
import           Prelude (seq)
import           Text.Show (Show(..))

import qualified Hcompta.Account as Account
import           Hcompta.Account (Account(..), Account_Anchor, Account_Tags(..))
-- import qualified Hcompta.Anchor as Anchor
import           Hcompta.Tag (Tags(..))
-}

{-
data Account account
 => Chart account account_data
 =  Chart
 { chart_accounts :: TreeMap (Account_Section account) account_data
 , chart_anchors  :: Map Account_Anchor account
 }

deriving instance ( Account             account
                  , Data                account
                  , Data                account_data
                  ) => Data (Chart account account_data)
deriving instance ( Account             account
                  , Show                account
                  , Show                account_data
                  ) => Show (Chart account account_data)
deriving instance Typeable2 Chart

instance
 ( Account account
 , Monoid account_data
 ) => Monoid (Chart account account_data) 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
		 }
data Charted account_section account account_data a
 =   Charted
 { chart   :: Chart account_section account account_data
 , charted :: a
 }
 deriving (Data, Show, Typeable)
-}


{-
class Chart_Account_Data account_data where
	chart_account_data_tags :: account_data -> Account_Tags

data
 ( Account account
 , Chart_Account_Data account_data
 ) => Chart account account_data
 =  Chart
 { chart_accounts :: TreeMap (Account_Section account) account_data
 , chart_anchors  :: Map Account_Anchor account
 -- , chart_tags     :: Account_Tags
 }
deriving instance ( Account             account
                  , Chart_Account_Data  account_data
                  , Data                account
                  , Data                account_data
                  ) => Data (Chart account account_data)
deriving instance ( Account      account
                  , Eq           account
                  , Eq           account_data
                  ) => Eq (Chart account account_data)
deriving instance ( Account        account
                  , Show           account
                  ) => Show (Chart account account_data)
deriving instance Typeable2 Chart
 -- FIXME: use 'Typeable' when dropping GHC-7.6 support

instance Account account
 => Monoid (Chart account_data account) where
	mempty =
		Chart
		 { chart_accounts   = mempty
		 -- , chart_tags = mempty
		 , chart_anchors    = mempty
		 }
	mappend x y =
		Chart
		 { chart_accounts = chart_accounts    x `mappend` chart_accounts   y
		 -- , chart_tags = chart_tags  x `mappend` chart_tags y
		 , chart_anchors  = chart_anchors     x `mappend` chart_anchors    y
		 }

instance
 ( NFData  account
 , Account account
 ) => NFData (Chart account_data account) where
	rnf Chart{chart_accounts, chart_anchors} =
		rnf chart_accounts `seq`
		rnf chart_anchors

-- | Return the 'Account_Tags'
--   associated with the given 'Account_Path'
--   in the given 'Chart'.
account_tags :: Account account => account -> Chart account account_data -> Account_Tags
account_tags acct chart =
	Account_Tags $ Tags $
	Map.unionsWith mappend $
	fmap ((\(Account_Tags (Tags tags)) -> tags) . chart_account_data_tags) $
	TreeMap.find_along (account_path acct) $
	chart_accounts chart

data Charted account_data account x
 =   Charted
 { charted_chart :: Chart account account_data
 , charted       :: x
 }
 deriving (Data, Show, Typeable)

instance
 ( Account.Account account
 , Account.Account x
 ) =>  Account.Account (Charted account account_data x) where
	type Account_Section (Charted account account_data x) = Account.Account_Section x
	account_path = Account.account_path . charted
instance
 ( Account account
 , Eq x
 ) => Eq (Charted account account_data x) where
	(==) = (==) `on` charted
instance
 ( Account account
 , Ord x
 ) => Ord (Charted account account_data x) where
	compare = compare `on` charted
instance Functor (Charted account account_data) where
	fmap f (Charted a x) = Charted a $ f x
instance
 ( Account account
 , Monoid x
 ) => Monoid (Charted account account_data x) where
	mempty = Charted mempty mempty
	mappend (Charted xc xt) (Charted yc yt) =
		Charted (mappend xc yc) (mappend xt yt)
instance
 ( Account account
 , NFData account, NFData x
 ) => NFData (Charted account account_data x) where
	rnf (Charted c x) = rnf c `seq` rnf x
-}

{-
-- | Return the 'Account's associated with
--   the given 'Tag'
--   in the given 'Chart'.
tag_accounts :: Tag -> Chart -> [Account]
tag_accounts (p:|ps, value) chart =
	concat $
	TreeMap.find_along (p:|ps `mappend` [value]) $
	chart_tags chart
-}