Correction : build-depends : transformers >= 0.4

[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 972e08d4a59cbad7c02b3b554aaf3001cf0cb2fb..b8779ec1d0be68cfffa44f6a91fd77085bdecefb 100644 (file)
--- a/lib/Hcompta/Model/Transaction/Posting.hs
+++ b/lib/Hcompta/Model/Transaction/Posting.hs
@@ -1,23 +1,21 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 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 qualified Hcompta.Model.Account as Account ()
 import           Hcompta.Model.Account (Account)
 import qualified Hcompta.Model.Amount as Amount
-import           Hcompta.Model.Amount (Amount)
-import qualified Hcompta.Model.Date as Date
 import           Hcompta.Model.Date (Date)
 import qualified Hcompta.Model.Transaction.Tag as Tag
-import           Hcompta.Model.Transaction.Tag (Tag)
 
 -- * The 'Posting' type
 
@@ -25,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, "")]
 
@@ -50,36 +48,65 @@ nil =
        Posting
         { account = []
         , 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]