{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Hcompta.Format.Ledger
 ( module Hcompta.Format.Ledger
 , module Hcompta.Format.Ledger.Amount
 , module Hcompta.Format.Ledger.Unit
 , module Hcompta.Format.Ledger.Quantity
 ) where

-- import           Control.Applicative (Const(..))
import           Control.DeepSeq (NFData(..))
import           Data.Bool
import           Data.Data (Data(..))
import           Data.Eq (Eq(..))
import           Data.Function (on)
import           Data.Functor (Functor(..))
import           Data.Functor.Compose (Compose(..))
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.Ord (Ord(..))
import           Data.Text (Text)
import           Data.Tuple (fst, uncurry)
import           Data.Typeable (Typeable)
import           Prelude (($), (.), FilePath, Num(..), flip, seq, undefined)
import           Text.Parsec.Pos (SourcePos, initialPos)
import           Text.Show (Show)

import qualified Hcompta.Account as Account
-- import qualified Hcompta.Amount as Amount
-- import           Hcompta.Balance (Balance(..))
import qualified Hcompta.Balance as Balance
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           Hcompta.Lib.Regex (Regex)
-- import qualified Hcompta.Quantity as Quantity
import qualified Hcompta.Polarize as Polarize
import qualified Hcompta.Posting as Posting
import qualified Hcompta.Stats as Stats
import qualified Hcompta.Tag as Tag

import           Hcompta.Format.Ledger.Amount
import           Hcompta.Format.Ledger.Quantity
import           Hcompta.Format.Ledger.Unit

-- * Type 'Account'

type Account_Section = Text
type Account = NonEmpty Account_Section
account :: Account_Section -> [Account_Section] -> Account
account = (:|)

-- ** Type 'Joker'

type Account_Joker
 = [Account_Joker_Section]
data Account_Joker_Section
 =   Account_Joker_Any
 |   Account_Joker_Section Text
 deriving (Data, Eq, Show, Typeable)

-- ** Type 'Pattern'

data Account_Pattern
 =   Account_Pattern_Exact Account
 |   Account_Pattern_Joker Account_Joker
 |   Account_Pattern_Regex Regex
 deriving (Show, Typeable)

-- * Type 'Chart'

type Chart = Chart.Chart Account

data Chart_With x
 =   Chart_With Chart x
 deriving (Data, Show)
chart :: Chart_With t -> Chart
chart (Chart_With c _) = c
instance Account.Account a
 => Account.Account    (Chart_With a) where
	type Account_Section (Chart_With a) = Account.Account_Section a
	account_path = Account.account_path . with_chart
instance Eq a => Eq (Chart_With a) where
	(==) = (==) `on` with_chart
instance Ord a => Ord (Chart_With a) where
	compare = compare `on` with_chart
instance Monoid a => Monoid (Chart_With a) where
	mempty = Chart_With mempty mempty
	mappend (Chart_With xc xt) (Chart_With yc yt) = Chart_With (mappend xc yc) (mappend xt yt)
instance NFData x => NFData (Chart_With x) where
	rnf (Chart_With c x) = rnf c `seq` rnf x

with_chart :: Chart_With t -> t
with_chart (Chart_With _ t) = t

-- * 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      :: Tag.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

instance Filter.Account (Chart_With Account) where
	account_path = with_chart
	account_tags (Chart_With c a) = Chart.account_tags a c

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
	 }

map_Postings_by_Account :: [Posting] -> Map Account [Posting]
map_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 (Chart_With Posting) where
	type Posting_Account   (Chart_With Posting) = Chart_With Account
	type Posting_Amount    (Chart_With Posting) = Posting.Posting_Amount  Posting
	type Posting_Amounts   (Chart_With Posting) = Posting.Posting_Amounts Posting
	posting_account (Chart_With c p) = Chart_With c $ Posting.posting_account p
	posting_amounts = Posting.posting_amounts . with_chart

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 (Chart_With Posting) where
	type Posting_Account   (Chart_With Posting) = Account
	type Posting_Quantity  (Chart_With Posting) = Balance.Posting_Quantity Posting
	type Posting_Unit      (Chart_With Posting) = Balance.Posting_Unit     Posting
	posting_account = posting_account . with_chart
	posting_amounts = Map.map Polarize.polarize . posting_amounts . with_chart
	posting_set_amounts amounts (Chart_With c p) =
		Chart_With c p{ posting_amounts=Map.map Polarize.depolarize amounts }

