Add support for price includes

Author: apauley

ChangeLog.md

@@ -2,7 +2,8 @@
 
 ## 0.13.1
 
-Minor report changes - do not assume too many extra options for default reports
+- Automatically add [include lines for yearly price files](https://github.com/apauley/hledger-flow/#price-files) if they are present on disk.
+- Minor report changes - do not assume too many extra options for default reports.
 
 ## 0.13.0
 

README.org

@@ -407,6 +407,30 @@ change. I'm only using closing balances in one or two places, so maybe
 that could do with some suggestions from people who use this more than
 myself.
 
+** Price Files
+   :PROPERTIES:
+   :CUSTOM_ID: price-files
+   :END:
+
+=hledger-flow= looks for [[https://hledger.org/journal.html#market-prices][price files]] to include in each yearly include file.
+
+For example, the presence of a file named =${BASE}/prices/2020/prices.journal= will result in some extra include file magic.
+
+The rest of this section assumes you'll have a file named =prices/2020/prices.journal= which contains price data for the year 2020.
+The =prices= directory should be right at the top of your =hledger-flow= base directory, next to the =import= directory.
+
+=hledger-flow= does not care how the price files got there, it only cares that you should have a separate file per year,
+and that it follows the above naming convention.
+
+Here is an example script which downloads prices and follows the naming convention:
+https://gist.github.com/apauley/398fa031c202733959af76b3b8ce8197
+
+After running an import with available price files you'll see a line has been added to =import/2020-include.journal=:
+
+#+BEGIN_EXAMPLE
+!include ../prices/2020/prices.journal
+#+END_EXAMPLE
+
 ** The =preprocess= Script
    :PROPERTIES:
    :CUSTOM_ID: the-preprocess-script

src/Hledger/Flow/Common.hs

@@ -322,26 +322,27 @@ includeFileName = (<.> "journal") . fromText . (format (fp%"-include")) . dirnam
 
 toIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> InputFileBundle -> Shell (Map.Map FilePath Text)
 toIncludeFiles opts ch m = do
-  preMap  <- extraIncludes opts ch (Map.keys m) ["opening.journal"] ["pre-import.journal"]
-  postMap <- extraIncludes opts ch (Map.keys m) ["closing.journal"] ["post-import.journal"]
+  preMap  <- extraIncludes opts ch (Map.keys m) ["opening.journal"] ["pre-import.journal"] []
+  postMap <- extraIncludes opts ch (Map.keys m) ["closing.journal"] ["post-import.journal"] ["prices.journal"]
   return $ (addPreamble . toIncludeFiles' preMap postMap) m
 
-extraIncludes :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [FilePath] -> [Text] -> [FilePath] -> Shell (InputFileBundle)
+extraIncludes :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [FilePath] -> [Text] -> [FilePath] -> [FilePath] -> Shell InputFileBundle
 extraIncludes opts ch = extraIncludes' opts ch Map.empty
 
-extraIncludes' :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> InputFileBundle -> [FilePath] -> [Text] -> [FilePath] -> Shell (InputFileBundle)
-extraIncludes' _ _ acc [] _ _ = return acc
-extraIncludes' opts ch acc (file:files) extraSuffixes manualFiles = do
-  extra <- extraIncludesForFile opts ch file extraSuffixes manualFiles
-  extraIncludes' opts ch (Map.unionWith (++) acc extra) files extraSuffixes manualFiles
+extraIncludes' :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> InputFileBundle -> [FilePath] -> [Text] -> [FilePath] -> [FilePath] -> Shell InputFileBundle
+extraIncludes' _ _ acc [] _ _ _ = return acc
+extraIncludes' opts ch acc (file:files) extraSuffixes manualFiles prices = do
+  extra <- extraIncludesForFile opts ch file extraSuffixes manualFiles prices
+  extraIncludes' opts ch (Map.unionWith (++) acc extra) files extraSuffixes manualFiles prices
 
-extraIncludesForFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> FilePath -> [Text] -> [FilePath] -> Shell (InputFileBundle)
-extraIncludesForFile opts ch file extraSuffixes manualFiles = do
+extraIncludesForFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> FilePath -> [Text] -> [FilePath] -> [FilePath] -> Shell InputFileBundle
+extraIncludesForFile opts ch file extraSuffixes manualFiles prices = do
   let dirprefix = fromText $ fst $ T.breakOn "-" $ format fp $ basename file
   let fileNames = map (\suff -> fromText $ format (fp%"-"%s) dirprefix suff) extraSuffixes
   let suffixFiles = map (directory file </>) fileNames
   let suffixDirFiles = map (directory file </> "_manual_" </> dirprefix </>) manualFiles
-  let extraFiles = suffixFiles ++ suffixDirFiles
+  let priceFiles = map (directory file </> ".." </> "prices" </> dirprefix </>) prices
+  let extraFiles = suffixFiles ++ suffixDirFiles ++ priceFiles
   filtered <- filterPaths testfile extraFiles
   let logMsg = format ("Looking for possible extra include files for '"%fp%"' among these "%d%" options: "%s%". Found "%d%": "%s)
                (relativeToBase opts file) (length extraFiles) (repr $ relativeFilesAsText opts extraFiles)

stack.yaml

@@ -18,7 +18,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: nightly-2020-02-19
+resolver: nightly-2020-02-29
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.

stack.yaml.lock

@@ -6,7 +6,7 @@
 packages: []
 snapshots:
 - completed:
-    size: 492204
-    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/2/19.yaml
-    sha256: 21d491c4e1b6a9a0d16a4b1d22f4fd9ce77f6a983172f549e982ac57120e6e04
-  original: nightly-2020-02-19
+    size: 496030
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2020/2/29.yaml
+    sha256: c3f6b6cd18cb8a067e9eab5c78945d5e03a15802fe34ed650a4be241ddda5ad0
+  original: nightly-2020-02-29

test/CSVImport/Integration.hs

@@ -30,27 +30,52 @@ testExtraIncludesForFile = TestCase (
 
         ch <- liftIO newTChanIO
 
-        extraOpening1 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["opening.journal"] []
+        extraOpening1 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["opening.journal"] [] []
         liftIO $ assertEqual "The opening journal should not be included when it is not on disk" expectedEmpty extraOpening1
 
-        extraClosing1 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["closing.journal"] []
+        extraClosing1 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["closing.journal"] [] []
         liftIO $ assertEqual "The closing journal should not be included when it is not on disk" expectedEmpty extraClosing1
 
         touchAll [opening, closing]
 
-        extraOpening2 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["opening.journal"] []
+        extraOpening2 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["opening.journal"] [] []
         liftIO $ assertEqual "The opening journal should be included when it is on disk" [(accountInclude, [opening])] extraOpening2
 
-        extraClosing2 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["closing.journal"] []
+        extraClosing2 <- extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["closing.journal"] [] []
         liftIO $ assertEqual "The closing journal should be included when it is on disk" [(accountInclude, [closing])] extraClosing2
      ))
 
+testExtraIncludesPrices :: Test
+testExtraIncludesPrices = TestCase (
+  sh (
+      do
+        tmpdir <- using (mktempdir "." "hlflow")
+        let importedJournals = map (tmpdir </>) journalFiles :: [FilePath]
+        touchAll $ importedJournals
+
+        let priceFile = "prices" </> "2020" </> "prices.journal"
+
+        let includeFile = tmpdir </> "import" </> "2020-include.journal"
+        let expectedEmpty = [(includeFile, [])]
+
+        ch <- liftIO newTChanIO
+
+        price1 <- extraIncludesForFile (defaultOpts tmpdir) ch includeFile [] [] ["prices.journal"]
+        liftIO $ assertEqual "The price file should not be included when it is not on disk" expectedEmpty price1
+
+        touchAll [tmpdir </> priceFile]
+        let expectedPricePath = tmpdir </> "import" </> ".." </> priceFile
+
+        price2 <- extraIncludesForFile (defaultOpts tmpdir) ch includeFile [] [] ["prices.journal"]
+        liftIO $ assertEqual "The price file should be included when it is on disk" [(includeFile, [expectedPricePath])] price2
+     ))
+
 testIncludesPrePost :: Test
 testIncludesPrePost = TestCase (
   sh (
       do
         tmpdir <- using (mktempdir "." "hlflow")
-        let ownerDir = tmpdir </> "import/john"
+        let ownerDir = tmpdir </> "import" </> "john"
         let includeFile = ownerDir </> "2019-include.journal"
         let pre  = ownerDir </> "_manual_" </> "2019" </> "pre-import.journal"
         let post = ownerDir </> "_manual_" </> "2019" </> "post-import.journal"
@@ -91,7 +116,32 @@ testIncludesOpeningClosing = TestCase (
               <> "!include 3-journal/2019/2019-01-30.journal\n"
               <> "!include 2019-closing.journal\n"
         let expectedMap = Map.singleton includeFile expectedText
-        liftIO $ assertEqual "All pre/post files on disk should be included" expectedMap fileMap
+        liftIO $ assertEqual "All opening/closing files on disk should be included" expectedMap fileMap
+     ))
+
+testIncludesPrices :: Test
+testIncludesPrices = TestCase (
+  sh (
+      do
+        tmpdir <- using (mktempdir "." "hlflow")
+        let importDir = tmpdir </> "import"
+        let includeFile = importDir </> "2020-include.journal"
+        let prices = tmpdir </> "prices" </> "2020" </> "prices.journal"
+        let pre  = importDir </> "_manual_" </> "2020" </> "pre-import.journal"
+        let post = importDir </> "_manual_" </> "2020" </> "post-import.journal"
+        touchAll [prices, pre, post]
+
+        let includeMap = Map.singleton includeFile [importDir </> "john" </> "2020-include.journal"]
+
+        ch <- liftIO newTChanIO
+        fileMap <- toIncludeFiles (defaultOpts tmpdir) ch includeMap
+        let expectedText = includePreamble <> "\n"
+              <> "!include _manual_/2020/pre-import.journal\n"
+              <> "!include john/2020-include.journal\n"
+              <> "!include ../prices/2020/prices.journal\n"
+              <> "!include _manual_/2020/post-import.journal\n"
+        let expectedMap = Map.singleton includeFile expectedText
+        liftIO $ assertEqual "The price file should be included together with any pre/post files" expectedMap fileMap
      ))
 
 testWriteIncludeFiles :: Test
@@ -174,4 +224,4 @@ testWriteIncludeFiles = TestCase (
   )
 
 tests :: Test
-tests = TestList [testExtraIncludesForFile, testIncludesPrePost, testIncludesOpeningClosing, testWriteIncludeFiles]
+tests = TestList [testExtraIncludesForFile, testExtraIncludesPrices, testIncludesPrePost, testIncludesOpeningClosing, testIncludesPrices, testWriteIncludeFiles]