prices: new addon (#486)

bin/.gitignore

@@ -3,6 +3,7 @@ hledger-chart
 hledger-check-dates
 hledger-dupes
 hledger-equity
+hledger-prices
 hledger-print-unique
 hledger-register-match
 hledger-rewrite

bin/hledger-prices.hs

@@ -0,0 +1,55 @@
+#!/usr/bin/env stack
+{- stack runghc --verbosity info
+  --package hledger
+-}
+
+import Data.Maybe
+import Data.Time
+import qualified Data.Text as T
+import Control.Monad
+import Hledger.Cli
+
+cmdmode :: Mode RawOpts
+cmdmode = (defCommandMode ["hledger-prices"]) {
+     modeArgs = ([], Nothing)
+    ,modeHelp = "print all prices from journal"
+    ,modeGroupFlags = Group {
+         groupNamed = [
+             ("Input",     inputflags)
+            ,("Misc",      helpflags)
+            ]
+        ,groupHidden = []
+        ,groupUnnamed = [
+             flagNone ["costs"] (setboolopt "costs")
+                "collect prices from postings"
+            ]
+        }
+    }
+
+showPrice :: MarketPrice -> String
+showPrice mp = unwords ["P", show $ mpdate mp, T.unpack . quoteCommoditySymbolIfNeeded $ mpcommodity mp, showAmountWithZeroCommodity $ mpamount mp]
+
+amountCost :: Day -> Amount -> Maybe MarketPrice
+amountCost d a =
+    case aprice a of
+        NoPrice -> Nothing
+        UnitPrice pa -> Just
+            MarketPrice { mpdate = d, mpcommodity = acommodity a, mpamount = pa }
+        TotalPrice pa -> Just
+            MarketPrice { mpdate = d, mpcommodity = acommodity a, mpamount = pa `divideAmount` abs (aquantity a) }
+
+postingCosts :: Posting -> [MarketPrice]
+postingCosts p = mapMaybe (amountCost date) . amounts $ pamount p  where
+   date = fromMaybe (tdate . fromJust $ ptransaction p) $ pdate p
+
+allPostsings :: Journal -> [Posting]
+allPostsings = concatMap tpostings . jtxns
+
+main :: IO ()
+main = do
+    opts <- getCliOpts cmdmode
+    withJournalDo opts{ ignore_assertions_ = True } $ \_ j -> do
+        let cprices = concatMap postingCosts . allPostsings $ j
+            printPrices = mapM_ (putStrLn . showPrice)
+        when (boolopt "costs" $ rawopts_ opts) $ printPrices cprices
+        printPrices $ jmarketprices j

tests/bin/prices.test

@@ -0,0 +1,42 @@
+# Test prices addon
+
+# by default only market prices are reported
+runghc ../../bin/hledger-prices.hs -f-
+<<<
+P 2016/1/1 EUR $1.06
+P 2016/2/1 EUR $1.05
+
+2016/1/1 paycheck
+    income:remuneration     $-100
+    income:donations         $-15
+    assets:bank
+
+2016/1/2 spend
+    expenses             20 EUR @ $1.07
+    assets:bank
+>>>
+P 2016-01-01 EUR $1.06
+P 2016-02-01 EUR $1.05
+>>>2
+>>>=0
+
+# costs from postings can be included also
+runghc ../../bin/hledger-prices.hs -f- --costs
+<<<
+P 2016/1/1 EUR $1.06
+P 2016/2/1 EUR $1.05
+
+2016/1/1 paycheck
+    income:remuneration     $-100
+    income:donations         $-15
+    assets:bank
+
+2016/1/2 spend
+    expenses             20 EUR @ $1.07
+    assets:bank
+>>>
+P 2016-01-02 EUR $1.07
+P 2016-01-01 EUR $1.06
+P 2016-02-01 EUR $1.05
+>>>2
+>>>=0