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

-- import           Control.Applicative (Const(..))
import           Data.Bool
import           Data.Data (Data(..))
import           Data.Eq (Eq(..))
import           Data.Functor.Compose (Compose(..))
import           Data.List
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Data.Map
import           Data.Maybe (Maybe(..))
import           Data.Monoid (Monoid(..))
import           Data.Text (Text)
import           Data.Tuple (fst)
import           Data.Typeable (Typeable)
import           Prelude (($), (.), FilePath, Num(..), flip, undefined)
import           Text.Parsec.Pos (SourcePos, initialPos)
import           Text.Show (Show)

import           Hcompta.Account (Account)
import           Hcompta.Amount (Amount)
import qualified Hcompta.Amount as Amount
-- import           Hcompta.Balance (Balance(..))
import qualified Hcompta.Balance as Balance
import           Hcompta.Date (Date)
import qualified Hcompta.Date as Date
import qualified Hcompta.Filter as Filter
-- import           Hcompta.GL (GL(..))
import qualified Hcompta.GL as GL
import qualified Hcompta.Journal as Journal
-- import           Hcompta.Lib.Consable
import           Hcompta.Lib.Parsec ()
import qualified Hcompta.Stats as Stats
import qualified Hcompta.Tag as Tag

type Code = Text
type Description = Text
type Status = Bool
type Comment = Text

-- * The 'Journal' type

data Monoid ts => Journal ts
 =  Journal
 { journal_file           :: FilePath
 , journal_includes       :: [Journal ts]
 , journal_last_read_time :: Date
 , journal_transactions   :: !ts
 , journal_unit_styles    :: Map Amount.Unit Amount.Style
 } deriving (Data, Eq, Show, Typeable)

journal :: Monoid ts => Journal ts
journal =
	Journal
	 { journal_file = mempty
	 , journal_includes = mempty
	 , journal_last_read_time = Date.nil
	 , journal_transactions = mempty
	 , journal_unit_styles = mempty
	 }

-- * The 'Transaction' type

data Transaction
 =   Transaction
 { transaction_code                      :: Code
 , transaction_comments_before           :: [Comment]
 , transaction_comments_after            :: [Comment]
 , transaction_dates                     :: (Date, [Date])
 , transaction_description               :: Description
 , transaction_postings                  :: Map Account [Posting]
 , transaction_virtual_postings          :: Map Account [Posting]
 , transaction_balanced_virtual_postings :: Map Account [Posting]
 , transaction_sourcepos                 :: SourcePos
 , transaction_status                    :: Status
 , transaction_tags                      :: Map Tag.Path [Tag.Value]
 } deriving (Data, Eq, Show, Typeable)

transaction :: Transaction
transaction =
	Transaction
	 { transaction_code = ""
	 , transaction_comments_before = []
	 , transaction_comments_after = []
	 , transaction_dates = (Date.nil, [])
	 , transaction_description = ""
	 , transaction_postings = mempty
	 , transaction_virtual_postings = mempty
	 , transaction_balanced_virtual_postings = mempty
	 , transaction_sourcepos = initialPos ""
	 , transaction_status = False
	 , transaction_tags = mempty
	 }

instance Filter.Transaction Transaction where
	type Transaction_Posting  Transaction = Posting
	type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
	transaction_date        = fst . transaction_dates
	transaction_description = transaction_description
	transaction_postings t  =
		Compose
		 [ Compose $ transaction_postings t
		 ]
	transaction_postings_virtual t  =
		Compose
		 [ Compose $ transaction_virtual_postings t
		 , Compose $ transaction_balanced_virtual_postings t
		 ]
	transaction_tags        = transaction_tags

instance Journal.Transaction Transaction where
	transaction_date = fst . transaction_dates

