{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.Format.Ledger where

-- import           Control.Applicative (Const(..))
import           Data.Bool
import           Data.Data (Data(..))
import           Data.Eq (Eq(..))
import           Data.Functor (Functor(..))
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, snd)
import           Data.Typeable (Typeable)
import           Prelude (($), (.), FilePath, Num(..), flip, undefined)
import           Text.Parsec.Pos (SourcePos, initialPos)
import           Text.Show (Show)

import qualified Hcompta.Account as Account
import           Hcompta.Amount (Amount)
import qualified Hcompta.Amount as Amount
-- import           Hcompta.Balance (Balance(..))
import qualified Hcompta.Balance as Balance
import           Hcompta.Chart (Chart)
import qualified Hcompta.Chart as Chart
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

-- * Type 'Account'

{-
data Account
 =   Account
 { account_path :: Account.Account_Path
 , account_tags :: Tag.Tags
 }

-}

-- * Type 'Journal'

data Monoid ts => Journal ts
 =  Journal
 { journal_file           :: FilePath
 , journal_includes       :: [Journal ts]
 , journal_last_read_time :: Date
 , journal_sections       :: !ts
 , journal_unit_styles    :: Map Amount.Unit Amount.Style
 , journal_chart          :: Chart
 } 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_sections = mempty
	 , journal_unit_styles = mempty
	 , journal_chart = mempty
	 }

-- * Type 'Transaction'

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.Account_Path [Posting]
 , transaction_virtual_postings          :: Map Account.Account_Path [Posting]
 , transaction_balanced_virtual_postings :: Map Account.Account_Path [Posting]
 , transaction_sourcepos                 :: SourcePos
 , transaction_status                    :: Status
 , transaction_tags                      :: Tag.Tags
 } 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 (Chart, Transaction) where
	type Transaction_Posting  (Chart, Transaction) = (Chart, Posting)
	type Transaction_Postings (Chart, Transaction) = Compose [] (Compose (Map Account.Account_Path) [])
	transaction_date        = fst . transaction_dates . snd
	transaction_description = transaction_description . snd
	transaction_postings (c, t)  =
		fmap (c,) $
		Compose
		 [ Compose $ transaction_postings t
		 ]
	transaction_postings_virtual (c, t) =
		fmap (c,) $
		Compose
		 [ Compose $ transaction_virtual_postings t
		 , Compose $ transaction_balanced_virtual_postings t
		 ]
	transaction_tags = transaction_tags . snd

--instance Journal.Transaction Transaction where
--	transaction_date = fst . transaction_dates
instance Journal.Transaction (Chart, Transaction) where
	transaction_date = fst . transaction_dates . snd

instance Stats.Transaction  Transaction where
	type Transaction_Posting  Transaction = Posting
	type Transaction_Postings Transaction = Compose [] (Compose (Map Account.Account_Path) [])
	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 Stats.Transaction  (Chart, Transaction) where
	type Transaction_Posting  (Chart, Transaction) = Stats.Transaction_Posting  Transaction
	type Transaction_Postings (Chart, Transaction) = Stats.Transaction_Postings Transaction
	transaction_date = Stats.transaction_date . snd
	transaction_postings = Stats.transaction_postings . snd
	transaction_postings_size = Stats.transaction_postings_size . snd
	transaction_tags = Stats.transaction_tags . snd

instance GL.Transaction     Transaction where
	type Transaction_Posting  Transaction = Posting
	type Transaction_Postings Transaction = Compose [] (Compose (Map Account.Account_Path) [])
	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)
		 }
instance GL.Transaction     (Chart, Transaction) where
	type Transaction_Posting  (Chart, Transaction) = (Chart, GL.Transaction_Posting  Transaction)
	type Transaction_Postings (Chart, Transaction) = GL.Transaction_Postings Transaction
	transaction_date = GL.transaction_date . snd
	transaction_postings (c, t) = fmap (c,) $ GL.transaction_postings t
	transaction_postings_filter f (c, t) =
		(c, t{ transaction_postings =
			Data.Map.mapMaybe
			 (\p -> case filter f $ fmap (c,) p of
				 [] -> Nothing
				 ps -> Just $ fmap snd ps)
			 (transaction_postings t)
		 , transaction_virtual_postings =
			Data.Map.mapMaybe
			 (\p -> case filter f $ fmap (c,) p of
				 [] -> Nothing
				 ps -> Just $ fmap snd ps)
			 (transaction_virtual_postings t)
		 , transaction_balanced_virtual_postings =
			Data.Map.mapMaybe
			 (\p -> case filter f $ fmap (c,) p of
				 [] -> Nothing
				 ps -> Just $ fmap snd 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]))

-- * Type 'Posting'

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

instance Filter.Account (Chart, Account.Account_Path) where
	account_path = snd
	account_tags (c, a) = Chart.account_tags a c

posting :: Account.Account_Path -> 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 Balance.Posting (Chart, Posting) where
	type Posting_Amount    (Chart, Posting) = Amount.Sum Amount
	posting_account = posting_account . snd
	posting_amounts = Data.Map.map Amount.sum . posting_amounts . snd
	posting_set_amounts amounts (c, p) =
		(c, p { posting_amounts=Data.Map.map Amount.sum_balance amounts })

instance Filter.Posting (Chart, Posting) where
	type Posting_Account  (Chart, Posting) = (Chart, Account.Account_Path)
	type Posting_Amount   (Chart, Posting) = Amount
	posting_account (c, p) = (c, posting_account p)
	posting_amounts = posting_amounts . snd
	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 GL.Posting   (Chart, Posting) where
	type Posting_Amount (Chart, Posting) = GL.Posting_Amount Posting
	posting_account = posting_account . snd
	posting_amount  = Amount.sum . posting_amounts . snd

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

-- ** 'Posting' mappings

type Posting_by_Account
 = Map Account.Account_Path [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