{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE TypeFamilies #-}
module Hcompta.Format.Ledger.Posting where

import           Control.DeepSeq (NFData(..))
import           Data.Bool
import           Data.Data (Data(..))
import           Data.Eq (Eq(..))
import           Data.Function (($), (.), flip)
import qualified Data.List as List
import           Data.List.NonEmpty (NonEmpty(..))
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import           Data.Text (Text)
import           Data.Tuple (uncurry)
import           Data.Typeable (Typeable)
import           Prelude (seq, undefined)
import           Text.Parsec.Pos (SourcePos, initialPos)
import           Text.Show (Show)

import qualified Hcompta.Balance as Balance
import qualified Hcompta.Chart as Chart
import           Hcompta.Date (Date)
import qualified Hcompta.Filter as Filter
import qualified Hcompta.GL as GL
import           Hcompta.Lib.Parsec ()
import qualified Hcompta.Polarize as Polarize
import           Hcompta.Posting (Posting_Tags(..))
import qualified Hcompta.Posting as Posting
import qualified Hcompta.Stats as Stats
import           Hcompta.Tag (Tags(..))

import           Hcompta.Format.Ledger.Account
import           Hcompta.Format.Ledger.Amount
import           Hcompta.Format.Ledger.Chart

-- * Type 'Posting_Type'

data Posting_Type
 =   Posting_Type_Regular
 |   Posting_Type_Virtual
 |   Posting_Type_Virtual_Balanced
 deriving (Data, Eq, Show, Typeable)

data Posting_Typed posting
 =   Posting_Typed Posting_Type posting
 deriving (Data, Eq, Show, Typeable)

posting_type :: Posting -> Posting_Type
posting_type Posting{posting_tags=Posting_Tags (Tags attrs)} =
	case Map.lookup ("Virtual":|[]) attrs of
	 Nothing -> Posting_Type_Regular
	 Just l | "Balanced" `List.elem` l -> Posting_Type_Virtual_Balanced
	 Just _  -> Posting_Type_Virtual

-- * Type 'Comment'

type Comment = Text

-- * Type 'Posting'

data Posting
 =   Posting
 { posting_account   :: Account
 , posting_amounts   :: Map Unit Quantity
 , posting_comments  :: [Comment]
 , posting_dates     :: [Date]
 , posting_sourcepos :: SourcePos
 , posting_status    :: Bool
 , posting_tags      :: Posting_Tags
 } deriving (Data, Eq, Show, Typeable)
instance NFData Posting where
	rnf
	 Posting
	 { posting_account
	 , posting_amounts
	 , posting_comments
	 , posting_dates
	 -- , posting_sourcepos
	 , posting_status
	 , posting_tags
	 } =
		rnf posting_account `seq`
		rnf posting_amounts `seq`
		rnf posting_comments `seq`
		rnf posting_dates `seq`
		-- rnf posting_sourcepos `seq`
		rnf posting_status `seq`
		rnf posting_tags

posting :: Account -> Posting
posting acct =
	Posting
	 { posting_account   = acct
	 , posting_amounts   = mempty
	 , posting_comments  = mempty
	 , posting_dates     = mempty
	 , posting_status    = False
	 , posting_sourcepos = initialPos ""
	 , posting_tags      = mempty
	 }

postings_by_account :: [Posting] -> Map Account [Posting]
postings_by_account =
	Map.fromListWith (flip mappend) .
	List.map (\p -> (posting_account p, [p]))

instance Posting.Posting Posting where
	type Posting_Account   Posting = Account
	type Posting_Amount    Posting = Amount
	type Posting_Amounts   Posting = []
	posting_account = posting_account
	posting_amounts = List.map (uncurry Amount) . Map.toList . posting_amounts

instance Posting.Posting (Charted Posting) where
	type Posting_Account   (Charted Posting) = Charted Account
	type Posting_Amount    (Charted Posting) = Posting.Posting_Amount  Posting
	type Posting_Amounts   (Charted Posting) = Posting.Posting_Amounts Posting
	posting_account (Chart.Charted c p) = Chart.Charted c $ Posting.posting_account p
	posting_amounts = Posting.posting_amounts . Chart.charted

instance Balance.Posting Posting where
	type Posting_Account   Posting = Account
	type Posting_Quantity  Posting = Polarize.Polarized Quantity
	type Posting_Unit      Posting = Unit
	posting_account = posting_account
	posting_amounts = Map.map Polarize.polarize . posting_amounts
	posting_set_amounts amounts p =
		p { posting_amounts=Map.map Polarize.depolarize amounts }

instance Balance.Posting (Charted Posting) where
	type Posting_Account   (Charted Posting) = Account
	type Posting_Quantity  (Charted Posting) = Balance.Posting_Quantity Posting
	type Posting_Unit      (Charted Posting) = Balance.Posting_Unit     Posting
	posting_account = posting_account . Chart.charted
	posting_amounts = Map.map Polarize.polarize . posting_amounts . Chart.charted
	posting_set_amounts amounts (Chart.Charted c p) =
		Chart.Charted c p{ posting_amounts=Map.map Polarize.depolarize amounts }

instance Filter.Posting (Charted Posting) where
	posting_type = undefined
	 -- NOTE: the posting_type will be given to Filter.test
	 --       through instance Posting p => Posting (Posting_Typed p)
	 --       by Filter.transaction_postings
	 --       and Filter.transaction_postings_virtual

instance GL.Posting     Posting where
	type Posting_Account  Posting = Account
	type Posting_Quantity Posting = Map Unit (Polarize.Polarized Quantity)
	posting_account  = posting_account
	posting_quantity = Map.map Polarize.polarize . posting_amounts

instance GL.Posting     (Charted Posting) where
	type Posting_Account  (Charted Posting) = Account
	type Posting_Quantity (Charted Posting) = GL.Posting_Quantity Posting
	posting_account  = GL.posting_account  . Chart.charted
	posting_quantity = GL.posting_quantity . Chart.charted

instance Stats.Posting  Posting where
	type Posting_Account  Posting = Account
	type Posting_Quantity Posting = Quantity
	type Posting_Unit     Posting = Unit
	posting_account = posting_account
	posting_amounts = posting_amounts

{-
-- ** 'Posting' mappings

type Posting_by_Account
 = Map Account [Posting]

type Posting_by_Amount_and_Account
 = Map (Map Unit Amount) Posting_by_Account

type Posting_by_Signs_and_Account
 = Map Signs Posting_by_Account

-- | Return a Data.'Map.Map' associating the given 'Posting's with their respective 'Account'.
posting_by_Account :: [Posting] -> Posting_by_Account
posting_by_Account =
	Map.fromListWith (flip mappend) .
	Data.List.map
	 (\p -> (posting_account p, [p]))

posting_by_Amount_and_Account :: Posting_by_Account -> Posting_by_Amount_and_Account
posting_by_Amount_and_Account =
	Map.foldlWithKey
	 (flip (\acct ->
		Data.List.foldl'
		 (flip (\p ->
			Map.insertWith
			 (Map.unionWith mappend)
			 (posting_amounts p)
			 (Map.singleton acct [p])))))
	 mempty

posting_by_Signs_and_Account :: Posting_by_Account -> Posting_by_Signs_and_Account
posting_by_Signs_and_Account =
	Map.foldlWithKey
	 (flip (\acct ->
		Data.List.foldl'
		 (flip (\p ->
			Map.insertWith
			 (Map.unionWith mappend)
			 (signs $ posting_amounts p)
			 (Map.singleton acct [p])))))
	 mempty
-}