Ajout : Calc.Balance.postings

[comptalang.git] / lib / Hcompta / Model / Transaction / Posting.hs

diff --git a/lib/Hcompta/Model/Transaction/Posting.hs b/lib/Hcompta/Model/Transaction/Posting.hs
index 6668982407492f91489a9fae9448abfa0d61b0b7..60590703b095f891ecbad8be4ca087bc1e2dfa54 100644 (file)
--- a/lib/Hcompta/Model/Transaction/Posting.hs
+++ b/lib/Hcompta/Model/Transaction/Posting.hs
@@ -6,15 +6,14 @@ module Hcompta.Model.Transaction.Posting where
 import           Data.Data
 import qualified Data.Foldable
 import qualified Data.List
-import qualified Data.Map
-import           Data.Map (Map)
+import qualified Data.Map.Strict as Data.Map
+import           Data.Text (Text)
 import           Data.Typeable ()
 import           Text.Parsec.Pos (SourcePos, initialPos)
 
 import qualified Hcompta.Model.Account as Account ()
 import           Hcompta.Model.Account (Account)
 import qualified Hcompta.Model.Amount as Amount
-import qualified Hcompta.Model.Date as Date
 import           Hcompta.Model.Date (Date)
 import qualified Hcompta.Model.Transaction.Tag as Tag
 
@@ -24,15 +23,15 @@ data Posting
  =   Posting
  { account   :: Account
  , amounts   :: Amount.By_Unit
- , comment   :: String
- , date      :: Date
- , date2     :: Maybe Date
- , status    :: Bool
+ , comments  :: [Comment]
+ , dates     :: [Date]
  , sourcepos :: SourcePos
+ , status    :: Bool
  , tags      :: Tag.By_Name
- , type_     :: Type
  } deriving (Data, Eq, Read, Show, Typeable)
 
+type Comment = Text
+
 instance Read SourcePos where
        readsPrec _ s = [(initialPos s, "")]
 
@@ -44,42 +43,70 @@ data Type
 
 -- ** Convenient constructors
 
-nil :: Posting
-nil =
+nil :: Account -> Posting
+nil acct =
        Posting
-        { account = []
+        { account = acct
         , amounts = Data.Map.empty
-        , comment = ""
-        , date = Date.nil
-        , date2 = Nothing
+        , comments = []
+        , dates = []
         , status = False
         , sourcepos = initialPos ""
         , tags = Data.Map.empty
-        , type_ = Type_Regular
         }
 
 -- * The 'By_Account' mapping
 
 type By_Account
- = Map Account [Posting]
+ = Data.Map.Map Account [Posting]
+
+type By_Amount_and_Account
+ = Data.Map.Map Amount.By_Unit By_Account
+
+type By_Signs_and_Account
+ = Data.Map.Map Amount.Signs By_Account
+
+by_amount_and_account :: By_Account -> By_Amount_and_Account
+by_amount_and_account =
+       Data.Map.foldlWithKey
+        (flip (\acct ->
+               Data.List.foldl
+                (flip (\p ->
+                       Data.Map.insertWith
+                        (Data.Map.unionWith (++))
+                        (amounts p)
+                        (Data.Map.singleton acct [p])))))
+        Data.Map.empty
+
+by_signs_and_account :: By_Account -> By_Signs_and_Account
+by_signs_and_account =
+       Data.Map.foldlWithKey
+        (flip (\acct ->
+               Data.List.foldl
+                (flip (\p ->
+                       Data.Map.insertWith
+                        (Data.Map.unionWith (++))
+                        (Amount.signs $ amounts p)
+                        (Data.Map.singleton acct [p])))))
+        Data.Map.empty
 
 -- ** Convenient constructors
 
--- | Return a tuple associating the given posting with its account.
+-- | Return a tuple associating the given 'Posting' with its 'Account'.
 by_account :: Posting -> (Account, Posting)
 by_account posting = (account posting, posting)
 
--- | Return a 'Data.Map.Map' associating the given 'Posting's with their respective 'Unit'.
+-- | Return a Data.'Data.Map.Map' associating the given 'Posting's with their respective 'Account'.
 from_List :: [Posting] -> By_Account
 from_List postings =
-       Data.Map.fromListWith (++) $
+       Data.Map.fromListWith (flip (++)) $
        Data.List.map
         (\posting -> (account posting, [posting]))
         postings
 
 -- * Collectors
 
--- | Return the units in use within the given postings
+-- | Return the 'Unit's in use within the given 'Posting's
 units
  :: Data.Foldable.Foldable m
  => m [Posting]