{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.Model.Transaction.Posting where

import           Data.Data
import qualified Data.Foldable
import qualified Data.List
import qualified Data.Map.Strict as Data.Map
import           Data.Text (Text)
import           Data.Typeable ()
import           Text.Parsec.Pos (SourcePos, initialPos)

import qualified Hcompta.Model.Account as Account ()
import           Hcompta.Model.Account (Account)
import qualified Hcompta.Model.Amount as Amount
import           Hcompta.Model.Date (Date)
import qualified Hcompta.Model.Transaction.Tag as Tag

-- * The 'Posting' type

data Posting
 =   Posting
 { account   :: Account
 , amounts   :: Amount.By_Unit
 , comments  :: [Comment]
 , dates     :: [Date]
 , sourcepos :: SourcePos
 , status    :: Bool
 , tags      :: Tag.By_Name
 } deriving (Data, Eq, Read, Show, Typeable)

type Comment = Text

instance Read SourcePos where
	readsPrec _ s = [(initialPos s, "")]

data Type
 =   Type_Regular
 |   Type_Virtual
 |   Type_Virtual_Balanced
 deriving (Data, Eq, Read, Show, Typeable)

-- ** Convenient constructors

nil :: Account -> Posting
nil acct =
	Posting
	 { account = acct
	 , amounts = Data.Map.empty
	 , comments = []
	 , dates = []
	 , status = False
	 , sourcepos = initialPos ""
	 , tags = Data.Map.empty
	 }

-- * The 'By_Account' mapping

type By_Account
 = Data.Map.Map Account [Posting]

type By_Amount_and_Account
 = Data.Map.Map Amount.By_Unit By_Account

type By_Signs_and_Account
 = Data.Map.Map Amount.Signs By_Account

by_amount_and_account :: By_Account -> By_Amount_and_Account
by_amount_and_account =
	Data.Map.foldlWithKey
	 (flip (\acct ->
		Data.List.foldl
		 (flip (\p ->
			Data.Map.insertWith
			 (Data.Map.unionWith (++))
			 (amounts p)
			 (Data.Map.singleton acct [p])))))
	 Data.Map.empty

by_signs_and_account :: By_Account -> By_Signs_and_Account
by_signs_and_account =
	Data.Map.foldlWithKey
	 (flip (\acct ->
		Data.List.foldl
		 (flip (\p ->
			Data.Map.insertWith
			 (Data.Map.unionWith (++))
			 (Amount.signs $ amounts p)
			 (Data.Map.singleton acct [p])))))
	 Data.Map.empty

-- ** Convenient constructors

-- | Return a tuple associating the given 'Posting' with its 'Account'.
by_account :: Posting -> (Account, Posting)
by_account posting = (account posting, posting)

-- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
from_List :: [Posting] -> By_Account
from_List postings =
	Data.Map.fromListWith (flip (++)) $
	Data.List.map
	 (\posting -> (account posting, [posting]))
	 postings

-- * Collectors

-- | Return the 'Unit's in use within the given 'Posting's
units
 :: Data.Foldable.Foldable m
 => m [Posting]
 -> [Amount.Unit]
units =
	Data.Foldable.foldl
	 (\acc ->
		Data.List.union acc .
		Data.List.concatMap
		 (Data.Map.keys . amounts))
	 []