lib: AutoTransaction.hs -> TransactionModifier.hs, PeriodicTransaction.hs

hledger-lib/Hledger/Data.hs

@@ -17,12 +17,13 @@ module Hledger.Data (
                module Hledger.Data.Ledger,
                module Hledger.Data.MarketPrice,
                module Hledger.Data.Period,
+               module Hledger.Data.PeriodicTransaction,
                module Hledger.Data.Posting,
                module Hledger.Data.RawOptions,
                module Hledger.Data.StringFormat,
                module Hledger.Data.Timeclock,
                module Hledger.Data.Transaction,
-               module Hledger.Data.AutoTransaction,
+               module Hledger.Data.TransactionModifier,
                module Hledger.Data.Types,
                tests_Hledger_Data
               )
@@ -38,12 +39,13 @@ import Hledger.Data.Journal
 import Hledger.Data.Ledger
 import Hledger.Data.MarketPrice
 import Hledger.Data.Period
+import Hledger.Data.PeriodicTransaction
 import Hledger.Data.Posting
 import Hledger.Data.RawOptions
 import Hledger.Data.StringFormat
 import Hledger.Data.Timeclock
 import Hledger.Data.Transaction
-import Hledger.Data.AutoTransaction
+import Hledger.Data.TransactionModifier
 import Hledger.Data.Types
 
 tests_Hledger_Data :: Test

hledger-lib/Hledger/Data/PeriodicTransaction.hs

@@ -1,34 +1,20 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE CPP #-}
 {-|
 
-This module provides helpers for applying 'TransactionModifier's 
+A 'PeriodicTransaction' is a rule describing recurring transactions.
-(eg generating automated postings) and generating 'PeriodicTransaction's.
 
 -}
-module Hledger.Data.AutoTransaction
+module Hledger.Data.PeriodicTransaction (
-    (
+    runPeriodicTransaction
-    -- * Transaction modifiers
+  , checkPeriodicTransactionStartDate
-      transactionModifierToFunction
+)
-
-    -- * Periodic transactions
-    , runPeriodicTransaction
-    , checkPeriodicTransactionStartDate
-
-    -- -- * Accessors, seemingly unused
-    -- , tmParseQuery
-    -- , jdatespan
-    -- , periodTransactionInterval
-    )
 where
 
-import Data.Maybe
 #if !(MIN_VERSION_base(4,11,0))
 import Data.Monoid ((<>))
 #endif
-import Data.Time.Calendar
 import qualified Data.Text as T
 import Hledger.Data.Types
 import Hledger.Data.Dates
