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

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

import           Hcompta.Lib.Parsec ()
import qualified Hcompta.Calc.Balance as Calc.Balance
import           Hcompta.Model.Date (Date)
import qualified Hcompta.Model.Date as Date
import           Hcompta.Model.Account (Account)
-- import qualified Hcompta.Model.Account as Account
import           Hcompta.Model.Amount (Amount)
import qualified Hcompta.Model.Amount as Amount
import           Data.Text (Text)

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

-- * The 'Journal' type

data Journal
 =   Journal
 { journal_file           :: FilePath
 , journal_includes       :: [Journal]
 , journal_last_read_time :: Time.UTCTime
 , journal_transactions   :: Transaction_by_Date
 , journal_unit_styles    :: Data.Map.Map Amount.Unit Amount.Style
 } deriving (Data, Eq, Show, Typeable)

journal :: Journal
journal =
	Journal
	 { journal_file = ""
	 , journal_includes = []
	 , journal_last_read_time = Time.posixSecondsToUTCTime 0
	 , journal_transactions = Data.Map.empty
	 , journal_unit_styles = Data.Map.empty
	 }


-- * 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                  :: Posting_by_Account
 , transaction_virtual_postings          :: Posting_by_Account
 , transaction_balanced_virtual_postings :: Posting_by_Account
 , transaction_sourcepos                 :: SourcePos
 , transaction_status                    :: Status
 , transaction_tags                      :: Tag_by_Name
 } 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 = Data.Map.empty
	 , transaction_virtual_postings = Data.Map.empty
	 , transaction_balanced_virtual_postings = Data.Map.empty
	 , transaction_sourcepos = initialPos ""
	 , transaction_status = False
	 , transaction_tags = Data.Map.empty
	 }

type Transaction_by_Date
 = Data.Map.Map Date.UTC [Transaction]

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

-- * The 'Posting' type

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

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

posting :: Account -> Posting
posting acct =
	Posting
	 { posting_account = acct
	 , posting_amounts = Data.Map.empty
	 , posting_comments = []
	 , posting_dates = []
	 , posting_status = False
	 , posting_sourcepos = initialPos ""
	 , posting_tags = Data.Map.empty
	 }

instance Calc.Balance.Posting Posting
 where
	type Posting_Amount Posting = Amount
	type Posting_Unit   Posting = Amount.Unit
	posting_account = posting_account
	posting_amounts = posting_amounts
	posting_make acct amounts = (posting acct) { posting_amounts=amounts }

-- ** The 'Posting' mappings

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

type Posting_by_Amount_and_Account
 = Data.Map.Map Amount.By_Unit Posting_by_Account

type Posting_by_Signs_and_Account
 = Data.Map.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])))))
	 Data.Map.empty

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])))))
	 Data.Map.empty

-- * The 'Tag' type

type Tag = (Tag_Name, Tag_Value)
type Tag_Name = Text
type Tag_Value = Text

type Tag_by_Name = Data.Map.Map Tag_Name [Tag_Value]

-- | Return a 'Data.Map.Map' associating the 'Value's of the given 'Tag's with their respective 'Name'.
tag_by_Name :: [Tag] -> Tag_by_Name
tag_by_Name =
	Data.Map.fromListWith (flip (++)) .
	Data.List.map (\(n, v) -> (n, [v]))