{-# 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.Data (Data(..))
+-- import qualified Data.Foldable as Data.Foldable
+import Data.Functor.Compose (Compose(..))
+import qualified Data.List as Data.List
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Data.Map
+import Data.Text (Text)
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.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.Lib.Consable
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)
+-- import Hcompta.GL (GL(..))
+import qualified Hcompta.GL as GL
+import qualified Hcompta.Journal as Journal
type Code = Text
type Description = Text
-- * The 'Journal' type
-data Journal
- = Journal
+data Consable ts t
+ => Journal ts t
+ = 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
+ , journal_includes :: [Journal ts t]
+ , journal_last_read_time :: Date
+ , journal_transactions :: !(ts t)
+ , journal_unit_styles :: Map Amount.Unit Amount.Style
} deriving (Data, Eq, Show, Typeable)
-journal :: Journal
+journal :: Consable ts t => Journal ts t
journal =
Journal
{ journal_file = ""
, journal_includes = []
- , journal_last_read_time = Time.posixSecondsToUTCTime 0
- , journal_transactions = Data.Map.empty
+ , journal_last_read_time = Date.nil
+ , journal_transactions = mempty
, 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_postings_balance :: Calc.Balance.Balance Amount
- , transaction_virtual_postings :: Posting_by_Account
- , transaction_balanced_virtual_postings :: Posting_by_Account
- , transaction_balanced_virtual_postings_balance :: Calc.Balance.Balance Amount
- , transaction_sourcepos :: SourcePos
- , transaction_status :: Status
- , transaction_tags :: Tag_by_Name
+ { 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_comments_after = []
, transaction_dates = (Date.nil, [])
, transaction_description = ""
- , transaction_postings = Data.Map.empty
- , transaction_postings_balance = Calc.Balance.nil
- , transaction_virtual_postings = Data.Map.empty
- , transaction_balanced_virtual_postings = Data.Map.empty
- , transaction_balanced_virtual_postings_balance = Calc.Balance.nil
+ , transaction_postings = mempty
+ , transaction_virtual_postings = mempty
+ , transaction_balanced_virtual_postings = mempty
, transaction_sourcepos = initialPos ""
, transaction_status = False
- , transaction_tags = Data.Map.empty
+ , transaction_tags = mempty
}
-type Transaction_by_Date
- = Data.Map.Map Date.UTC [Transaction]
+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
+ , 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 Filter.GL (GL.GL_Line Transaction) where
+ type GL_Amount (GL.GL_Line Transaction) = Amount
+ register_account = GL.posting_account . GL.register_line_posting
+ register_date = GL.transaction_date . GL.register_line_transaction
+ register_amount_positive = Amount.sum_positive . GL.posting_amount . GL.register_line_posting
+ register_amount_negative = Amount.sum_negative . GL.posting_amount . GL.register_line_posting
+ register_amount_balance = Amount.sum_balance . GL.posting_amount . GL.register_line_posting
+ register_sum_positive = Amount.sum_positive . GL.register_line_sum
+ register_sum_negative = Amount.sum_negative . GL.register_line_sum
+ register_sum_balance = Amount.sum_balance . GL.register_line_sum
+-}
+
+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] -> Transaction_by_Date
+transaction_by_Date :: [Transaction] -> (Compose (Map Date) []) Transaction
transaction_by_Date =
+ Compose .
Data.Map.fromListWith (flip (++)) .
- Data.List.map (\t -> (Date.to_UTC $ fst $ transaction_dates t, [t]))
+ Data.List.map (\t -> (fst $ transaction_dates t, [t]))
-- * The 'Posting' type
data Posting
= Posting
{ posting_account :: Account
- , posting_amounts :: Amount.By_Unit
+ , posting_amounts :: Map Amount.Unit Amount
, posting_comments :: [Comment]
, posting_dates :: [Date]
, posting_sourcepos :: SourcePos
, posting_tags = Data.Map.empty
}
-instance Calc.Balance.Posting Posting
- where
+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_set_amounts amounts p = p { posting_amounts=amounts }
+
+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
-- ** The 'Posting' mappings
type Posting_by_Account
- = Data.Map.Map Account [Posting]
+ = Map Account [Posting]
type Posting_by_Amount_and_Account
- = Data.Map.Map Amount.By_Unit Posting_by_Account
+ = Map Amount.By_Unit Posting_by_Account
type Posting_by_Signs_and_Account
- = Data.Map.Map Amount.Signs Posting_by_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
type Tag_Name = Text
type Tag_Value = Text
-type Tag_by_Name = Data.Map.Map Tag_Name [Tag_Value]
+type Tag_by_Name = 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]))
+
+-- Instances 'Consable'
+
+-- 'Transaction's
+instance Consable [] Transaction where
+ mcons = (:)
+
+{-
+-- 'Balance'
+instance Consable (Const
+ ( Balance (Amount.Sum Amount)
+ , Filter.Simplified (Filter.Filter_Bool (Filter.Filter_Transaction Transaction))
+ , Filter.Simplified (Filter.Filter_Bool (Filter.Filter_Posting Posting))
+ ))
+ Transaction where
+ mcons t c@(Const (bal, ft, fp)) =
+ if Filter.test ft t
+ then Const . (, ft, fp) $
+ balance (Compose $ transaction_postings t) $
+ balance (Compose $ transaction_virtual_postings t) $
+ balance (Compose $ transaction_balanced_virtual_postings t) $
+ bal
+ else c
+ where balance =
+ flip $ Data.Foldable.foldr $ \p ->
+ if Filter.test fp p
+ then Balance.balance
+ ( posting_account p
+ , Balance.Account_Sum $ Data.Map.map Amount.sum (posting_amounts p)
+ )
+ else id
+
+-- 'Balance.Balance_by_Account'
+instance Consable (Const
+ ( Balance.Balance_by_Account (Amount.Sum Amount) ))
+ Transaction where
+ mcons t (Const bal) =
+ (\(Const b) -> Const b) $
+ mcons (Compose $ transaction_postings t) $
+ mcons (Compose $ transaction_virtual_postings t) $
+ mcons (Compose $ transaction_balanced_virtual_postings t) $
+ Const bal
+
+-- 'Balance.Balance_by_Unit'
+instance Consable (Const
+ ( Balance.Balance_by_Unit (Amount.Sum Amount) ))
+ Transaction where
+ mcons t (Const ts) = Const $
+ Data.Foldable.foldl' (flip Balance.by_unit)
+ ts (Compose $ transaction_postings t)
+-}