{-# 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           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 qualified Data.Map.Strict as Map
import           Data.Map.Strict (Map)
import           Data.Monoid (Monoid(..))
import           Data.Ord (Ord(..))
import           Data.Typeable
import           Text.Show (Show(..))
import           Prelude (($), (.), seq)

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

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

instance Account account
 => Monoid (Chart 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) 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_Tags
account_tags acct chart =
	Account_Tags $ Tags $
	Map.unionsWith mappend $
	fmap (\(Account_Tags (Tags tags)) -> tags) $
	TreeMap.find_along (account_path acct) $
	chart_accounts chart

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

instance
 ( Account.Account account
 , Account.Account x
 ) =>  Account.Account (Charted account x) where
	type Account_Section (Charted account x) = Account.Account_Section x
	account_path = Account.account_path . charted
instance
 ( Account account
 , Eq x
 ) => Eq (Charted account x) where
	(==) = (==) `on` charted
instance
 ( Account account
 , Ord x
 ) => Ord (Charted account x) where
	compare = compare `on` charted
instance Functor (Charted account) where
	fmap f (Charted a x) = Charted a $ f x
instance
 ( Account account
 , Monoid x
 ) => Monoid (Charted account 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 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
-}