instance Stats.Transaction  Transaction where
	type Transaction_Posting  Transaction = Posting
	type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
	transaction_date = fst . transaction_dates
	transaction_postings t =
		Compose
		 [ Compose $ transaction_postings t
		 , Compose $ transaction_virtual_postings t
		 , Compose $ transaction_balanced_virtual_postings t
		 ]
	transaction_postings_size t =
		Data.Map.size (transaction_postings t) +
		Data.Map.size (transaction_virtual_postings t) +
		Data.Map.size (transaction_balanced_virtual_postings t)
	transaction_tags =
		transaction_tags

instance GL.Transaction     Transaction where
	type Transaction_Posting  Transaction = Posting
	type Transaction_Postings Transaction = Compose [] (Compose (Map Account) [])
	transaction_date = fst . transaction_dates
	transaction_postings t =
		Compose
		 [ Compose $ transaction_postings t
		 , Compose $ transaction_virtual_postings t
		 , Compose $ transaction_balanced_virtual_postings t
		 ]
	transaction_postings_filter f t =
		t{ transaction_postings =
			Data.Map.mapMaybe
			 (\p -> case filter f p of
				 [] -> Nothing
				 ps -> Just ps)
			 (transaction_postings t)
		 , transaction_virtual_postings =
			Data.Map.mapMaybe
			 (\p -> case filter f p of
				 [] -> Nothing
				 ps -> Just ps)
			 (transaction_virtual_postings t)
		 , transaction_balanced_virtual_postings =
			Data.Map.mapMaybe
			 (\p -> case filter f p of
				 [] -> Nothing
				 ps -> Just ps)
			 (transaction_balanced_virtual_postings t)
		 }

-- | Return a 'Data.Map.Map' associating
--   the given 'Transaction's with their respective 'Date'.
transaction_by_Date :: [Transaction] -> (Compose (Map Date) []) Transaction
transaction_by_Date =
	Compose .
	Data.Map.fromListWith (flip (++)) .
	Data.List.map (\t -> (fst $ transaction_dates t, [t]))

-- * The 'Posting' type

data Posting
 =   Posting
 { posting_account   :: Account
 , posting_amounts   :: Map Amount.Unit Amount
 , posting_comments  :: [Comment]
 , posting_dates     :: [Date]
 , posting_sourcepos :: SourcePos
 , posting_status    :: Bool
 , posting_tags      :: Map Tag.Path [Tag.Value]
 } deriving (Data, Eq, Show, Typeable)

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
	 }

instance Balance.Posting Posting where
	type Posting_Amount    Posting = Amount.Sum Amount
	posting_account = posting_account
	posting_amounts = Data.Map.map Amount.sum . posting_amounts
	posting_set_amounts amounts p =
		p { posting_amounts=Data.Map.map Amount.sum_balance amounts }

instance Filter.Posting Posting where
	type Posting_Amount   Posting = Amount
	posting_account = posting_account
	posting_amounts = posting_amounts
	posting_type    = undefined
	 -- NOTE: the posting_type will be given to Filter.test
	 --       through instance Posting p => Posting (Posting_Type, p)
	 --       by Filter.transaction_postings
	 --       and Filter.transaction_postings_virtual

instance GL.Posting   Posting where
	type Posting_Amount Posting = Amount.Sum (Map Amount.Unit Amount)
	posting_account = posting_account
	posting_amount  = Amount.sum . posting_amounts

instance Stats.Posting Posting where
	type Posting_Amount  Posting = Amount
	posting_account = posting_account
	posting_amounts = posting_amounts

-- ** The 'Posting' mappings

type Posting_by_Account
 = Map Account [Posting]

type Posting_by_Amount_and_Account
 = Map Amount.By_Unit Posting_by_Account

type Posting_by_Signs_and_Account
 = Map Amount.Signs Posting_by_Account

-- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
posting_by_Account :: [Posting] -> Posting_by_Account
posting_by_Account =
	Data.Map.fromListWith (flip (++)) .
	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 =
	Data.Map.foldlWithKey
	 (flip (\acct ->
		Data.List.foldl'
		 (flip (\p ->
			Data.Map.insertWith
			 (Data.Map.unionWith (++))
			 (posting_amounts p)
			 (Data.Map.singleton acct [p])))))
	 mempty

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