{-# 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
+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 Monoid ts => Journal ts
+ = 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]
+ , journal_last_read_time :: Date
+ , journal_transactions :: !ts
+ , journal_unit_styles :: Map Amount.Unit Amount.Style
} deriving (Data, Eq, Show, Typeable)
-journal :: Journal
+journal :: Monoid ts => Journal ts
journal =
Journal
- { journal_file = ""
- , journal_includes = []
- , journal_last_read_time = Time.posixSecondsToUTCTime 0
- , journal_transactions = Data.Map.empty
- , journal_unit_styles = Data.Map.empty
+ { 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_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_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
}
--- ** The 'Transaction_by_Date' mapping
-
-type Transaction_by_Date
- = Data.Map.Map Date.UTC [Transaction]
-
--- | Return a Data.'Data.Map.Map' associating
+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 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 acct =
Posting
{ posting_account = acct
- , posting_amounts = Data.Map.empty
- , posting_comments = []
- , posting_dates = []
+ , posting_amounts = mempty
+ , posting_comments = mempty
+ , posting_dates = mempty
, posting_status = False
, posting_sourcepos = initialPos ""
- , posting_tags = Data.Map.empty
+ , posting_tags = mempty
}
-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
- type Posting_Unit Posting = Amount.Unit
posting_account = posting_account
posting_amounts = posting_amounts
- posting_make acct amounts = (posting acct) { 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
posting_by_Amount_and_Account =
Data.Map.foldlWithKey
(flip (\acct ->
- Data.List.foldl
+ Data.List.foldl'
(flip (\p ->
Data.Map.insertWith
(Data.Map.unionWith (++))
(posting_amounts p)
(Data.Map.singleton acct [p])))))
- Data.Map.empty
+ 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
+ Data.List.foldl'
(flip (\p ->
Data.Map.insertWith
(Data.Map.unionWith (++))
(Amount.signs $ posting_amounts p)
(Data.Map.singleton acct [p])))))
- Data.Map.empty
+ mempty
-- * The 'Tag' type
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