@@ -36,7 +22,6 @@ import Hledger.Data.Amount
 import Hledger.Data.Posting (post)
 import Hledger.Data.Transaction
 import Hledger.Utils.UTF8IOCompat (error')
-import Hledger.Query
 -- import Hledger.Utils.Debug
 
 -- $setup
@@ -44,111 +29,6 @@ import Hledger.Query
 -- >>> import Hledger.Data.Posting
 -- >>> import Hledger.Data.Journal
 
--- | Converts a 'TransactionModifier' and a 'Query' to a 
--- 'Transaction'-transforming function. The query allows injection of
--- additional restrictions on which postings to modify. 
--- The transformer function will not call 'txnTieKnot', you will
--- probably want to call that after using it.
---
--- >>> transactionModifierToFunction Any (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
--- 0000/01/01
---     ping           $1.00
---     pong           $2.00
--- <BLANKLINE>
--- <BLANKLINE>
--- >>> transactionModifierToFunction Any (TransactionModifier "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
--- 0000/01/01
---     ping           $1.00
--- <BLANKLINE>
--- <BLANKLINE>
--- >>> transactionModifierToFunction None (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
--- 0000/01/01
---     ping           $1.00
--- <BLANKLINE>
--- <BLANKLINE>
--- >>> transactionModifierToFunction Any (TransactionModifier "ping" ["pong" `post` amount{amultiplier=True, aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]}
--- 0000/01/01
---     ping           $2.00
---     pong           $6.00
--- <BLANKLINE>
--- <BLANKLINE>
-transactionModifierToFunction :: Query -> TransactionModifier -> (Transaction -> Transaction)
-transactionModifierToFunction q mt = 
-  \t@(tpostings -> ps) -> t { tpostings = generatePostings ps } -- TODO add modifier txn comment/tags ?
-  where
-    q' = simplifyQuery $ And [q, tmParseQuery mt (error' "a transaction modifier's query cannot depend on current date")]
-    mods = map tmPostingToFunction $ tmpostings mt
-    generatePostings ps = [p' | p <- ps
-                              , p' <- if q' `matchesPosting` p then p:[ m p | m <- mods] else [p]]
-    
--- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt', 
--- and return it as a function requiring the current date. 
---
--- >>> mtvaluequery (TransactionModifier "" []) undefined
--- Any
--- >>> mtvaluequery (TransactionModifier "ping" []) undefined
--- Acct "ping"
--- >>> mtvaluequery (TransactionModifier "date:2016" []) undefined
--- Date (DateSpan 2016)
--- >>> mtvaluequery (TransactionModifier "date:today" []) (read "2017-01-01")
--- Date (DateSpan 2017/01/01)
-tmParseQuery :: TransactionModifier -> (Day -> Query)
-tmParseQuery mt = fst . flip parseQuery (tmquerytxt mt)
-
----- | 'DateSpan' of all dates mentioned in 'Journal'
-----
----- >>> jdatespan nulljournal
----- DateSpan -
----- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01"}] }
----- DateSpan 2016/01/01
----- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01", tpostings=[nullposting{pdate=Just $ read "2016-02-01"}]}] }
----- DateSpan 2016/01/01-2016/02/01
---jdatespan :: Journal -> DateSpan
---jdatespan j
---        | null dates = nulldatespan
---        | otherwise = DateSpan (Just $ minimum dates) (Just $ 1 `addDays` maximum dates)
---    where
---        dates = concatMap tdates $ jtxns j
-
----- | 'DateSpan' of all dates mentioned in 'Transaction'
-----
----- >>> tdates nulltransaction
----- [0000-01-01]
---tdates :: Transaction -> [Day]
---tdates t = tdate t : concatMap pdates (tpostings t) ++ maybeToList (tdate2 t) where
---    pdates p = catMaybes [pdate p, pdate2 p]
-
-postingScale :: Posting -> Maybe Quantity
-postingScale p =
-    case amounts $ pamount p of
-        [a] | amultiplier a -> Just $ aquantity a
-        _ -> Nothing
-
--- | Converts a 'TransactionModifier''s posting to a 'Posting'-generating function,
--- which will be used to make a new posting based on the old one (an "automated posting").
-tmPostingToFunction :: Posting -> (Posting -> Posting)
-tmPostingToFunction p' = 
-  \p -> renderPostingCommentDates $ p'
-      { pdate = pdate p
-      , pdate2 = pdate2 p
-      , pamount = amount' p
-      }
-  where
-    amount' = case postingScale p' of
-        Nothing -> const $ pamount p'
-        Just n -> \p -> withAmountType (head $ amounts $ pamount p') $ pamount p `divideMixedAmount` (1/n)
-    withAmountType amount (Mixed as) = case acommodity amount of
-        "" -> Mixed as
-        c -> Mixed [a{acommodity = c, astyle = astyle amount, aprice = aprice amount} | a <- as]
-
-renderPostingCommentDates :: Posting -> Posting
-renderPostingCommentDates p = p { pcomment = comment' }
-    where
-        datesComment = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p]
-        comment'
-            | T.null datesComment = pcomment p
-            | otherwise = T.intercalate "\n" $ filter (not . T.null) [T.strip $ pcomment p, "[" <> datesComment <> "]"]
-
 -- doctest helper, too much hassle to define in the comment
 -- XXX duplicates some logic in periodictransactionp
 _ptgen str = do

hledger-lib/Hledger/Data/TransactionModifier.hs

@@ -0,0 +1,137 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE CPP #-}
+{-|
+
+A 'TransactionModifier' is a rule that modifies certain 'Transaction's,
+typically adding automated postings to them. 
+
+-}
+module Hledger.Data.TransactionModifier (
+    transactionModifierToFunction
+)
+where
+
+import Data.Maybe
+#if !(MIN_VERSION_base(4,11,0))
+import Data.Monoid ((<>))
+#endif
+import qualified Data.Text as T
+import Data.Time.Calendar
+import Hledger.Data.Types
+import Hledger.Data.Dates
+import Hledger.Data.Amount
+import Hledger.Query
+import Hledger.Utils.UTF8IOCompat (error')
+-- import Hledger.Utils.Debug
+
+-- $setup
+-- >>> :set -XOverloadedStrings
+-- >>> import Hledger.Data.Posting
+-- >>> import Hledger.Data.Transaction
+-- >>> import Hledger.Data.Journal
+
+-- | Converts a 'TransactionModifier' and a 'Query' to a 
+-- 'Transaction'-transforming function. The query allows injection of
+-- additional restrictions on which postings to modify. 
+-- The transformer function will not call 'txnTieKnot', you will
+-- probably want to call that after using it.
+--
+-- >>> transactionModifierToFunction Any (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
+-- 0000/01/01
+--     ping           $1.00
+--     pong           $2.00
+-- <BLANKLINE>
+-- <BLANKLINE>
+-- >>> transactionModifierToFunction Any (TransactionModifier "miss" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
+-- 0000/01/01
+--     ping           $1.00
+-- <BLANKLINE>
+-- <BLANKLINE>
+-- >>> transactionModifierToFunction None (TransactionModifier "" ["pong" `post` usd 2]) nulltransaction{tpostings=["ping" `post` usd 1]}
+-- 0000/01/01
+--     ping           $1.00
+-- <BLANKLINE>
+-- <BLANKLINE>
+-- >>> transactionModifierToFunction Any (TransactionModifier "ping" ["pong" `post` amount{amultiplier=True, aquantity=3}]) nulltransaction{tpostings=["ping" `post` usd 2]}
+-- 0000/01/01
+--     ping           $2.00
+--     pong           $6.00
+-- <BLANKLINE>
+-- <BLANKLINE>
+transactionModifierToFunction :: Query -> TransactionModifier -> (Transaction -> Transaction)
+transactionModifierToFunction q mt = 
+  \t@(tpostings -> ps) -> t { tpostings = generatePostings ps } -- TODO add modifier txn comment/tags ?
+  where
+    q' = simplifyQuery $ And [q, tmParseQuery mt (error' "a transaction modifier's query cannot depend on current date")]
+    mods = map tmPostingToFunction $ tmpostings mt
+    generatePostings ps = [p' | p <- ps
+                              , p' <- if q' `matchesPosting` p then p:[ m p | m <- mods] else [p]]
+    
+-- | Parse the 'Query' from a 'TransactionModifier's 'tmquerytxt', 
+-- and return it as a function requiring the current date. 
+--
+-- >>> tmParseQuery (TransactionModifier "" []) undefined
+-- Any
+-- >>> tmParseQuery (TransactionModifier "ping" []) undefined
+-- Acct "ping"
+-- >>> tmParseQuery (TransactionModifier "date:2016" []) undefined
+-- Date (DateSpan 2016)
+-- >>> tmParseQuery (TransactionModifier "date:today" []) (read "2017-01-01")
+-- Date (DateSpan 2017/01/01)
+tmParseQuery :: TransactionModifier -> (Day -> Query)
+tmParseQuery mt = fst . flip parseQuery (tmquerytxt mt)
+
+---- | 'DateSpan' of all dates mentioned in 'Journal'
+----
+---- >>> jdatespan nulljournal
+---- DateSpan -
+---- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01"}] }
+---- DateSpan 2016/01/01
+---- >>> jdatespan nulljournal{jtxns=[nulltransaction{tdate=read "2016-01-01", tpostings=[nullposting{pdate=Just $ read "2016-02-01"}]}] }
+---- DateSpan 2016/01/01-2016/02/01
+--jdatespan :: Journal -> DateSpan
+--jdatespan j
+--        | null dates = nulldatespan
+--        | otherwise = DateSpan (Just $ minimum dates) (Just $ 1 `addDays` maximum dates)
+--    where
+--        dates = concatMap tdates $ jtxns j
+
+---- | 'DateSpan' of all dates mentioned in 'Transaction'
+----
+---- >>> tdates nulltransaction
+---- [0000-01-01]
+--tdates :: Transaction -> [Day]
+--tdates t = tdate t : concatMap pdates (tpostings t) ++ maybeToList (tdate2 t) where
+--    pdates p = catMaybes [pdate p, pdate2 p]
+
+postingScale :: Posting -> Maybe Quantity
+postingScale p =
+    case amounts $ pamount p of
+        [a] | amultiplier a -> Just $ aquantity a
+        _ -> Nothing
+
+-- | Converts a 'TransactionModifier''s posting to a 'Posting'-generating function,
+-- which will be used to make a new posting based on the old one (an "automated posting").
+tmPostingToFunction :: Posting -> (Posting -> Posting)
+tmPostingToFunction p' = 
+  \p -> renderPostingCommentDates $ p'
+      { pdate = pdate p
+      , pdate2 = pdate2 p
+      , pamount = amount' p
+      }
+  where
+    amount' = case postingScale p' of
+        Nothing -> const $ pamount p'
+        Just n -> \p -> withAmountType (head $ amounts $ pamount p') $ pamount p `divideMixedAmount` (1/n)
+    withAmountType amount (Mixed as) = case acommodity amount of
+        "" -> Mixed as
+        c -> Mixed [a{acommodity = c, astyle = astyle amount, aprice = aprice amount} | a <- as]
+
+renderPostingCommentDates :: Posting -> Posting
+renderPostingCommentDates p = p { pcomment = comment' }
+    where
+        datesComment = T.concat $ catMaybes [T.pack . showDate <$> pdate p, ("=" <>) . T.pack . showDate <$> pdate2 p]
+        comment'
+            | T.null datesComment = pcomment p
+            | otherwise = T.intercalate "\n" $ filter (not . T.null) [T.strip $ pcomment p, "[" <> datesComment <> "]"]

hledger-lib/hledger-lib.cabal

@@ -2,7 +2,7 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 43aa3146bd1ffaeb1d8fa11aef445ffdb30976bcb6bc6285e93199a770cb982c
+-- hash: 61409a17c81f76ecd1ec1a836d308b382b0c1dffce1c3076bdfe5f8ac6da4370
 
 name:           hledger-lib
 version:        1.10.99
@@ -59,12 +59,13 @@ library
       Hledger.Data.Ledger
       Hledger.Data.MarketPrice
       Hledger.Data.Period
+      Hledger.Data.PeriodicTransaction
       Hledger.Data.StringFormat
       Hledger.Data.Posting
       Hledger.Data.RawOptions
       Hledger.Data.Timeclock
       Hledger.Data.Transaction
-      Hledger.Data.AutoTransaction
+      Hledger.Data.TransactionModifier
       Hledger.Data.Types
       Hledger.Query
       Hledger.Read
@@ -149,18 +150,19 @@ test-suite doctests
       Hledger.Data.Account
       Hledger.Data.AccountName
       Hledger.Data.Amount
-      Hledger.Data.AutoTransaction
       Hledger.Data.Commodity
       Hledger.Data.Dates
       Hledger.Data.Journal
       Hledger.Data.Ledger
       Hledger.Data.MarketPrice
       Hledger.Data.Period
+      Hledger.Data.PeriodicTransaction
       Hledger.Data.Posting
       Hledger.Data.RawOptions
       Hledger.Data.StringFormat
       Hledger.Data.Timeclock
       Hledger.Data.Transaction
+      Hledger.Data.TransactionModifier
       Hledger.Data.Types
       Hledger.Query
       Hledger.Read
@@ -246,18 +248,19 @@ test-suite easytests
       Hledger.Data.Account
       Hledger.Data.AccountName
       Hledger.Data.Amount
-      Hledger.Data.AutoTransaction
       Hledger.Data.Commodity
       Hledger.Data.Dates
       Hledger.Data.Journal
       Hledger.Data.Ledger
       Hledger.Data.MarketPrice
       Hledger.Data.Period
+      Hledger.Data.PeriodicTransaction
       Hledger.Data.Posting
       Hledger.Data.RawOptions
       Hledger.Data.StringFormat
       Hledger.Data.Timeclock
       Hledger.Data.Transaction
+      Hledger.Data.TransactionModifier
       Hledger.Data.Types
       Hledger.Query
       Hledger.Read
@@ -344,18 +347,19 @@ test-suite hunittests
       Hledger.Data.Account
       Hledger.Data.AccountName
       Hledger.Data.Amount
-      Hledger.Data.AutoTransaction
       Hledger.Data.Commodity
       Hledger.Data.Dates
       Hledger.Data.Journal
       Hledger.Data.Ledger
       Hledger.Data.MarketPrice
       Hledger.Data.Period
+      Hledger.Data.PeriodicTransaction
       Hledger.Data.Posting
       Hledger.Data.RawOptions
       Hledger.Data.StringFormat
       Hledger.Data.Timeclock
       Hledger.Data.Transaction
+      Hledger.Data.TransactionModifier
       Hledger.Data.Types
       Hledger.Query
       Hledger.Read

hledger-lib/package.yaml

@@ -108,12 +108,13 @@ library:
   - Hledger.Data.Ledger
   - Hledger.Data.MarketPrice
   - Hledger.Data.Period
+  - Hledger.Data.PeriodicTransaction
   - Hledger.Data.StringFormat
   - Hledger.Data.Posting
   - Hledger.Data.RawOptions
   - Hledger.Data.Timeclock
   - Hledger.Data.Transaction
-  - Hledger.Data.AutoTransaction
+  - Hledger.Data.TransactionModifier
   - Hledger.Data.Types
   - Hledger.Query
   - Hledger.Read