instance Filter.Posting (Chart_With 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     (Chart_With Posting) where
	type Posting_Account  (Chart_With Posting) = Account
	type Posting_Quantity (Chart_With Posting) = GL.Posting_Quantity Posting
	posting_account  = GL.posting_account  . with_chart
	posting_quantity = GL.posting_quantity . with_chart

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

-- ** 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)

{-
-- ** '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
-}

-- * Type 'Transaction'

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

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                      :: Tag.Tags
 } deriving (Data, Eq, Show, Typeable)
instance NFData Transaction where
	rnf
	 Transaction
	 { transaction_code
	 , transaction_comments_before
	 , transaction_comments_after
	 , transaction_dates
	 , transaction_description
	 , transaction_postings
	 , transaction_virtual_postings
	 , transaction_balanced_virtual_postings
	 -- , transaction_sourcepos
	 , transaction_status
	 , transaction_tags
	 } =
		rnf transaction_code `seq`
		rnf transaction_comments_before `seq`
		rnf transaction_comments_after `seq`
		rnf transaction_dates `seq`
		rnf transaction_description `seq`
		rnf transaction_postings `seq`
		rnf transaction_virtual_postings `seq`
		rnf transaction_balanced_virtual_postings `seq`
		-- rnf transaction_sourcepos `seq`
		rnf transaction_status `seq`
		rnf transaction_tags


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_With Transaction) where
	type Transaction_Posting  (Chart_With Transaction) = (Chart_With Posting)
	type Transaction_Postings (Chart_With Transaction) = Compose [] (Compose (Map Account) [])
	transaction_date        = fst . transaction_dates . with_chart
	transaction_description = transaction_description . with_chart
	transaction_postings (Chart_With c t)  =
		fmap (Chart_With c) $
		Compose
		 [ Compose $ transaction_postings t
		 ]
	transaction_postings_virtual (Chart_With c t) =
		fmap (Chart_With c) $
		Compose
		 [ Compose $ transaction_virtual_postings t
		 , Compose $ transaction_balanced_virtual_postings t
		 ]
	transaction_tags = transaction_tags . with_chart

--instance Journal.Transaction Transaction where
--	transaction_date = fst . transaction_dates
instance Journal.Transaction (Chart_With Transaction) where
	transaction_date = fst . transaction_dates . with_chart

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 =
		Map.size (transaction_postings t) +
		Map.size (transaction_virtual_postings t) +
		Map.size (transaction_balanced_virtual_postings t)
	transaction_tags = transaction_tags
instance Stats.Transaction  (Chart_With Transaction) where
	type Transaction_Posting  (Chart_With Transaction) = Stats.Transaction_Posting  Transaction
	type Transaction_Postings (Chart_With Transaction) = Stats.Transaction_Postings Transaction
	transaction_date = Stats.transaction_date . with_chart
	transaction_postings = Stats.transaction_postings . with_chart
	transaction_postings_size = Stats.transaction_postings_size . with_chart
	transaction_tags = Stats.transaction_tags . with_chart

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

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

-- * Type 'Journal'

data Monoid ts
 => Journal ts
 =  Journal
 { journal_file           :: FilePath
 , journal_includes       :: [Journal ts]
 , journal_last_read_time :: Date
 , journal_sections       :: !ts
 , journal_amount_styles  :: !Styles
 , 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_amount_styles  = mempty
	 , journal_chart          = mempty
	 }