Polissage : CLI.Command.*.
[comptalang.git] / lib / Hcompta / Format / Ledger.hs
index 9d74f1f0f63c0add2601f3f4e7a2e55d90f0f5ce..967b85ce5e7e8c81a72be8c0e06e717230426e7e 100644 (file)
@@ -1,26 +1,36 @@
 {-# 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
@@ -29,43 +39,41 @@ type Comment = 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
@@ -76,32 +84,88 @@ 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
@@ -127,23 +191,34 @@ posting acct =
         , 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
@@ -182,10 +257,61 @@ 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]
+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)
+-}