run: cache individual files rather than file groups

hledger/Hledger/Cli/Commands/Run.hs

@@ -15,8 +15,10 @@ module Hledger.Cli.Commands.Run (
  ,run'
 ) where
 
+
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
+import Data.Semigroup (sconcat)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import System.Console.CmdArgs.Explicit as C ( Mode )
@@ -33,7 +35,7 @@ import System.IO.Unsafe (unsafePerformIO)
 import System.Console.Haskeline
 
 import Safe (headMay)
-import Hledger.Cli.Utils (withJournalDo)
+import Hledger.Cli.Utils (journalTransform)
 
 -- | Command line options for this command.
 runmode = hledgerCommandMode
@@ -119,42 +121,39 @@ runREPL findBuiltinCommand = do
         loop
 
 {-# NOINLINE journalCache #-}
-journalCache :: MVar (Map.Map [String] Journal)
+journalCache :: MVar (Map.Map String Journal)
 journalCache = unsafePerformIO $ newMVar Map.empty
 
 -- | Key used to cache the journal given in the arguments to 'run'.
-defaultJournalKey :: [String]
+defaultJournalKey :: String
-defaultJournalKey = ["journal specified in args of run"]
+defaultJournalKey = "journal specified in args of run"
 
-hasStdin :: [String] -> Bool
+addJournalToCache :: Journal -> String -> IO ()
-hasStdin fps = "-" `elem` fps
+addJournalToCache j key = modifyMVar_ journalCache $ \cache ->
-
+  return $ Map.insert key j cache
-addJournalToCache :: Journal -> [String] -> IO ()
-addJournalToCache j journalpaths = modifyMVar_ journalCache $ \cache ->
-  if hasStdin $ dbg1 "addJournalToCache" journalpaths
-  then return cache
-  else return $ Map.insert journalpaths j cache
 
 withJournalCached :: CliOpts -> (Journal -> IO ()) -> IO ()
-withJournalCached cliopts f = do
+withJournalCached cliopts cmd = do
-  journalpaths <- journalFilePathFromOptsNoDefault cliopts
+  mbjournalpaths <- journalFilePathFromOptsNoDefault cliopts
-  -- if command does not have -f flags, use the same journal that was given to the "run" invocation
+  let journalpaths = case mbjournalpaths of
-  let key = case journalpaths of
+                      Nothing    -> NE.fromList [defaultJournalKey]
-              Nothing -> defaultJournalKey
+                      Just paths -> paths
-              Just paths -> NE.toList paths
+  j <- journalTransform cliopts . sconcat <$> mapM (readAndCacheJournalFile (inputopts_ cliopts)) journalpaths
-  dbg1IO "withJournalCached key" key
+  cmd j
-  modifyMVar_ journalCache $ \cache ->
+  where
-    if hasStdin key
+    readAndCacheJournalFile :: InputOpts -> PrefixedFilePath -> IO Journal
-    then do dbg1IO "withJournalCached skipping cache due to stdin" key
+    readAndCacheJournalFile iopts "-" = do
-            withJournalDo cliopts f
+      dbg1IO "readAndCacheJournalFile using stdin, not cached" "-"
-            return cache
+      j <- runExceptT $ readJournalFile iopts "-"
-    else case Map.lookup key cache of
+      either error' return j
+    readAndCacheJournalFile iopts fp = do
+      dbg1IO "readAndCacheJournalFile" fp
+      modifyMVar journalCache $ \cache ->
+        case Map.lookup fp cache of
           Just journal -> do
-            dbg1IO "withJournalCached using cache" key
+            dbg1IO "readAndCacheJournalFile using cache" fp
-            f journal
+            return (cache, journal)
-            return cache
           Nothing -> do
-            dbg1IO "withJournalCached reading and caching journal" key
+            dbg1IO "readAndCacheJournalFile reading and caching journals" fp
-            withJournalDo cliopts $ \j -> do
+            journal <- runExceptT $ readJournalFile iopts fp
-              f j
+            either error' (\j -> return (Map.insert fp j cache, j)) journal
-              return (Map.insert key j cache)