hledger-flow 0.18.0 → 0.19.0

raw patch · 29 files changed

+1891/−171 lines, 29 filesdep +aesondep +ansi-terminaldep +bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, ansi-terminal, bytestring, http-client, http-client-tls

API changes (from Hackage documentation)

Files

• ChangeLog.md +25/−0
• app/Main.hs +144/−20
• hledger-flow.cabal +22/−2
• src/Hledger/Flow/BaseDir.hs +15/−7
• src/Hledger/Flow/Common.hs +87/−13
• src/Hledger/Flow/Environment.hs +103/−0
• src/Hledger/Flow/Import/CSVImport.hs +40/−45
• src/Hledger/Flow/Import/ImportHelpers.hs +33/−2
• src/Hledger/Flow/Import/ImportHelpersTurtle.hs +61/−50
• src/Hledger/Flow/Import/Inventory.hs +24/−6
• src/Hledger/Flow/Init.hs +70/−0
• src/Hledger/Flow/Internals.hs +4/−0
• src/Hledger/Flow/Logging.hs +3/−0
• src/Hledger/Flow/PathHelpers.hs +6/−5
• src/Hledger/Flow/ReleaseNotice.hs +128/−0
• src/Hledger/Flow/Reports.hs +16/−16
• src/Hledger/Flow/RulesTemplate.hs +154/−0
• src/Hledger/Flow/Status.hs +173/−0
• src/Hledger/Flow/Status/Gather.hs +147/−0
• src/Hledger/Flow/Status/Render.hs +181/−0
• test/BaseDir/Integration.hs +13/−3
• test/Common/Unit.hs +10/−1
• test/Environment/Unit.hs +41/−0
• test/Init/Integration.hs +22/−0
• test/ReleaseNotice/Unit.hs +81/−0
• test/RulesTemplate/Unit.hs +43/−0
• test/Spec.hs +13/−1
• test/Status/Integration.hs +92/−0
• test/Status/Unit.hs +140/−0

@@ -28,6 +28,31 @@   existing destination belongs in release-procedure.md. --> +## 0.19.0++- New `init` and `status` commands. `status` lists your accounts, flags+  misplaced statements, and tells you when to import after changing rules,+  adding manual journals or deleting statements.+  Running `hledger-flow` alone does the same inside a ledger, and says how to+  start one elsewhere. See the [quick-start](https://github.com/apauley/hledger-flow/blob/master/QUICKSTART.md#import-your-first-statement).+- `status --json` gives scripts and AI agents the same facts and next step+  ([fields](https://github.com/apauley/hledger-flow/blob/master/docs/README.md#status-for-scripts-and-agents)).+  `status --rules-template owner/bank/account` prints a starter rules file+  from the latest statement or its matching preprocessed CSV.+- `--show-options` now prints the hledger-flow version and commit, the full+  path and version of hledger, and each setting with the flag that changes it.+  `status` always ends with these versions and paths, and `status --json` has+  them under `environment`.+- Interactive `import` and `report` runs can show an [upgrade notice](https://github.com/apauley/hledger-flow/blob/master/docs/README.md#release-notices) without waiting for the network. Set `HLEDGER_FLOW_NO_UPDATE_CHECK=1` to turn it off.+- `import` and `report` print a short summary and the next step. The report+  summary counts how many empty reports were skipped. Both `status` and+  `report` accept `~/` paths in `LEDGER_FILE`. Timings and progress lines+  moved to `--verbose`. Errors no longer show Haskell+  backtraces, and a failing hledger conversion names the rules file to check+  without echoing the whole statement.+- Linux x86-64 users can [build and install a strictly confined snap](https://github.com/apauley/hledger-flow/blob/master/snap/README.md)+  that includes the hledger 1.99.6 pre-release for imports, reports, and account scripts.+ ## 0.18.0  - If you keep handwritten transactions in a journal under `3-journal`

@@ -1,6 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}  module Main where @@ -10,6 +11,7 @@ import Prelude hiding (putStrLn)  import qualified Options.Applicative as Opts (command)+import Options.Applicative.Help.Pretty (Doc, pretty, vsep) import Options.Applicative     ( auto,       argument,@@ -19,9 +21,9 @@       hsubparser,       info,       prefs,-      progDescDoc,-      showHelpOnEmpty,-      showHelpOnError,+      progDesc,+      footerDoc,+      hidden,       optional,       Alternative(many, (<|>)),       Parser,@@ -35,13 +37,26 @@       switch )  import Hledger.Flow.Common ( hledgerInfoFromPath )+import Hledger.Flow.Status ( Situation (..) )+import Hledger.Flow.Status.Gather ( classifyDir )+import Hledger.Flow.Status.Render ( printStatus )+import qualified Data.Text as Text+import Path.IO ( getCurrentDir, resolveDir' )+import Hledger.Flow.Init ( runInit )+import Hledger.Flow.RulesTemplate ( rulesTemplateFor ) import Hledger.Flow.Internals (versionInfo, systemInfo)-import Hledger.Flow.BaseDir ( determineBaseDir )+import Hledger.Flow.BaseDir ( determineBaseDir, findBaseDir ) import qualified Hledger.Flow.RuntimeOptions as RT+import Hledger.Flow.ReleaseNotice ( withReleaseNotice ) import Hledger.Flow.Reports ( generateReports ) import Hledger.Flow.Import.CSVImport ( importCSVs )  import qualified Data.Text.IO as T+import Control.Exception (SomeAsyncException (..), SomeException, catch, displayException, fromException, throwIO)+import Hledger.Flow.PathHelpers (PathException (..), turtleToAbsDir)+import System.Exit (ExitCode (..), exitWith)+import System.IO (hPutStrLn, hSetEncoding, stderr, stdout, utf8)+import System.IO.Error (ioeGetErrorString, isUserError) #ifdef mingw32_HOST_OS import System.IO.CodePage (withCP65001) #endif@@ -55,8 +70,15 @@                                  , asciiReports :: Bool                                  } deriving (Show) -data Command = Import ImportParams | Report ReportParams deriving (Show)+data StatusParams = StatusParams { statusDir :: Maybe FilePath+                                 , statusJson :: Bool+                                 , statusRulesTemplate :: Maybe String+                                 } deriving (Show) +newtype InitParams = InitParams { initDir :: Maybe FilePath } deriving (Show)++data Command = Import ImportParams | Report ReportParams | Status StatusParams | Init InitParams deriving (Show)+ data MainParams = MainParams { verbosity :: Int                              , hledgerPathOpt :: Maybe FilePath                              , hledgerConfOpt :: Maybe FilePath@@ -64,7 +86,7 @@                              , batchSize :: Maybe Int                              , sequential :: Bool                              } deriving (Show)-data BaseCommand = Version | Command { mainParams :: MainParams, command :: Command } deriving (Show)+data BaseCommand = Version | Command { mainParams :: MainParams, command :: Maybe Command } deriving (Show)  main :: IO () #ifdef mingw32_HOST_OS@@ -77,16 +99,87 @@  runCLI :: IO () runCLI = do+  -- Status and errors use non-ASCII symbols; a C locale must not make them fail.+  mapM_ (`hSetEncoding` utf8) [stdout, stderr]+  runCommand `catch` reportFatal++-- | Print uncaught errors as one plain message, without GHC's backtrace.+reportFatal :: SomeException -> IO ()+reportFatal e+  | Just (code :: ExitCode) <- fromException e = throwIO code+  | Just (SomeAsyncException _) <- fromException e = throwIO e+  | otherwise = do+      hPutStrLn stderr ("hledger-flow: " ++ fatalMessage e)+      exitWith (ExitFailure 1)++fatalMessage :: SomeException -> String+fatalMessage e+  | Just (pe :: PathException) <- fromException e = show pe+  | Just ioe <- fromException e, isUserError ioe = ioeGetErrorString ioe+  | otherwise = displayException e++runCommand :: IO ()+runCommand = do   let description = "An hledger workflow focusing on automated statement import and classification:\nhttps://github.com/apauley/hledger-flow#readme"-  cmd <- customExecParser (prefs (showHelpOnError <> showHelpOnEmpty))-    (info (helper <*> baseCommandParser) (headerDoc (Just description)))+  cmd <- customExecParser (prefs mempty)+    (info (helper <*> baseCommandParser) (headerDoc (Just description) <> footerDoc (Just topExamples)))   case cmd of     Version -> do       sysInfo <- systemInfo       T.putStrLn $ versionInfo sysInfo -    Command mainParams' (Import subParams) -> toRuntimeOptionsImport mainParams' subParams >>= importCSVs-    Command mainParams' (Report subParams) -> toRuntimeOptionsReport mainParams' subParams >>= generateReports+    Command mainParams' (Just (Import subParams)) ->+      withReleaseNotice $ (toRuntimeOptionsImport mainParams' subParams >>= importCSVs) `catch` reportFatal+    Command mainParams' (Just (Report subParams)) ->+      withReleaseNotice $ (toRuntimeOptionsReport mainParams' subParams >>= generateReports) `catch` reportFatal+    Command mainParams' (Just (Status subParams)) -> runStatus mainParams' subParams+    Command mainParams' (Just (Init subParams)) -> do+      cwd <- getCurrentDir+      dir <- maybe (return cwd) resolveDir' (initDir subParams)+      runInit (hledgerPathOpt mainParams') cwd dir+    Command mainParams' Nothing -> runBare mainParams' +-- | (name, one-line description) of each command, in display order.+commandSummaries :: [(String, String)]+commandSummaries =+  [ ("status", "Show what's in your ledger and what to do next"),+    ("init", "Start a new ledger in a folder"),+    ("import", "Turn statements into journals"),+    ("report", "Generate reports from your journals")+  ]++summaryOf :: String -> String+summaryOf name = maybe "" id (lookup name commandSummaries)++briefUsage :: Text.Text+briefUsage =+  "hledger-flow turns bank statements into hledger journals and reports.\n\nCommands:\n"+    <> Text.concat ["  " <> Text.justifyLeft width ' ' (Text.pack name) <> "   " <> Text.pack desc <> "\n" | (name, desc) <- commandSummaries]+    <> "\nRun `hledger-flow --help` for options and examples.\n"+  where+    width = maximum (map (length . fst) commandSummaries)++runStatus :: MainParams -> StatusParams -> IO ()+runStatus mainParams' params = do+  cwd <- getCurrentDir+  dir <- maybe (return cwd) (turtleToAbsDir cwd) (statusDir params)+  base <- findBaseDir dir >>= maybe (throwIO (MissingBaseDir dir)) return+  case statusRulesTemplate params of+    Just account -> rulesTemplateFor base (Text.pack account) >>= either (ioError . userError . Text.unpack) T.putStr+    Nothing -> printStatus (hledgerPathOpt mainParams') (hledgerConfOpt mainParams') (statusJson params) base++-- | Running hledger-flow with no command: say where we are and what to do.+runBare :: MainParams -> IO ()+runBare mainParams' = do+  situation <- getCurrentDir >>= classifyDir+  case situation of+    InLedger base -> printStatus (hledgerPathOpt mainParams') (hledgerConfOpt mainParams') False base+    EmptyDir -> T.putStrLn "This folder is empty. Run `hledger-flow init` to start your ledger here."+    Elsewhere ->+      T.putStr $+        briefUsage+          <> "\nNo hledger-flow ledger here or in any parent folder.\n"+          <> "Run `hledger-flow init` in an empty folder to start one.\n"+ defaultBatchSize :: Int defaultBatchSize = 20 @@ -145,22 +238,53 @@ baseCommandParser = (Command <$> verboseParser <*> commandParser)   <|> flag' Version (long "version" <> short 'V' <> help "Display version information") -commandParser :: Parser Command-commandParser = fmap Import (subcommand "import" "Uses hledger with your own rules and/or scripts to convert electronic statements into categorised journal files" subcommandParserImport)-  <|> fmap Report (subcommand "report" "Generate Reports" subcommandParserReport)-+commandParser :: Parser (Maybe Command)+commandParser = optional $ hsubparser $+  subcommand "status" (Status <$> subcommandParserStatus)+    <> subcommand "init" (Init . InitParams <$> optional (argument str (metavar "DIR" <> help "The folder for the new ledger, created if missing. Defaults to the current folder.")))+    <> subcommand "import" (Import <$> subcommandParserImport)+    <> subcommand "report" (Report <$> subcommandParserReport)+    <> metavar "COMMAND"   where-    subcommand name desc parser =-      hsubparser (Opts.command name (info parser (progDescDoc (Just desc))) <> metavar name)+    subcommand name parser = Opts.command name (info parser (progDesc (summaryOf name) <> footerDoc (lines' <$> lookup name subcommandExamples))) +lines' :: [String] -> Doc+lines' = vsep . map pretty++topExamples :: Doc+topExamples = lines'+  [ "Examples:",+    "  hledger-flow init            Start a ledger in the current folder",+    "  hledger-flow status          See what's there and what to do next",+    "  hledger-flow import          Turn statements into journals",+    "  hledger-flow report          Generate reports",+    "  hledger-flow status --json   The same status, for scripts and agents",+    "",+    "Docs: https://github.com/apauley/hledger-flow/tree/master/docs"+  ]++subcommandExamples :: [(String, [String])]+subcommandExamples =+  [ ("status", ["Examples:", "  hledger-flow status --json", "  hledger-flow status --rules-template me/mybank/checking"]),+    ("init", ["Example:", "  hledger-flow init ~/finances"]),+    ("import", ["Examples:", "  hledger-flow import import/me/mybank", "  hledger-flow import --start-year current"]),+    ("report", ["Example:", "  hledger-flow report"])+  ]++subcommandParserStatus :: Parser StatusParams+subcommandParserStatus = StatusParams+  <$> optional (argument str (metavar "DIR" <> help "A folder inside the ledger. Defaults to the current folder."))+  <*> switch (long "json" <> help "Print the status as JSON, for scripts and agents")+  <*> optional (option str (long "rules-template" <> metavar "ACCOUNT" <> help "Print a starter rules file for owner/bank/account, built from its newest statement's header row"))+ verboseParser :: Parser MainParams verboseParser = MainParams   <$> (length <$> many (flag' () (long "verbose" <> short 'v' <> help "Print more verbose output")))   <*> optional (option str (long "hledger-path" <> short 'H' <> metavar "HLEDGER-PATH" <> help "The full path to an hledger executable"))-  <*> optional (option str (long "hledger-conf" <> metavar "PATH" <> help "The hledger config file to pass to hledger --conf"))-  <*> switch (long "show-options" <> help "Print the options this program will run with")-  <*> optional (option auto (long "batch-size" <> metavar "SIZE" <> help ("Number of files to process in parallel. Must be positive. Default: " <> show defaultBatchSize <> ". Ignored during sequential processing.")))-  <*> switch (long "sequential" <> help "Disable parallel processing")+  <*> optional (option str (long "hledger-conf" <> metavar "PATH" <> hidden <> help "The hledger config file to pass to hledger --conf"))+  <*> switch (long "show-options" <> hidden <> help "Print the hledger-flow version, hledger path and settings import or report runs with. status always shows them.")+  <*> optional (option auto (long "batch-size" <> metavar "SIZE" <> hidden <> help ("Number of files to process in parallel. Must be positive. Default: " <> show defaultBatchSize <> ". Ignored during sequential processing.")))+  <*> switch (long "sequential" <> hidden <> help "Disable parallel processing")  subcommandParserImport :: Parser ImportParams subcommandParserImport = ImportParams

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           hledger-flow-version:        0.18.0+version:        0.19.0 synopsis:       An hledger workflow focusing on automated statement import and classification. description:    Please see the README on GitHub at <https://github.com/apauley/hledger-flow#readme> category:       Finance, Console@@ -31,16 +31,23 @@       Hledger.Flow.Common       Hledger.Flow.DateTime       Hledger.Flow.DocHelpers+      Hledger.Flow.Environment       Hledger.Flow.Import.CSVImport       Hledger.Flow.Import.ImportHelpers       Hledger.Flow.Import.ImportHelpersTurtle       Hledger.Flow.Import.Inventory       Hledger.Flow.Import.Types+      Hledger.Flow.Init       Hledger.Flow.Internals       Hledger.Flow.Logging       Hledger.Flow.PathHelpers+      Hledger.Flow.ReleaseNotice       Hledger.Flow.Reports+      Hledger.Flow.RulesTemplate       Hledger.Flow.RuntimeOptions+      Hledger.Flow.Status+      Hledger.Flow.Status.Gather+      Hledger.Flow.Status.Render       Hledger.Flow.Types   other-modules:       Paths_hledger_flow@@ -48,13 +55,18 @@       src   ghc-options: -Wall   build-depends:-      async >=2.2.5 && <2.3+      aeson >=2.2.5 && <2.3+    , ansi-terminal >=1.1.5 && <1.2+    , async >=2.2.5 && <2.3     , base >=4.20 && <4.22+    , bytestring ==0.12.*     , containers ==0.7.*     , directory >=1.3.8.5 && <1.4     , exceptions >=0.10.9 && <0.11     , filepath >=1.5.4.0 && <1.6     , gitrev >=1.3.1 && <1.4+    , http-client >=0.7.19 && <0.8+    , http-client-tls >=0.3.6.4 && <0.4     , path >=0.9.6 && <0.10     , path-io >=1.8.2 && <1.9     , process >=1.6.26.1 && <1.7@@ -77,6 +89,7 @@     , hledger-flow     , optparse-applicative >=0.18.1.0 && <0.20     , path >=0.9.6 && <0.10+    , path-io >=1.8.2 && <1.9     , text >=2.1.3 && <2.2   default-language: Haskell2010   if os(windows)@@ -94,8 +107,14 @@       CSVImport.ImportHelperTurtleTests       CSVImport.Integration       CSVImport.Unit+      Environment.Unit       ImportHelpers.Integration+      Init.Integration       PathHelpers.Unit+      ReleaseNotice.Unit+      RulesTemplate.Unit+      Status.Integration+      Status.Unit       TestHelpers       Paths_hledger_flow   hs-source-dirs:@@ -103,6 +122,7 @@   ghc-options: -threaded -rtsopts -with-rtsopts=-N   build-depends:       HUnit >=1.6.2.0 && <1.7+    , aeson >=2.2.5 && <2.3     , base >=4.20 && <4.22     , containers ==0.7.*     , directory >=1.3.8.5 && <1.4

@@ -3,6 +3,7 @@  module Hledger.Flow.BaseDir   ( determineBaseDir,+    findBaseDir,     relativeToBase,     relativeToBase',     turtleBaseDir,@@ -38,13 +39,20 @@  determineBaseDirFromStartDir' :: (MonadIO m, MonadThrow m) => AbsDir -> AbsDir -> m (BaseDir, RunDir) determineBaseDirFromStartDir' startDir possibleBaseDir = do-  Control.Monad.when (parent possibleBaseDir == possibleBaseDir) $ throwM (MissingBaseDir startDir)-  foundBaseDir <- doesDirExist $ possibleBaseDir </> [reldir|import|]-  if foundBaseDir-    then do-      runDir <- limitRunDir possibleBaseDir startDir-      return (possibleBaseDir, runDir)-    else determineBaseDirFromStartDir' startDir $ parent possibleBaseDir+  found <- liftIO $ findBaseDir possibleBaseDir+  case found of+    Nothing -> throwM (MissingBaseDir startDir)+    Just bd -> do+      runDir <- limitRunDir bd startDir+      return (bd, runDir)++-- | The nearest directory at or above the start directory that contains @import/@.+findBaseDir :: AbsDir -> IO (Maybe BaseDir)+findBaseDir dir = do+  found <- doesDirExist $ dir </> [reldir|import|]+  if found+    then return (Just dir)+    else if parent dir == dir then return Nothing else findBaseDir (parent dir)  -- | We have unexpected behaviour when the runDir is deeper than the account directory, -- e.g. "1-in" or the year directory. Specifically, include files are generated incorrectly

@@ -4,6 +4,7 @@ module Hledger.Flow.Common where  import Control.Concurrent (threadDelay)+import Control.Exception (SomeException, try) import Control.Monad (filterM, forM_, when) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Concurrent.Async (concurrently, mapConcurrently)@@ -30,6 +31,7 @@ import qualified Path import qualified Path.IO as Path import qualified System.Directory as Directory+import System.Environment (lookupEnv) import qualified System.FilePath as FilePath import System.Exit (ExitCode (..), exitWith) import System.IO (hClose)@@ -62,6 +64,20 @@                   <> "There are a number of installation options on the hledger website: https://hledger.org/download.html"           ioError (userError msg) +-- | The hledger to use, or Nothing when it can't be found or run. Never exits.+findHledger :: Maybe FilePath -> IO (Maybe HledgerInfo)+findHledger pathOption = do+  found <- case pathOption of+    Just h -> do+      exists <- Directory.doesFileExist h+      if exists then Just <$> Path.resolveFile' h else return Nothing+    Nothing -> Directory.findExecutable "hledger" >>= traverse Path.resolveFile'+  case found of+    Nothing -> return Nothing+    Just hlp -> do+      version <- try (hledgerVersionFromPath hlp) :: IO (Either SomeException T.Text)+      return (either (const Nothing) (Just . HledgerInfo hlp) version)+ hledgerVersionFromPath :: AbsFile -> IO T.Text hledgerVersionFromPath hlp = do   let command = (Process.proc (toFilePath hlp) ["--version"])@@ -93,10 +109,34 @@ escapeArg :: T.Text -> T.Text escapeArg a   | not (T.null a) && T.all safe a = a-  | otherwise = "'" <> T.replace "'" "'\"'\"'" a <> "'"+  | otherwise = posixLiteral a   where     safe c = isAscii c && (isAlphaNum c || c `elem` ("-_./:=+,@%" :: String)) +-- | The shell used for copyable commands on this platform.+data Shell = Posix | PowerShell deriving (Eq, Show)++nativeShell :: Shell+nativeShell = if Sys.os == "mingw32" then PowerShell else Posix++shellArgument :: Shell -> T.Text -> T.Text+shellArgument Posix arg = escapeArg arg+shellArgument PowerShell arg+  | not (T.null arg) && T.all simple arg = arg+  | otherwise = powerShellLiteral arg+  where+    simple c = isAscii c && (isAlphaNum c || c `elem` ("-_./" :: String))++posixLiteral :: T.Text -> T.Text+posixLiteral arg = "'" <> T.replace "'" "'\"'\"'" arg <> "'"++powerShellLiteral :: T.Text -> T.Text+powerShellLiteral arg = "'" <> T.concatMap escape arg <> "'"+  where+    -- PowerShell also recognises typographic single quotes as delimiters.+    escape c | c == '\'' || (c >= '\x2018' && c <= '\x201b') = T.replicate 2 (T.singleton c)+             | otherwise = T.singleton c+ errExit :: Int -> TChan LogMessage -> T.Text -> a -> IO a errExit exitStatus ch = errExit' exitStatus (channelErrLn ch) @@ -162,7 +202,7 @@   (TChan LogMessage -> T.Text -> IO ()) ->   ProcInput ->   IO FullTimedOutput-timeAndExitOnErr opts ch cmdLabel = timeAndExitOnErr' opts ch cmdLabel []+timeAndExitOnErr opts ch cmdLabel = timeAndExitOnErr' opts ch cmdLabel [] []  timeAndExitOnErr' ::   (HasVerbosity o) =>@@ -170,26 +210,44 @@   TChan LogMessage ->   T.Text ->   [T.Text] ->+  [T.Text] ->   (TChan LogMessage -> T.Text -> IO ()) ->   (TChan LogMessage -> T.Text -> IO ()) ->   ProcInput ->   IO FullTimedOutput-timeAndExitOnErr' opts ch cmdLabel extraCmdLabels stdoutLogger stderrLogger input@(cmd, args, _) = do+timeAndExitOnErr' opts ch cmdLabel extraCmdLabels hints stdoutLogger stderrLogger input@(cmd, args, _) = do   let action = runProcessCaptured input-  timed@((ec, stdOut, stdErr), _) <- logTimedAction opts ch cmdLabel extraCmdLabels cmd args stdoutLogger stderrLogger action+  -- On failure the error output goes into the (trimmed) message, not straight to the console.+  timed@((ec, stdOut, stdErr), _) <- logTimedAction opts ch cmdLabel extraCmdLabels cmd args stdoutLogger (\_ _ -> return ()) action   case ec of     ExitFailure i -> do       let cmdText = cmd <> " " <> showCmdArgs args-      let msgOut = descriptiveOutput "Standard output" stdOut-      let msgErr = descriptiveOutput "Error output" stdErr-+      let msgOut = descriptiveOutput "Standard output" (trimToolOutput stdOut)+      let msgErr = descriptiveOutput "Error output" (trimToolOutput stdErr)       let exitMsg =-            "\n=== Begin Error: " <> cmdLabel <> " ===\nExternal command:\n"-              <> cmdText <> "\nExit code " <> T.pack (show i) <> "\n" <> msgOut <> msgErr-              <> "=== End Error: " <> cmdLabel <> " ===\n"+            "Failed " <> cmdLabel <> " (exit code " <> T.pack (show i) <> ").\n"+              <> "Command: " <> cmdText <> "\n" <> msgOut <> msgErr+              <> T.unlines hints       errExit i ch exitMsg timed-    ExitSuccess -> return timed+    ExitSuccess -> do+      stderrLogger ch stdErr+      return timed +-- | Keep a tool's output readable: at most 20 lines of at most 300 characters.+-- hledger can echo a whole statement on one line when parsing fails.+trimToolOutput :: T.Text -> T.Text+trimToolOutput txt+  | length ls <= maxLines && all ((<= maxWidth) . T.length) ls = txt+  | otherwise = T.intercalate "\n" (map cut (take maxLines ls) ++ dropped) <> (if "\n" `T.isSuffixOf` txt then "\n" else "")+  where+    ls = T.lines txt+    maxLines = 20+    maxWidth = 300+    cut l = if T.length l > maxWidth then T.take maxWidth l <> "…" else l+    dropped = case length ls - maxLines of+      n | n > 0 -> ["… (" <> T.pack (show n) <> " more lines)"]+      _ -> []+ parAwareActions :: (HasSequential o, HasBatchSize o) => o -> [IO a] -> IO [a] parAwareActions opts = if (sequential opts) then sequence else parBatchedActions (batchSize opts) [] @@ -250,6 +308,19 @@ allYearsFileName :: FilePath allYearsFileName = "all-years" <.> "journal" +-- Keep the configured spelling for diagnostics and expand a leading ~ for IO.+configuredLedgerFile :: IO (Maybe (FilePath, FilePath))+configuredLedgerFile = do+  value <- lookupEnv "LEDGER_FILE"+  case value of+    Just path | not (null path) -> do+      resolved <- case path of+        "~" -> Directory.getHomeDirectory+        '~' : sep : rest | FilePath.isPathSeparator sep -> (FilePath.</> rest) <$> Directory.getHomeDirectory+        _ -> return path+      return (Just (path, resolved))+    _ -> return Nothing+ directivesFile :: (HasBaseDir o) => o -> AbsFile directivesFile opts = baseDir opts Path.</> [relfile|directives.journal|] @@ -279,8 +350,11 @@  writeTextMap :: Map.Map FilePath T.Text -> IO () writeTextMap files = forM_ (Map.toList files) $ \(path, contents) -> do-  current <- tryIOError (T.readFile path)-  when (either (const True) (/= contents) current) $ T.writeFile path contents+  changed <- textFileNeedsUpdate path contents+  when changed $ T.writeFile path contents++textFileNeedsUpdate :: FilePath -> T.Text -> IO Bool+textFileNeedsUpdate path contents = either (const True) (/= contents) <$> tryIOError (T.readFile path)  listOwners :: HasBaseDir o => o -> IO [RelDir] listOwners opts = do

@@ -0,0 +1,103 @@+{-# LANGUAGE OverloadedStrings #-}++-- | The versions, paths and settings a command runs with, for debugging and bug reports.+module Hledger.Flow.Environment+  ( Setting (..),+    environmentSettings,+    coresSetting,+    importSettings,+    reportSettings,+    renderSettings,+    environmentJSON,+  )+where++import Data.Aeson (Value, object, (.=))+import qualified Data.Text as T+import Data.Version (showVersion)+import Hledger.Flow.Internals (SystemInfo (..), gitCommit)+import Hledger.Flow.RuntimeOptions+import Hledger.Flow.Status (hledgerVersionNumber)+import Hledger.Flow.Types (BaseDir, HledgerInfo (..))+import Path (toFilePath)+import Paths_hledger_flow (version)+import System.FilePath (dropTrailingPathSeparator)++-- | One line: a label, its value and the flags that change it.+data Setting = Setting {sLabel :: T.Text, sValue :: T.Text, sFlags :: T.Text, sProblem :: Bool}++setting :: T.Text -> T.Text -> T.Text -> Setting+setting l v f = Setting l v f False++-- | What every command shares: hledger-flow, hledger, its config and the ledger.+environmentSettings :: SystemInfo -> Maybe HledgerInfo -> Maybe FilePath -> BaseDir -> [Setting]+environmentSettings sys hledger conf base =+  [ setting "hledger-flow" (T.pack (showVersion version <> " (" <> gitCommit <> "), " <> compilerName sys <> " " <> showVersion (compilerVersion sys) <> ", " <> os sys <> " " <> arch sys)) "",+    case hledger of+      Just hl -> setting "hledger" (T.pack (toFilePath (hlPath hl)) <> "  (" <> hledgerVersionNumber (hlVersion hl) <> ")") "--hledger-path"+      Nothing -> Setting "hledger" "not found" "--hledger-path" True,+    setting "hledger.conf" (maybe "none" T.pack conf) "--hledger-conf",+    setting "Ledger" (T.pack (dropTrailingPathSeparator (toFilePath base))) ""+  ]++coresSetting :: SystemInfo -> Setting+coresSetting sys = setting "Cores" (tshow (cores sys) <> ", using " <> tshow (availableCores sys)) ""++optsEnvironment :: RuntimeOptions -> [Setting]+optsEnvironment o = environmentSettings (sysInfo o) (Just (hledgerInfo o)) (hledgerConf o) (baseDir o)++parallelism :: RuntimeOptions -> Setting+parallelism o = setting "Parallelism" value "--batch-size, --sequential"+  where+    sys = sysInfo o+    value+      | sequential o = "one file at a time"+      | otherwise = tshow (batchSize o) <> " files at a time, " <> tshow (availableCores sys) <> " of " <> tshow (cores sys) <> " cores"++importSettings :: RuntimeOptions -> [Setting]+importSettings o =+  optsEnvironment o+    ++ [ setting "Run from" runFrom "",+         setting "Start year" (maybe "all years" (\y -> tshow y <> " onwards") (importStartYear o)) "--start-year",+         setting "Files" (if onlyNewFiles o then "only new or changed" else "regenerate all") "--new-files-only",+         parallelism o+       ]+  where+    runFrom = case dropTrailingPathSeparator (toFilePath (importRunDir o)) of+      "." -> ". (whole ledger)"+      dir -> T.pack dir++reportSettings :: RuntimeOptions -> [Setting]+reportSettings o =+  optsEnvironment o+    ++ [ setting "Tables" (if prettyReports o then "pretty" else "ASCII") "--ascii-reports",+         parallelism o+       ]++-- | Aligned lines; @problem@ styles values that need attention, such as a missing hledger.+renderSettings :: (T.Text -> T.Text) -> [Setting] -> [T.Text]+renderSettings problem settings = map line settings+  where+    width f = maximum (0 : map (T.length . f) settings)+    -- A long value without flags, such as the ledger path, mustn't push the flags column right.+    valueWidth = maximum (0 : [T.length (sValue s) | s <- settings, not (T.null (sFlags s))])+    line s =+      let value = T.justifyLeft valueWidth ' ' (sValue s)+          styled = if sProblem s then problem value else value+       in T.stripEnd (T.justifyLeft (width sLabel) ' ' (sLabel s) <> "  " <> styled <> "   " <> sFlags s)++environmentJSON :: SystemInfo -> Maybe FilePath -> Value+environmentJSON sys conf =+  object+    [ "hledgerFlowVersion" .= showVersion version,+      "commit" .= gitCommit,+      "compiler" .= (compilerName sys <> " " <> showVersion (compilerVersion sys)),+      "os" .= os sys,+      "arch" .= arch sys,+      "cores" .= cores sys,+      "availableCores" .= availableCores sys,+      "hledgerConf" .= conf+    ]++tshow :: Show a => a -> T.Text+tshow = T.pack . show

@@ -9,10 +9,10 @@ import Control.Concurrent.STM import Control.Monad import Data.Maybe (fromMaybe)-import qualified Data.Map.Strict as Map import qualified Data.Text as T import qualified Data.Text.IO as T import Hledger.Flow.DateTime (timeAction)+import Hledger.Flow.Environment (importSettings, renderSettings) import Hledger.Flow.BaseDir (effectiveRunDir, relativeToBase) import Hledger.Flow.Common import Hledger.Flow.DocHelpers (docURL)@@ -31,19 +31,45 @@ import System.IO (hClose) import qualified System.Info as Sys import qualified System.Process as Process-import System.FilePath (dropExtensions, dropTrailingPathSeparator, takeExtension, (<.>), (</>))+import System.FilePath (dropTrailingPathSeparator, takeExtension, (</>))+import qualified Data.List as List+import Hledger.Flow.Status (plural)+import Hledger.Flow.Status.Gather (accountName, gatherStatus)+import Hledger.Flow.Status.Render (nextStepHere, renderNext, useColor)+import System.IO (stdout) import Prelude hiding (putStrLn, take, writeFile)  type FileWasGenerated = Bool  importCSVs :: RuntimeOptions -> IO () importCSVs opts = withConsoleLogging $ \ch -> do-  when (showOptions opts) (channelOutLn ch (T.pack (show opts)))+  when (showOptions opts) (channelOutLn ch (T.unlines (renderSettings id (importSettings opts))))   logVerbose opts ch "Starting import"   (journals, diff) <- timeAction $ importCSVs' opts ch-  let generatedJournals = filter snd journals-  channelOutLn ch $ "Imported " <> T.pack (show (length generatedJournals)) <> "/" <> T.pack (show (length journals)) <> " journals in " <> T.pack (show diff)+  let importRoot = baseDir opts Path.</> [Path.reldir|import|]+      effectiveDir = effectiveRunDir (baseDir opts) (importRunDir opts)+      scope = T.pack (dropTrailingPathSeparator (relativeToBase opts (Path.toFilePath effectiveDir)))+      accounts = List.nub (map (accountName importRoot . fst) journals)+  channelOutLn ch (importSummary scope (length journals) (length (filter snd journals)) accounts)+  logVerbose opts ch ("Import took " <> T.pack (show diff))+  status <- gatherStatus (Just (hledgerInfo opts)) (baseDir opts)+  next <- nextStepHere status+  color <- useColor stdout+  channelOut ch (renderNext color next) +-- | One line saying what import did.+importSummary :: T.Text -> Int -> Int -> [T.Text] -> T.Text+importSummary scope total generated accounts+  | total == 0 = "No statements to import in " <> scope <> "."+  | generated == total = "Imported " <> plural total "statement" <> " for " <> accountsText <> "."+  | otherwise =+      "Imported " <> T.pack (show generated) <> " of " <> plural total "statement" <> " for " <> accountsText+        <> " (" <> T.pack (show (total - generated)) <> " already up to date)."+  where+    accountsText+      | length accounts <= 3 = T.intercalate ", " accounts+      | otherwise = plural (length accounts) "account"+ importCSVs' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> IO [(AbsFile, FileWasGenerated)] importCSVs' opts ch = do   let effectiveDir = effectiveRunDir (baseDir opts) (importRunDir opts)@@ -51,7 +77,7 @@       selected = inImportScope effectiveDir (fromMaybe 0 (importStartYear opts))   let startYearMsg = maybe " " (\y -> " (for the year " <> T.pack (show y) <> " and onwards) ") (importStartYear opts)   let dirText = T.pack (Path.toFilePath effectiveDir)-  channelOutLn ch $ "Collecting input files" <> startYearMsg <> "from " <> dirText+  logVerbose opts ch $ "Collecting input files" <> startYearMsg <> "from " <> dirText   (inventory, diff) <- timeAction $ findImportFiles importRoot   let inputFiles = filter selected (stageFiles importRoot [Path.reldir|1-in|] inventory)       fileCount = length inputFiles@@ -61,28 +87,20 @@     errExit 1 ch ("Multiple input files map to the same output:\n" <>       T.intercalate "\n" [relative output <> " <- " <> T.intercalate ", " (map relative sources)                          | (output, sources) <- collisions]) ()-  channelOutLn ch $ "Found " <> T.pack (show fileCount) <> " input files" <> startYearMsg <> "in " <> T.pack (show diff) <> ". Proceeding with import..."+  logVerbose opts ch $ "Found " <> T.pack (show fileCount) <> " input files" <> startYearMsg <> "in " <> T.pack (show diff) <> ". Proceeding with import..."   importedJournals <- parAwareActions opts (map (extractAndImport opts ch) inputFiles)    -- Hooks may create files, so reconcile against a fresh inventory only after   -- every selected conversion succeeds. A cached CSV is never a source.   (refreshed, journalFindTime) <- timeAction $ findImportFiles importRoot-  expected <- expectedOutputs (stageFiles importRoot [Path.reldir|1-in|] refreshed)-  let stageWithExtension stage ext = filter ((== ext) . takeExtension . Path.toFilePath) (stageFiles importRoot stage refreshed)-      journals = stageWithExtension [Path.reldir|3-journal|] ".journal"-      generated = stageWithExtension [Path.reldir|2-preprocessed|] ".csv" ++ journals-  classified <- forM generated $ \file -> do-    key <- canonicalFile file-    return (file, Map.member key expected)-  let orphans = [file | (file, False) <- classified, selected file]-      journalsOnDisk = [file | (file, True) <- classified, takeExtension (Path.toFilePath file) == ".journal"]-  forM_ orphans $ \file -> do+  (orphans, journalsOnDisk) <- classifyGeneratedOutputs importRoot refreshed (stageFiles importRoot [Path.reldir|1-in|] refreshed)+  forM_ (filter selected orphans) $ \file -> do     target <- moveToTrash file     channelOutLn ch $ "Moved orphaned output " <> relative file <> " to " <> relative target   (_, writeIncludeTime1) <- timeAction $ writeIncludesFromInventory opts ch importRoot refreshed journalsOnDisk   (_, writeIncludeTime2) <- timeAction $ writeToplevelAllYearsInclude opts   let includeGenTime = journalFindTime + writeIncludeTime1 + writeIncludeTime2-  channelOutLn ch $ "Wrote include files for " <> T.pack (show (length journalsOnDisk)) <> " generated journals in " <> T.pack (show includeGenTime)+  logVerbose opts ch $ "Wrote include files for " <> T.pack (show (length journalsOnDisk)) <> " generated journals in " <> T.pack (show includeGenTime)   return importedJournals  extractAndImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> AbsFile -> IO (AbsFile, FileWasGenerated)@@ -145,16 +163,12 @@       -- Windows PowerShell -File treats construct's literal "-" as an option.       -- Invoke the script with literal strings and propagate its exit status.       let command = "[Console]::OutputEncoding = New-Object Text.UTF8Encoding($false); & "-            <> T.unwords (map literal (T.pack path : args))+            <> T.unwords (map powerShellLiteral (T.pack path : args))             <> "; if (!$?) { if ($LASTEXITCODE) { exit $LASTEXITCODE }; exit 1 }"       return (T.pack shell, ["-NoProfile", "-NonInteractive", "-OutputFormat", "Text", "-Command", command])   | otherwise = return (T.pack path, args)   where     path = Path.toFilePath script-    -- PowerShell also recognises typographic single quotes as delimiters.-    literal s = "'" <> T.concatMap escape s <> "'"-    escape c | c == '\'' || (c >= '\x2018' && c <= '\x201b') = T.replicate 2 (T.singleton c)-             | otherwise = T.singleton c  logNewFileSkip :: RuntimeOptions -> TChan FlowTypes.LogMessage -> T.Text -> AbsFile -> IO () logNewFileSkip opts ch logIdentifier absTarget =@@ -190,7 +204,8 @@       let args = hledgerConfArgs opts ++ ["print", "--explicit"] ++ directivesArgs ++ csvArgs        let cmdLabel = "importing '" <> T.pack relCSV <> "' using rules file '" <> T.pack relRules <> "'"-      ((_, stdOut, _), _) <- timeAndExitOnErr opts ch cmdLabel dummyLogger channelErr (hledger, args, Nothing)+      let hints = ["Check the skip, fields and separator lines in " <> T.pack relRules <> ".", "Docs: " <> docURL "rules-files"]+      ((_, stdOut, _), _) <- timeAndExitOnErr' opts ch cmdLabel [] hints dummyLogger channelErr (hledger, args, Nothing)       T.writeFile (Path.toFilePath journalOut) stdOut     Nothing ->       do@@ -203,26 +218,6 @@                 <> docURL "rules-files"         errExit 1 ch msg () -rulesFileCandidates :: AbsFile -> ImportDirs Path.Abs -> IO [AbsFile]-rulesFileCandidates csv dirs = do-  let bank = importDirLines (bankDir dirs)-      account = importDirLines (accountDir dirs)-  accountRule <- rulesName (bank ++ account)-  bankRule <- rulesName bank-  overrides <- if "rfo" `T.isPrefixOf` suffix-    then do-      name <- rulesName [suffix]-      return [dir Path.</> name | dir <- [accountDir dirs, bankDir dirs, importDir dirs]]-    else return []-  return (overrides ++ [accountDir dirs Path.</> accountRule, importDir dirs Path.</> bankRule])-  where-    stem = dropExtensions (Path.toFilePath (Path.filename csv))-    suffix = snd (T.breakOnEnd "_" (T.pack stem))-    rulesName parts = Path.parseRelFile (T.unpack (T.intercalate "-" parts) <.> "rules")--importDirLines :: Path.Path b Path.Dir -> [T.Text]-importDirLines = T.splitOn "\n" . T.pack . dropTrailingPathSeparator . Path.toFilePath . Path.dirname- hookDirArgs :: ImportDirs b -> [T.Text] hookDirArgs dirs = map (T.concat . importDirLines) [bankDir dirs, accountDir dirs, ownerDir dirs] @@ -252,7 +247,7 @@     Just stdinPipe <- return input     Just stdoutPipe <- return output     hClose stdinPipe-    _ <- timeAndExitOnErr' opts ch cmdLabel [constructCmdText] channelOut channelErr+    _ <- timeAndExitOnErr' opts ch cmdLabel [constructCmdText] [] channelOut channelErr       (hledger, args, Just stdoutPipe)     hClose stdoutPipe     status <- Process.waitForProcess handle

@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} -module Hledger.Flow.Import.ImportHelpers (withStagedOutput, extractImportDirs, groupIncludesUpTo, includeFileName) where+module Hledger.Flow.Import.ImportHelpers (withStagedOutput, extractImportDirs, groupIncludesUpTo, includeFileName, rulesFileCandidates, defaultRulesCandidates, importDirLines) where  import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe)@@ -12,7 +12,9 @@ import Hledger.Flow.PathHelpers (AbsFile, RelDir, RelFile, pathSize) import Path import qualified Path.IO as PathIO-import System.FilePath (dropTrailingPathSeparator)+import Control.Monad.Catch (MonadThrow)+import System.FilePath (dropExtensions, dropTrailingPathSeparator)+import qualified System.FilePath as FilePath  -- Keep hook output on the destination filesystem and publish it only on success. withStagedOutput :: AbsFile -> (AbsFile -> IO ()) -> IO ()@@ -67,3 +69,32 @@ includeFileName f = do   let includeFile = (dropTrailingPathSeparator . toFilePath . dirname . parent) f ++ "-include.journal"   fromMaybe [relfile|unknown-include.journal|] $ parseRelFile includeFile++-- | Rules files for a statement in lookup order: statement-specific overrides,+-- then the account's default rules files.+rulesFileCandidates :: AbsFile -> ImportDirs Abs -> IO [AbsFile]+rulesFileCandidates csv dirs = do+  overrides <- if "rfo" `T.isPrefixOf` suffix+    then do+      name <- rulesName [suffix]+      return [dir </> name | dir <- [accountDir dirs, bankDir dirs, importDir dirs]]+    else return []+  (overrides ++) <$> defaultRulesCandidates dirs+  where+    stem = dropExtensions (toFilePath (filename csv))+    suffix = snd (T.breakOnEnd "_" (T.pack stem))++-- | The account-level and bank-level rules files, in lookup order.+defaultRulesCandidates :: ImportDirs Abs -> IO [AbsFile]+defaultRulesCandidates dirs = do+  let bank = importDirLines (bankDir dirs)+      account = importDirLines (accountDir dirs)+  accountRule <- rulesName (bank ++ account)+  bankRule <- rulesName bank+  return [accountDir dirs </> accountRule, importDir dirs </> bankRule]++rulesName :: MonadThrow m => [T.Text] -> m RelFile+rulesName parts = parseRelFile (T.unpack (T.intercalate "-" parts) FilePath.<.> "rules")++importDirLines :: Path b Dir -> [T.Text]+importDirLines = T.splitOn "\n" . T.pack . dropTrailingPathSeparator . toFilePath . dirname

@@ -5,6 +5,7 @@ module Hledger.Flow.Import.ImportHelpersTurtle   ( extraIncludesForFile,     includePreamble,+    includesNeedUpdate,     toIncludeFiles,     toIncludeLine,     writeIncludesFromInventory,@@ -14,14 +15,14 @@ where  import Control.Concurrent.STM (TChan)-import Control.Monad (unless)+import Control.Monad (filterM, unless) import qualified Data.List as List (isPrefixOf, nub, sort) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.IO as T-import Hledger.Flow.BaseDir (relativeToBase, relativeToBase', turtleBaseDir)-import Hledger.Flow.Common (allYearsFileName, directivesFile, filterPaths, groupValuesBy, writeFiles, writeFiles')+import Hledger.Flow.BaseDir (relativeToBase')+import Hledger.Flow.Common (allYearsFileName, filterPaths, groupValuesBy, textFileNeedsUpdate, writeFiles') import Hledger.Flow.Import.ImportHelpers (groupIncludesUpTo) import Hledger.Flow.Import.Inventory (manualIncludeFiles, managedIncludeFiles) import Hledger.Flow.Import.Types@@ -44,9 +45,14 @@ allYearsPath journal = fst (FilePath.splitFileName journal) </> allYearsFileName  toIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> TurtleFileBundle -> IO (Map.Map FilePath T.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"] ["prices.journal"]+toIncludeFiles opts ch = renderIncludeFiles (baseDir opts) (logVerbose opts ch)++renderIncludeFiles :: BaseDir -> (T.Text -> IO ()) -> TurtleFileBundle -> IO (Map.Map FilePath T.Text)+renderIncludeFiles base logMessage m = do+  let extras suffixes manual prices = Map.unions <$> mapM+        (\file -> findExtraIncludes base logMessage file suffixes manual prices) (Map.keys m)+  preMap <- extras ["opening.journal"] ["pre-import.journal"] []+  postMap <- extras ["closing.journal"] ["post-import.journal"] ["prices.journal"]   return $ (addPreamble . toIncludeFiles' preMap postMap) m  toIncludeFiles' :: TurtleFileBundle -> TurtleFileBundle -> TurtleFileBundle -> Map.Map FilePath T.Text@@ -71,15 +77,27 @@ includePreamble :: T.Text includePreamble = "### Generated by hledger-flow - DO NOT EDIT ###\n" -writeFileMap :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> (TurtleFileBundle, TurtleFileBundle) -> IO [FilePath]-writeFileMap opts ch (m, allYears) = do-  _ <- writeFiles' $ (addPreamble . toIncludeFiles' Map.empty Map.empty) allYears-  writeFiles . (toIncludeFiles opts ch) $ m- writeIncludesFromInventory :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> AbsDir -> [AbsFile] -> [AbsFile] -> IO [AbsFile] writeIncludesFromInventory opts ch stopAt inventory journals = do-  let base = baseDir opts-      importRoot = base Path.</> [Path.reldir|import|]+  (files, roots) <- expectedIncludes (baseDir opts) (logVerbose opts ch) stopAt inventory journals+  _ <- writeFiles' files+  return roots++-- | Check the same contents import would write, including obsolete generated indexes.+includesNeedUpdate :: BaseDir -> AbsDir -> [AbsFile] -> [AbsFile] -> IO Bool+includesNeedUpdate base root inventory journals = do+  (includes, _) <- expectedIncludes base (const (return ())) root inventory journals+  top <- toplevelAllYearsInclude base+  anyChanged (Map.toList (Map.union top includes))+  where+    anyChanged [] = return False+    anyChanged ((file, contents) : rest) = do+      changed <- textFileNeedsUpdate file contents+      if changed then return True else anyChanged rest++expectedIncludes :: BaseDir -> (T.Text -> IO ()) -> AbsDir -> [AbsFile] -> [AbsFile] -> IO (Map.Map FilePath T.Text, [AbsFile])+expectedIncludes base logMessage stopAt inventory journals = do+  let importRoot = base Path.</> [Path.reldir|import|]       journalFiles = filter (isJournalFile . Path.toFilePath) journals   boundary <- Path.stripProperPrefix base stopAt   unless (all (Path.isProperPrefixOf stopAt) journalFiles) $@@ -97,41 +115,36 @@       years = yearsIncludeMap (Map.keys includes)       allAtStop = Path.toFilePath stopAt </> allYearsFileName       indexes = Map.insertWith (++) allAtStop [] years-      current = Map.union includes indexes-  -- Empty obsolete generated indexes as well as removing their parent links:-  -- users can open an account or year ledger directly.-  let old = managedIncludeFiles importRoot (filter (Path.isProperPrefixOf stopAt) inventory)-  mapM_ (clearObsolete current) old-  _ <- writeFileMap opts ch (includes, indexes)-  return [base Path.</> f | f <- Map.keys groups, Path.parent f == boundary]+      old = managedIncludeFiles importRoot (filter (Path.isProperPrefixOf stopAt) inventory)+  rendered <- renderIncludeFiles base logMessage includes+  let current = Map.union rendered ((addPreamble . toIncludeFiles' Map.empty Map.empty) indexes)+      emptyIndex = includePreamble <> "\n"+  -- Users may still open obsolete generated indexes directly. Leave hand-written files alone.+  obsolete <- filterM (needsClearing emptyIndex) [file | file <- map Path.toFilePath old, Map.notMember file current]+  let files = Map.union current (Map.fromList [(file, emptyIndex) | file <- obsolete])+  return (files, [base Path.</> f | f <- Map.keys groups, Path.parent f == boundary])   where-    clearObsolete current file = unless (Map.member (Path.toFilePath file) current) $ do-      contents <- T.readFile (Path.toFilePath file)-      if includePreamble `T.isPrefixOf` contents-        then do-          _ <- writeFiles' (Map.singleton (Path.toFilePath file) (includePreamble <> "\n"))-          return ()-        else return ()+    needsClearing emptyIndex file = do+      text <- T.readFile file+      return (includePreamble `T.isPrefixOf` text && text /= emptyIndex)  writeToplevelAllYearsInclude :: (HasBaseDir o, HasVerbosity o) => o -> IO [FilePath]-writeToplevelAllYearsInclude opts = do-  let directives = directivesFile opts-  directivesExists <- PathIO.doesFileExist directives-  let preMap = if directivesExists then Map.singleton (turtleBaseDir opts </> allYearsFileName) [Path.toFilePath directives] else Map.empty-  let allTop = Map.singleton (turtleBaseDir opts </> allYearsFileName) ["import" </> allYearsFileName]-  writeFiles' $ (addPreamble . toIncludeFiles' preMap Map.empty) allTop--extraIncludes :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [FilePath] -> [T.Text] -> [FilePath] -> [FilePath] -> IO TurtleFileBundle-extraIncludes opts ch = extraIncludes' opts ch Map.empty+writeToplevelAllYearsInclude opts = toplevelAllYearsInclude (baseDir opts) >>= writeFiles' -extraIncludes' :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> TurtleFileBundle -> [FilePath] -> [T.Text] -> [FilePath] -> [FilePath] -> IO TurtleFileBundle-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+toplevelAllYearsInclude :: BaseDir -> IO (Map.Map FilePath T.Text)+toplevelAllYearsInclude base = do+  let directives = base Path.</> [Path.relfile|directives.journal|]+      top = Path.toFilePath base </> allYearsFileName+  directivesExists <- PathIO.doesFileExist directives+  let preMap = if directivesExists then Map.singleton top [Path.toFilePath directives] else Map.empty+      allTop = Map.singleton top ["import" </> allYearsFileName]+  return $ (addPreamble . toIncludeFiles' preMap Map.empty) allTop  extraIncludesForFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> FilePath -> [T.Text] -> [FilePath] -> [FilePath] -> IO TurtleFileBundle-extraIncludesForFile opts ch file extraSuffixes manualFiles prices = do+extraIncludesForFile opts ch = findExtraIncludes (baseDir opts) (logVerbose opts ch)++findExtraIncludes :: BaseDir -> (T.Text -> IO ()) -> FilePath -> [T.Text] -> [FilePath] -> [FilePath] -> IO TurtleFileBundle+findExtraIncludes base logMessage file extraSuffixes manualFiles prices = do   let name = FilePath.takeFileName file       stem = if "." `List.isPrefixOf` name then name else FilePath.dropExtensions name       dirprefix = takeWhile (/= '-') stem@@ -141,14 +154,12 @@   let priceFiles = map ((((FilePath.takeDirectory file </> "..") </> "prices") </> dirprefix) </>) prices   let extraFiles = suffixFiles ++ suffixDirFiles ++ priceFiles   filtered <- filterPaths doesFileExist extraFiles-  let logMsg =-        "Looking for possible extra include files for '" <> T.pack (relativeToBase opts file)+  let relative = relativeToBase' (Path.toFilePath base)+      logMsg =+        "Looking for possible extra include files for '" <> T.pack (relative file)           <> "' among these " <> T.pack (show (length extraFiles)) <> " options: "-          <> T.pack (show (relativeFilesAsText opts extraFiles))+          <> T.pack (show (map (T.pack . relative) extraFiles))           <> ". Found " <> T.pack (show (length filtered)) <> ": "-          <> T.pack (show (relativeFilesAsText opts filtered))-  logVerbose opts ch logMsg+          <> T.pack (show (map (T.pack . relative) filtered))+  logMessage logMsg   return $ Map.fromList [(file, filtered)]--relativeFilesAsText :: (HasBaseDir o) => o -> [FilePath] -> [T.Text]-relativeFilesAsText opts = map (T.pack . relativeToBase opts)

@@ -8,9 +8,11 @@     inImportScope,     generatedOutput,     expectedOutputs,+    classifyGeneratedOutputs,     conflictingOutputs,     canonicalFile,     manualIncludeFiles,+    isManualJournal,     managedIncludeFiles,     moveToTrash,   )@@ -73,6 +75,19 @@     return (key, [source])   return (Map.fromListWith (++) canonical) +-- | Orphaned generated files and the source-backed journals to include.+classifyGeneratedOutputs :: AbsDir -> [AbsFile] -> [AbsFile] -> IO ([AbsFile], [AbsFile])+classifyGeneratedOutputs root inventory sources = do+  expected <- expectedOutputs sources+  let staged stage ext = filter ((== ext) . FilePath.takeExtension . toFilePath) (stageFiles root stage inventory)+      cached = staged [reldir|2-preprocessed|] ".csv"+      journals = staged [reldir|3-journal|] ".journal"+  classified <- forM (cached ++ journals) $ \file -> do+    key <- canonicalFile file+    return (file, Map.member key expected)+  return ([file | (file, False) <- classified],+          [file | (file, True) <- classified, FilePath.takeExtension (toFilePath file) == ".journal"])+ canonicalFile :: AbsFile -> IO AbsFile canonicalFile file = Directory.canonicalizePath (toFilePath file) >>= parseAbsFile @@ -111,17 +126,20 @@ -- Seed the include at the manual file's own level; its contents are added by -- the existing pre/post renderer, keeping ordering and avoiding duplicates. manualIncludeFiles :: AbsDir -> [AbsFile] -> IO [AbsFile]-manualIncludeFiles root files = Set.toAscList . Set.fromList <$> mapM includePath (filter supported files)+manualIncludeFiles root files = Set.toAscList . Set.fromList <$> mapM includePath (filter (isManualJournal root) files)   where-    supported file = case reverse (relativeParts root file) of-      name : year : "_manual_" : ancestors ->-        length ancestors <= 3 && isYear year-          && name `elem` ["pre-import.journal", "post-import.journal"]-      _ -> False     includePath file = do       let year = FilePath.dropTrailingPathSeparator (toFilePath (dirname (parent file)))       name <- parseRelFile (year ++ "-include.journal")       return (parent (parent (parent file)) </> name)++-- | A @_manual_@ pre- or post-import journal that import includes.+isManualJournal :: AbsDir -> AbsFile -> Bool+isManualJournal root file = case reverse (relativeParts root file) of+  name : year : "_manual_" : ancestors ->+    length ancestors <= 3 && isYear year+      && name `elem` ["pre-import.journal", "post-import.journal"]+  _ -> False  managedIncludeFiles :: AbsDir -> [AbsFile] -> [AbsFile] managedIncludeFiles root = filter supported

@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++-- | Start a new ledger.+module Hledger.Flow.Init+  ( InitOutcome (..),+    initLedger,+    runInit,+  )+where++import Control.Exception (IOException, catch)+import Control.Monad (when)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import Hledger.Flow.BaseDir (findBaseDir)+import Hledger.Flow.Common (Shell (..), nativeShell, shellArgument)+import Hledger.Flow.PathHelpers (AbsDir)+import Hledger.Flow.Status.Render (printNext, tildePath)+import Hledger.Flow.Types (BaseDir)+import Path+import Path.IO (createDirIfMissing, doesDirExist, getHomeDir)+import qualified System.FilePath as FilePath++data InitOutcome+  = -- | The new ledger, and an unrelated ledger above it, if any.+    Created BaseDir (Maybe BaseDir)+  | -- | The folder already has @import/@.+    AlreadyLedger BaseDir+  | -- | The folder is inside this ledger's @import/@ tree.+    InsideLedger BaseDir+  deriving (Eq, Show)++-- | Create @DIR/import/@ unless that would nest inside another ledger.+initLedger :: AbsDir -> IO InitOutcome+initLedger dir = do+  hasImport <- doesDirExist (dir </> [reldir|import|])+  if hasImport+    then return (AlreadyLedger dir)+    else do+      above <- findBaseDir dir+      case above of+        Just b | let imp = b </> [reldir|import|], imp == dir || imp `isProperPrefixOf` dir -> return (InsideLedger b)+        _ -> do+          createDirIfMissing True (dir </> [reldir|import|])+          return (Created dir above)++-- | Run @hledger-flow init@ for a folder, printing what happened and what's next.+runInit :: Maybe FilePath -> AbsDir -> AbsDir -> IO ()+runInit hledgerPath cwd dir = do+  home <- (Just <$> getHomeDir) `catch` (\e -> const (return Nothing) (e :: IOException))+  let absolute = T.pack . FilePath.dropTrailingPathSeparator . toFilePath+      shown = T.pack . tildePath home . T.unpack . absolute+  outcome <- initLedger dir+  case outcome of+    AlreadyLedger b ->+      ioError . userError . T.unpack $+        shown b <> " is already a hledger-flow ledger. Run `hledger-flow status` there to see where it stands."+    InsideLedger b ->+      ioError . userError . T.unpack $+        "That folder is inside the ledger at " <> shown b <> ". Start a new ledger outside its import/ folder."+    Created base parentLedger -> do+      T.putStrLn ("Started a ledger in " <> shown base)+      mapM_ (\p -> T.putStrLn ("Note: " <> shown p <> " also has an import/ folder. Commands run inside " <> shown base <> " use the new ledger.")) parentLedger+      when (base /= cwd) $ do+        let changeDir = case nativeShell of+              Posix -> "cd "+              PowerShell -> "Set-Location -LiteralPath "+        T.putStrLn ("Change to it first: " <> changeDir <> shellArgument nativeShell (absolute base))+      printNext hledgerPath base

@@ -36,6 +36,10 @@         ++ $(gitHash)     ) +-- | The git commit this binary was built from, abbreviated; @UNKNOWN@ outside git.+gitCommit :: String+gitCommit = take 7 $(gitHash)+ systemInfo :: IO SystemInfo systemInfo = do   processors <- getNumProcessors

@@ -9,6 +9,7 @@ import qualified Data.Text.IO as T import Data.Time.LocalTime (getZonedTime) import qualified GHC.IO.Handle.FD as H+import System.IO (hFlush) import Hledger.Flow.Types  dummyLogger :: TChan LogMessage -> T.Text -> IO ()@@ -51,6 +52,8 @@   case logMsg of     StdOut msg -> do       T.hPutStr H.stdout msg+      -- Keep stdout and stderr lines in the order they were logged.+      hFlush H.stdout       consoleChannelLoop ch     StdErr msg -> do       T.hPutStr H.stderr msg

@@ -24,12 +24,13 @@  instance Show PathException where   show (MissingBaseDir d) =-    "Unable to find an import directory at "-      ++ show d-      ++ " (or in any of its parent directories).\n\n"-      ++ "Have a look at the documentation for more information:\n"+    "No hledger-flow ledger here or in any parent folder (looked from "+      ++ Path.toFilePath d+      ++ ").\n"+      ++ "Run `hledger-flow init` to start one here, or pass the ledger's folder as an argument.\n"+      ++ "Docs: "       ++ T.unpack (docURL "getting-started")-  show (InvalidTurtleDir d) = "Expected a directory but got this instead: " ++ d+  show (InvalidTurtleDir d) = "Not a folder: " ++ d  instance Exception PathException 

@@ -0,0 +1,128 @@+{-# LANGUAGE OverloadedStrings #-}++module Hledger.Flow.ReleaseNotice+  ( withReleaseNotice, startCheck, finishCommand, checkRelease+  ) where++import Control.Concurrent.Async (async, poll)+import Control.Exception (catch, evaluate, throwIO, try)+import Control.Monad (guard, join)+import Data.Aeson (decode, decodeFileStrict, withObject, (.:), (.:?), (.!=))+import Data.Aeson.Types (parseMaybe)+import qualified Data.ByteString.Lazy as BL+import Data.Char (isDigit)+import Data.Maybe (fromMaybe, listToMaybe)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.IO as T+import Data.Version (Version, parseVersion, showVersion)+import Network.HTTP.Client (HttpException, checkResponse, httpLbs, parseRequest, requestHeaders, responseBody, throwErrorStatusCodes)+import Network.HTTP.Client.TLS (getGlobalManager)+import Paths_hledger_flow (version)+import System.Directory (canonicalizePath)+import System.Environment (getExecutablePath, lookupEnv)+import System.Exit (ExitCode)+import System.FilePath ((</>), takeDirectory, takeFileName)+import System.IO (hIsTerminalDevice, stderr, stdout)+import System.IO.Error (catchIOError)+import System.Timeout (timeout)+import Text.ParserCombinators.ReadP (eof, readP_to_S)++withReleaseNotice :: IO () -> IO ()+withReleaseNotice command = do+  finish <- setup `catchIOError` const (pure (pure ()))+  finishCommand finish command+  where+    setup = do+      disabled <- lookupEnv "HLEDGER_FLOW_NO_UPDATE_CHECK"+      outTTY <- hIsTerminalDevice stdout+      errTTY <- hIsTerminalDevice stderr+      if disabled /= Just "1" && outTTY && errTTY+        then startCheck (checkRelease fetch getExecutablePath)+        else pure (pure ())++-- The worker belongs to this CLI invocation. Do not join it or synchronously+-- cancel it on exit: either would put network cleanup on the command's path.+startCheck :: IO (Maybe T.Text) -> IO (IO ())+startCheck check = do+  worker <- async $ do+    notice <- check+    traverse evaluate notice+  pure $ do+    result <- poll worker+    case result of+      Just (Right (Just notice)) -> T.hPutStrLn stderr notice+      _ -> pure ()++-- The caller has already rendered ordinary errors as diagnostics + ExitCode.+-- Catch just ExitCode here so that interrupts skip the notice altogether.+finishCommand :: IO () -> IO () -> IO ()+finishCommand finish command = do+  outcome <- try command :: IO (Either ExitCode ())+  finish `catchIOError` const (pure ())+  either throwIO pure outcome++fetch :: String -> IO (Maybe BL.ByteString)+fetch url = request `catch` ignoreHttpError+  where+    request = do+      manager <- getGlobalManager+      req <- parseRequest url+      let githubRequest = req { requestHeaders = [("User-Agent", "hledger-flow")]+                              , checkResponse = throwErrorStatusCodes }+      response <- httpLbs githubRequest manager+      pure (Just (responseBody response))+    ignoreHttpError :: HttpException -> IO (Maybe BL.ByteString)+    ignoreHttpError _ = pure Nothing++checkRelease :: (String -> IO (Maybe BL.ByteString)) -> IO FilePath -> IO (Maybe T.Text)+checkRelease get executable = do+  result <- timeout 3000000 (get "https://api.github.com/repos/apauley/hledger-flow/releases/latest")+  case join result >>= releaseVersion of+    Just latest | latest > version -> do+      confirmed <- timeout 1000000 (homebrewOffers latest `catchIOError` const (pure False))+      let advice = if confirmed == Just True+            then "Upgrade with: brew update && brew upgrade ferntrail/tap/hledger-flow"+            else "https://github.com/apauley/hledger-flow/releases/latest"+      pure $ Just $ "hledger-flow " <> render latest <> " is available (installed "+                 <> render version <> ").\n" <> advice+    _ -> pure Nothing+  where+    render = T.pack . showVersion+    homebrewOffers latest = do+      path <- executable >>= canonicalizePath+      owned <- ownsHomebrewBinary path+      if owned then do+        formula <- get "https://raw.githubusercontent.com/FernTrail/homebrew-tap/main/Formula/hledger-flow.rb"+        let tagLine = "tag = \"v" <> render latest <> "\""+        pure $ fromMaybe False $ do+          body <- formula+          contents <- either (const Nothing) Just (T.decodeUtf8' (BL.toStrict body))+          pure $ tagLine `elem` map T.strip (T.lines contents)+      else pure False++releaseVersion :: BL.ByteString -> Maybe Version+releaseVersion bytes = do+  value <- decode bytes+  tag <- parseMaybe (withObject "release" $ \o -> do+    draft <- o .:? "draft" .!= False+    prerelease <- o .:? "prerelease" .!= False+    guard (not draft && not prerelease)+    o .: "tag_name") value+  number <- T.stripPrefix "v" tag+  guard (T.all (\c -> isDigit c || c == '.') number)+  listToMaybe [v | (v, "") <- readP_to_S (parseVersion <* eof) (T.unpack number)]++ownsHomebrewBinary :: FilePath -> IO Bool+ownsHomebrewBinary path+  | map takeFileName [path, bin, rack, takeDirectory rack] /=+      ["hledger-flow", "bin", "hledger-flow", "Cellar"] = pure False+  | otherwise = do+      receipt <- decodeFileStrict (keg </> "INSTALL_RECEIPT.json")+      let tap = receipt >>= parseMaybe (withObject "receipt" $ \o ->+                  o .: "source" >>= withObject "source" (.: "tap"))+      pure $ fmap T.toCaseFold tap == Just "ferntrail/tap"+  where+    bin = takeDirectory path+    keg = takeDirectory bin+    rack = takeDirectory keg

@@ -11,20 +11,20 @@ import Data.Char (toLower) import Data.Either import qualified Data.List as List-import Data.Maybe import qualified Data.Text as T import qualified Data.Text.IO as T import Hledger.Flow.DateTime (timeAction)+import Hledger.Flow.Environment (renderSettings, reportSettings) import Hledger.Flow.BaseDir (relativeToBase) import Hledger.Flow.Common import Hledger.Flow.Logging import Hledger.Flow.PathHelpers (AbsDir, AbsFile, RelDir, RelFile) import Hledger.Flow.RuntimeOptions+import Hledger.Flow.Status (plural) import qualified Hledger.Flow.Types as FlowTypes import Path ((</>), parent, reldir, relfile, parseRelDir, toFilePath) import qualified Path.IO as PathIO import qualified System.Directory as Directory-import System.Environment (lookupEnv) import Prelude hiding (putStrLn, readFile, writeFile)  data ReportParams = ReportParams@@ -38,24 +38,24 @@  generateReports :: RuntimeOptions -> IO () generateReports opts = withConsoleLogging $ \ch -> do-  when (showOptions opts) $ channelOutLn ch (T.pack (show opts))+  when (showOptions opts) $ channelOutLn ch (T.unlines (renderSettings id (reportSettings opts)))   (reports, diff) <- timeAction $ generateReports' opts ch-  let failedAttempts = lefts reports-  let failedText = if List.null failedAttempts then "" else "(and attempted to write " <> T.pack (show (length failedAttempts)) <> " more) "-  channelOutLn ch $ "Generated " <> T.pack (show (length (rights reports))) <> " reports " <> failedText <> "in " <> T.pack (show diff)+  let skipped = length (lefts reports)+      skippedText = if skipped == 0 then "" else " Skipped " <> plural skipped "empty report" <> "."+  channelOutLn ch $ "Generated " <> plural (length (rights reports)) "report" <> " in reports/." <> skippedText+  channelOutLn ch "Each report starts with the hledger command that made it. Copy that line to tailor the report."+  logVerbose opts ch ("Reports took " <> T.pack (show diff))  generateReports' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> IO [Either AbsFile AbsFile] generateReports' opts ch = do-  let wipMsg =-        "These reports can be used as a starting point for more tailored reports.\n"-          <> "The first line of each report contains the command used - change the parameters and use it in your own reports.\n"-  channelOutLn ch wipMsg   owners <- listOwners opts-  ledgerEnvValue <- lookupEnv "LEDGER_FILE"-  let hledgerJournal = fromMaybe (toFilePath (baseDir opts </> [relfile|all-years.journal|])) ledgerEnvValue+  configured <- configuredLedgerFile+  let hledgerJournal = maybe (toFilePath (baseDir opts </> [relfile|all-years.journal|])) snd configured   hledgerJournalExists <- Directory.doesFileExist hledgerJournal-  unless hledgerJournalExists $ ioError $ userError $-    "Unable to find journal file: " ++ hledgerJournal ++ "\nIs your LEDGER_FILE environment variable set correctly?"+  unless hledgerJournalExists $ ioError $ userError $ case configured of+    Just (v, _) -> "LEDGER_FILE is set to " ++ v ++ ", which doesn't exist. Point it at "+      ++ toFilePath (baseDir opts </> [relfile|all-years.journal|]) ++ ", or unset it."+    Nothing -> "No all-years.journal in " ++ toFilePath (baseDir opts) ++ " yet. Run `hledger-flow import` first."   let journalWithYears = baseDir opts </> [relfile|import/all-years.journal|]   let aggregateReportDir         | any ((== toFilePath [reldir|all|]) . map toLower . toFilePath) owners = baseDir opts </> [reldir|reports/_all_|]@@ -124,14 +124,14 @@   let reportDisplayArgs = confArgs ++ fileArgs relativeJournals ++ periodArgs ++ args   let hledger = T.pack (toFilePath (FlowTypes.hlPath (hledgerInfo opts)))   let cmdLabel = "hledger " <> showCmdArgs reportDisplayArgs-  ((exitCode, stdOut, _), _) <- timeAndExitOnErr opts ch cmdLabel dummyLogger channelErr (hledger, reportArgs, Nothing)+  ((_, stdOut, _), _) <- timeAndExitOnErr opts ch cmdLabel dummyLogger channelErr (hledger, reportArgs, Nothing)   if (successCheck stdOut)     then do       T.writeFile (toFilePath outputFile) (cmdLabel <> "\n\n" <> stdOut)       logVerbose opts ch $ "Wrote " <> T.pack relativeOutputFile       return $ Right outputFile     else do-      channelErrLn ch $ "Did not write '" <> T.pack relativeOutputFile <> "' (" <> cmdLabel <> ") " <> T.pack (show exitCode)+      logVerbose opts ch $ "Skipped empty report " <> T.pack relativeOutputFile       exists <- PathIO.doesFileExist outputFile       when exists (PathIO.removeFile outputFile)       return $ Left outputFile

@@ -0,0 +1,154 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++-- | A starter hledger rules file built from a statement's header row.+module Hledger.Flow.RulesTemplate+  ( splitHeader,+    looksLikeHeader,+    templateFields,+    rulesTemplate,+    rulesTemplateFor,+  )+where++import Data.Char (isAlphaNum, isDigit, toLower)+import qualified Data.List as List+import Data.Maybe (fromMaybe)+import qualified Data.Text as T+import Hledger.Flow.BaseDir (relativeToBase')+import Hledger.Flow.DocHelpers (docURL)+import Hledger.Flow.Import.Inventory (findImportFiles, stageFiles)+import Hledger.Flow.Status.Gather (accountName, cachedStatement)+import Hledger.Flow.Types (BaseDir)+import Path+import qualified System.FilePath as FilePath+import System.IO (IOMode (ReadMode), hIsEOF, hSetEncoding, mkTextEncoding, withFile)+import qualified Data.Text.IO as T++-- | The separator and the column names of a header line. Strips a UTF-8 BOM,+-- surrounding quotes and spaces.+-- ponytail: a quoted name containing the separator is split; use a CSV parser if that bites.+splitHeader :: T.Text -> (Char, [T.Text])+splitHeader line = (sep, map clean (T.splitOn (T.singleton sep) l))+  where+    l = T.dropWhileEnd (== '\r') (T.dropWhile (== '\xFEFF') line)+    count c = T.count (T.singleton c) l+    sep = List.foldl' (\best c -> if count c > count best then c else best) ',' [';', '\t']+    clean = T.strip . unquote . T.strip+    unquote t+      | T.length t >= 2 && T.head t == '"' && T.last t == '"' = T.init (T.tail t)+      | otherwise = t++-- | False when any column looks like a date or an amount.+looksLikeHeader :: [T.Text] -> Bool+looksLikeHeader = not . any dataish+  where+    dataish f = not (T.null f) && T.all (`elem` ("0123456789-/.:,+$€£ " :: String)) f++-- | hledger field names for the columns: obvious date, description and amount+-- columns are named for hledger; the rest keep a normalised version of their name.+templateFields :: [T.Text] -> [T.Text]+templateFields names = dedupe (zipWith pick [0 ..] normalised)+  where+    normalised = zipWith normalise [1 :: Int ..] names+    normalise i n =+      let t = T.intercalate "_" (filter (not . T.null) (T.splitOn "_" (T.map (\c -> if isAlphaNum c then toLower c else '_') n)))+       in if T.null t then "field" <> T.pack (show i) else t+    indexed = zip [0 :: Int ..] normalised+    dateIx = fst <$> List.find (("date" `T.isInfixOf`) . snd) indexed+    descIx = fst <$> List.find (\(i, n) -> Just i /= dateIx && any (`T.isInfixOf` n) ["desc", "payee", "narrat", "detail"]) indexed+    amountIx = case [i | (i, n) <- indexed, "amount" `T.isInfixOf` n, Just i /= dateIx, Just i /= descIx] of+      [i] -> Just i+      _ -> fst <$> List.find ((== "amount") . snd) indexed+    pick i n+      | Just i == dateIx = "date"+      | Just i == descIx = "description"+      | Just i == amountIx = "amount"+      | isSpecialField n = "bank_" <> n+      | otherwise = n+    dedupe = go []+      where+        go _ [] = []+        go seen (n : rest) =+          let k = length (filter (== n) seen)+           in (if k == 0 then n else n <> "_" <> T.pack (show (k + 1))) : go (n : seen) rest++-- | Names hledger gives a meaning of its own, such as balance (assertions) or status.+isSpecialField :: T.Text -> Bool+isSpecialField n =+  n `elem` ["status", "code", "comment", "balance", "currency", "date2", "account", "amount", "date", "description"]+    || (T.dropWhileEnd isDigit n `elem` ["account", "amount", "balance", "comment", "currency"] && T.any isDigit n)++notCsv :: FilePath -> T.Text+notCsv path =+  T.pack path <> " isn't a CSV file, so there's no header row to build rules from. "+    <> "A preprocess script can convert it to CSV first: "+    <> docURL "the-preprocess-script"++-- | The starter rules file for a statement, from its contents.+rulesTemplate :: T.Text -> T.Text -> FilePath -> T.Text -> Either T.Text T.Text+rulesTemplate bank account path contents+  | map toLower (FilePath.takeExtension path) `notElem` [".csv", ".tsv", ".ssv"] = Left (notCsv path)+  | T.null (T.strip line) || not (looksLikeHeader names) =+      Left ("The first line of " <> T.pack path <> " looks like data, not column names. Write the fields line yourself: " <> docURL "rules-files")+  | otherwise =+      Right . T.unlines $+        [ "# Starter rules for " <> bank <> "/" <> account <> ", made by hledger-flow from the header row of",+          "# " <> T.pack path <> ". Check every line, then run: hledger-flow import",+          "# hledger's CSV rules reference: https://hledger.org/hledger.html#csv",+          "",+          "skip 1"+        ]+          ++ ["separator " <> (if sep == '\t' then "TAB" else T.singleton sep) | sep /= ',']+          ++ [ "fields " <> T.intercalate ", " fields,+               ""+             ]+          ++ [ "# Columns prefixed with bank_ would otherwise mean something to hledger.\n"+                 <> "# For example, rename bank_balance to balance to check balance assertions.\n"+               | any (\f -> maybe False isSpecialField (T.stripPrefix "bank_" f)) fields+             ]+          ++ [+               "# Make the date format match your statement, e.g. %d/%m/%Y",+               "# date-format %Y-%m-%d",+               "",+               "# Separate debit and credit columns? Name them amount-out and amount-in",+               "# in the fields line instead of amount.",+               "",+               "account1 assets:" <> bank <> ":" <> account,+               "account2 expenses:unknown"+             ]+  where+    line = T.takeWhile (/= '\n') contents+    (sep, names) = splitHeader line+    fields = templateFields names++-- | The starter rules file for an account (@owner/bank/account@), from its newest statement.+rulesTemplateFor :: BaseDir -> T.Text -> IO (Either T.Text T.Text)+rulesTemplateFor base requested = do+  let account = T.dropWhileEnd (== '/') (maybe requested id (T.stripPrefix "import/" requested))+      root = base </> [reldir|import|]+  files <- findImportFiles root+  let inputs = stageFiles root [reldir|1-in|] files+      statements = filter ((== account) . accountName root) inputs+      known = List.nub (map (accountName root) inputs)+  case reverse statements of+    [] ->+      return . Left $+        "No statements found for " <> account <> ". Accounts with statements: "+          <> (if null known then "none" else T.intercalate ", " known) <> "."+    newest : _ -> do+      source <- fromMaybe newest <$> cachedStatement newest+      let path = relativeToBase' (toFilePath base) (toFilePath source)+          isCsv = map toLower (FilePath.takeExtension path) `elem` [".csv", ".tsv", ".ssv"]+          (bank, acct) = case T.splitOn "/" account of+            [_, b, a] -> (b, a)+            _ -> (account, account)+      header <- if isCsv then firstLine (toFilePath source) else return ""+      return (rulesTemplate bank acct path header)++-- | The first line of a file, tolerating encodings other than UTF-8.+firstLine :: FilePath -> IO T.Text+firstLine path = withFile path ReadMode $ \h -> do+  hSetEncoding h =<< mkTextEncoding "UTF-8//ROUNDTRIP"+  eof <- hIsEOF h+  if eof then return "" else T.hGetLine h

@@ -0,0 +1,173 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++-- | What a ledger contains, and the one thing to do next.+module Hledger.Flow.Status+  ( Situation (..),+    LedgerFile (..),+    AccountStatus (..),+    Misplaced (..),+    LedgerStatus (..),+    NextStep (..),+    statementExtensions,+    suggestPlacement,+    misplacedFiles,+    nextStep,+    hledgerVersionNumber,+    plural,+  )+where++import Data.Char (isDigit, toLower)+import Data.Maybe (mapMaybe)+import qualified Data.Set as Set+import qualified Data.Text as T+import Hledger.Flow.Common (Shell (..), posixLiteral, powerShellLiteral, shellArgument)+import Hledger.Flow.DocHelpers (docURL)+import Hledger.Flow.Import.Inventory (stageFiles)+import Hledger.Flow.PathHelpers (AbsDir, AbsFile)+import Hledger.Flow.Types (BaseDir, HledgerInfo)+import Path (reldir, relfile, stripProperPrefix, toFilePath, (</>))+import qualified System.FilePath as FilePath++data Situation = InLedger BaseDir | EmptyDir | Elsewhere deriving (Eq, Show)++data LedgerFile = LedgerFile {lfValue :: FilePath, lfExists :: Bool} deriving (Eq, Show)++data AccountStatus = AccountStatus+  { asAccount :: T.Text,+    asStatements :: Int,+    asYears :: [Integer],+    asRulesFile :: Maybe FilePath,+    asRulesCandidates :: [FilePath],+    asWithoutRules :: Int,+    asPreprocess :: Bool,+    asConstruct :: Bool,+    asJournalsMissing :: Int,+    asJournalsOutdated :: Int+  }+  deriving (Eq, Show)++-- | Both paths are relative to the base directory and start with @import@.+data Misplaced = Misplaced {mpPath :: FilePath, mpSuggestion :: FilePath} deriving (Eq, Show)++data LedgerStatus = LedgerStatus+  { lsBaseDir :: BaseDir,+    lsHledger :: Maybe HledgerInfo,+    lsLedgerFile :: Maybe LedgerFile,+    lsAccounts :: [AccountStatus],+    lsMisplaced :: [Misplaced],+    lsManualJournals :: Int,+    lsAllYearsExists :: Bool,+    lsNeedsReconciliation :: Bool+  }+  deriving (Show)++data NextStep = NextStep+  { nsSummary :: T.Text,+    nsCommand :: Maybe T.Text,+    nsDetail :: [T.Text],+    nsDocs :: Maybe T.Text+  }+  deriving (Eq, Show)++statementExtensions :: [String]+statementExtensions = ["csv", "tsv", "ssv", "ofx", "qfx", "qif", "xls", "xlsx"]++isYear :: String -> Bool+isYear s = length s == 4 && all isDigit s++-- | Where a file found at these path components (below @import/@) belongs.+suggestPlacement :: [FilePath] -> FilePath+suggestPlacement parts = FilePath.joinPath (["import"] ++ identity ++ ["1-in", year, file])+  where+    dirs = if null parts then [] else init parts+    file = if null parts then "" else last parts+    year = case filter isYear dirs of+      y : _ -> y+      [] -> "<year>"+    stages = ["1-in", "2-preprocessed", "3-journal"]+    named = take 3 (takeWhile (\d -> d `notElem` stages && not (isYear d)) dirs)+    identity = named ++ drop (length named) ["<owner>", "<bank>", "<account>"]++-- | Statement-like files under the import root that import will never read.+misplacedFiles :: AbsDir -> [AbsFile] -> [Misplaced]+misplacedFiles root files = mapMaybe misplaced (filter candidate files)+  where+    staged = Set.fromList (stageFiles root [reldir|1-in|] files ++ cachedCSVs)+    cachedCSVs = filter ((== ".csv") . FilePath.takeExtension . toFilePath) (stageFiles root [reldir|2-preprocessed|] files)+    candidate f = extension f `elem` statementExtensions && Set.notMember f staged+    extension = map toLower . drop 1 . FilePath.takeExtension . toFilePath+    misplaced f = do+      rel <- stripProperPrefix root f+      let parts = FilePath.splitDirectories (toFilePath rel)+      return (Misplaced (FilePath.joinPath ("import" : parts)) (suggestPlacement parts))++plural :: Int -> T.Text -> T.Text+plural 1 noun = "1 " <> noun+plural n noun = T.pack (show n) <> " " <> noun <> "s"++-- | The single most important next step. The first matching rule wins.+nextStep :: Integer -> Shell -> AbsDir -> LedgerStatus -> NextStep+nextStep year shell cwd s+  | Nothing <- lsHledger s =+      NextStep "Install hledger, or pass its location with --hledger-path" Nothing [] (Just "https://hledger.org/install.html")+  | statements == 0 && null (lsMisplaced s) && lsManualJournals s == 0 && not (lsNeedsReconciliation s) =+      NextStep+        "Put your first statement in import/<owner>/<bank>/<account>/1-in/<year>/"+        Nothing+        [ "For example: import/me/mybank/checking/1-in/" <> T.pack (show year) <> "/statement.csv",+          "Then check with: " <> command "status"+        ]+        (Just (docURL "input-files"))+  | not (null (lsMisplaced s)) =+      NextStep+        ("Move " <> plural (length (lsMisplaced s)) "file" <> " to where hledger-flow looks")+        Nothing+        [T.pack (mpPath m) <> " → " <> T.pack (mpSuggestion m) | m <- lsMisplaced s]+        (Just (docURL "input-files"))+  | a : _ <- filter needsRules (lsAccounts s) =+      NextStep+        ("Create " <> T.pack (firstCandidate a) <> " (rules for " <> asAccount a <> ")")+        (Just (command "status" <> " --rules-template " <> shellArgument shell (asAccount a)))+        ["Save its output as that file, then edit it."]+        (Just (docURL "rules-files"))+  | toImport > 0 =+      NextStep ("Import " <> plural toImport "new or changed statement") (Just importCommand) [] Nothing+  | not (lsAllYearsExists s) =+      NextStep "Run import to create all-years.journal" (Just importCommand) [] Nothing+  | lsNeedsReconciliation s =+      NextStep "Run import to reconcile generated files and journal includes" (Just importCommand) [] Nothing+  | maybe True (not . lfExists) (lsLedgerFile s) =+      NextStep+        "Point LEDGER_FILE at this ledger so hledger finds it"+        (Just exportLine)+        [ "LEDGER_FILE is set to " <> T.pack (lfValue lf) <> ", which doesn't exist."+          | Just lf <- [lsLedgerFile s]+        ]+        (Just "https://github.com/apauley/hledger-flow/blob/master/QUICKSTART.md#import-your-first-statement")+  | otherwise =+      NextStep "Generate reports, or explore with hledger" (Just (command "report")) ["Or try: hledger balance"] Nothing+  where+    command subcommand = "hledger-flow " <> subcommand <> baseArgument+    baseArgument+      | cwd == lsBaseDir s = ""+      | otherwise = " " <> shellArgument shell (T.pack (FilePath.dropTrailingPathSeparator (toFilePath (lsBaseDir s))))+    importCommand = command "import"+    statements = sum (map asStatements (lsAccounts s))+    toImport = sum [asJournalsMissing a + asJournalsOutdated a | a <- lsAccounts s]+    needsRules a = asWithoutRules a > 0 && not (asConstruct a)+    firstCandidate a = case asRulesCandidates a of+      c : _ | cwd /= lsBaseDir s -> toFilePath (lsBaseDir s) FilePath.</> c+            | otherwise -> c+      [] -> "a rules file"+    allYears = T.pack (toFilePath (lsBaseDir s </> [relfile|all-years.journal|]))+    exportLine = case shell of+      Posix -> "export LEDGER_FILE=" <> posixLiteral allYears+      PowerShell -> "$env:LEDGER_FILE = " <> powerShellLiteral allYears++-- | @"hledger 1.50.2, mac-aarch64"@ → @"1.50.2"@.+hledgerVersionNumber :: T.Text -> T.Text+hledgerVersionNumber txt = case dropWhile (== "hledger") (T.words txt) of+  v : _ -> T.dropWhileEnd (== ',') v+  [] -> ""

@@ -0,0 +1,147 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++-- | Collect a ledger's status from disk. Read-only and silent.+module Hledger.Flow.Status.Gather+  ( classifyDir,+    gatherStatus,+    accountName,+    cachedStatement,+    hookExists,+  )+where++import Control.Monad (forM)+import qualified Data.List as List+import qualified Data.Map.Strict as Map+import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing)+import qualified Data.Text as T+import Hledger.Flow.BaseDir (findBaseDir, relativeToBase')+import Hledger.Flow.Common (configuredLedgerFile, firstExistingFile)+import Hledger.Flow.Import.ImportHelpers (defaultRulesCandidates, extractImportDirs, rulesFileCandidates)+import Hledger.Flow.Import.ImportHelpersTurtle (includesNeedUpdate)+import Hledger.Flow.Import.Inventory (classifyGeneratedOutputs, findImportFiles, generatedOutput, isManualJournal, managedIncludeFiles, stageFiles)+import Hledger.Flow.Import.Types (ImportDirs (..))+import Hledger.Flow.PathHelpers (AbsDir, AbsFile, RelFile)+import Hledger.Flow.Status+import Hledger.Flow.Types (BaseDir, HledgerInfo)+import Path+import qualified Path.IO as PathIO+import qualified System.Directory as Directory+import qualified System.FilePath as FilePath+import qualified System.Info as Sys+import System.IO.Error (tryIOError)++-- | Is this folder inside a ledger, empty, or something else?+classifyDir :: AbsDir -> IO Situation+classifyDir dir = do+  found <- findBaseDir dir+  case found of+    Just base -> return (InLedger base)+    Nothing -> do+      (dirs, files) <- PathIO.listDirRel dir+      let names = map (FilePath.dropTrailingPathSeparator . toFilePath) dirs ++ map toFilePath files+      return (if all ("." `List.isPrefixOf`) names then EmptyDir else Elsewhere)++gatherStatus :: Maybe HledgerInfo -> BaseDir -> IO LedgerStatus+gatherStatus hledger base = do+  let root = base </> [reldir|import|]+  files <- findImportFiles root+  let statements = stageFiles root [reldir|1-in|] files+      groups = Map.toAscList (Map.fromListWith (flip (++)) [(accountName root s, [s]) | s <- statements])+  accounts <- forM groups (uncurry (accountStatus base))+  configured <- configuredLedgerFile+  ledgerFile <- forM configured $ \(value, path) -> LedgerFile value <$> Directory.doesFileExist path+  allYears <- PathIO.doesFileExist (base </> [relfile|all-years.journal|])+  (orphans, journals) <- classifyGeneratedOutputs root files statements+  -- A newly initialised, empty ledger has no indexes to reconcile yet.+  reconciliation <- if allYears && null orphans+    then includesNeedUpdate base root files journals+    else return (not (null orphans) || not (null (managedIncludeFiles root files)))+  return+    LedgerStatus+      { lsBaseDir = base,+        lsHledger = hledger,+        lsLedgerFile = ledgerFile,+        lsAccounts = accounts,+        lsMisplaced = List.sortOn mpPath (misplacedFiles root files),+        lsManualJournals = length (filter (isManualJournal root) files),+        lsAllYearsExists = allYears,+        lsNeedsReconciliation = reconciliation+      }++accountName :: AbsDir -> AbsFile -> T.Text+accountName root file = case stripProperPrefix root file of+  Just rel -> T.intercalate "/" (map T.pack (take 3 (FilePath.splitDirectories (toFilePath rel))))+  Nothing -> T.pack (toFilePath file)++accountStatus :: BaseDir -> T.Text -> [AbsFile] -> IO AccountStatus+accountStatus base name statements = do+  dirs <- case statements of+    s : _ -> either (ioError . userError . T.unpack) return (extractImportDirs s)+    [] -> ioError (userError ("No statements for " ++ T.unpack name))+  let relative = relativeToBase' (toFilePath base) . toFilePath+  defaults <- defaultRulesCandidates dirs+  rulesFile <- firstExistingFile defaults+  preprocess <- hookFile (accountDir dirs) [relfile|preprocess|]+  construct <- hookFile (accountDir dirs) [relfile|construct|]+  directives <- firstExistingFile [base </> [relfile|directives.journal|]]+  results <- forM statements $ \s -> do+    cached <- cachedStatement s+    rules <- rulesFileCandidates (fromMaybe s cached) dirs >>= firstExistingFile+    let conversionInputs = case construct of+          Just script -> [Just script]+          Nothing -> [rules, directives]+        inputs = s : catMaybes (cached : preprocess : conversionInputs)+    journal <- generatedOutput [reldir|3-journal|] ".journal" s+    state <- journalState inputs journal+    return (rules, state)+  let (resolved, journals) = unzip results+  return+    AccountStatus+      { asAccount = name,+        asStatements = length statements,+        asYears = List.nub (List.sort (map yearOf statements)),+        asRulesFile = relative <$> rulesFile,+        asRulesCandidates = map relative defaults,+        asWithoutRules = length (filter isNothing resolved),+        asPreprocess = isJust preprocess,+        asConstruct = isJust construct,+        asJournalsMissing = length (filter (== Missing) journals),+        asJournalsOutdated = length (filter (== Outdated) journals)+      }+  where+    yearOf s = read (FilePath.dropTrailingPathSeparator (toFilePath (dirname (parent s))))++data JournalState = Current | Outdated | Missing deriving (Eq)++journalState :: [AbsFile] -> AbsFile -> IO JournalState+journalState inputs journal = do+  exists <- PathIO.doesFileExist journal+  if exists+    then do+      -- Keep filesystem precision so a rule edited just after import is noticed.+      newer <- tryIOError $ do+        written <- PathIO.getModificationTime journal+        any (> written) <$> mapM PathIO.getModificationTime inputs+      return (if either (const True) id newer then Outdated else Current)+    else return Missing++-- | Import reads this statement's cached CSV when present, even without a hook.+cachedStatement :: AbsFile -> IO (Maybe AbsFile)+cachedStatement statement = do+  csv <- generatedOutput [reldir|2-preprocessed|] ".csv" statement+  firstExistingFile [csv]++-- | Same hook names import looks for.+hookExists :: AbsDir -> RelFile -> IO Bool+hookExists dir hook = isJust <$> hookFile dir hook++hookFile :: AbsDir -> RelFile -> IO (Maybe AbsFile)+hookFile dir hook = do+  let base = dir </> hook+  alternatives <-+    if Sys.os == "mingw32"+      then mapM (`addExtension` base) [".ps1", ".exe"]+      else return []+  firstExistingFile (base : alternatives)

@@ -0,0 +1,181 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Status as text for people and JSON for scripts and agents.+module Hledger.Flow.Status.Render+  ( useColor,+    renderStatus,+    renderNext,+    renderEnvironment,+    statusJSON,+    tildePath,+    nextStepHere,+    printStatus,+    printNext,+  )+where++import Control.Exception (IOException, catch)+import Data.Aeson (Value, object, (.=))+import Data.Aeson.Text (encodeToLazyText)+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy.IO as TL+import Hledger.Flow.Common (findHledger, nativeShell)+import Hledger.Flow.DateTime (currentYear)+import Hledger.Flow.Environment (coresSetting, environmentJSON, environmentSettings, renderSettings)+import Hledger.Flow.Internals (SystemInfo, systemInfo)+import Hledger.Flow.Status.Gather (gatherStatus)+import Hledger.Flow.Types (BaseDir)+import Path.IO (getCurrentDir, getHomeDir)+import qualified Data.List as List+import qualified Data.Text as T+import Hledger.Flow.PathHelpers (AbsDir)+import Hledger.Flow.Status+import Hledger.Flow.Types (HledgerInfo (..))+import Path (toFilePath)+import System.Console.ANSI (Color (..), ColorIntensity (..), ConsoleIntensity (..), ConsoleLayer (..), SGR (..), hSupportsANSIColor, setSGRCode)+import System.Environment (lookupEnv)+import qualified System.FilePath as FilePath+import System.IO (Handle, stdout)++-- | Colour only on a terminal, and only when NO_COLOR is unset or empty.+useColor :: Handle -> IO Bool+useColor h = do+  noColor <- lookupEnv "NO_COLOR"+  supported <- hSupportsANSIColor h+  return (supported && maybe True null noColor)++-- | An absolute path, with the home directory shown as @~@.+tildePath :: Maybe AbsDir -> FilePath -> FilePath+tildePath home path = case home of+  Just h | Just rest <- List.stripPrefix (toFilePath h) path -> "~" FilePath.</> rest+  _ -> path++paint :: Bool -> [SGR] -> T.Text -> T.Text+paint False _ txt = txt+paint True sgr txt = T.pack (setSGRCode sgr) <> txt <> T.pack (setSGRCode [Reset])++green, red, yellow, bold :: Bool -> T.Text -> T.Text+green c = paint c [SetColor Foreground Vivid Green]+red c = paint c [SetColor Foreground Vivid Red]+yellow c = paint c [SetColor Foreground Vivid Yellow]+bold c = paint c [SetConsoleIntensity BoldIntensity]++baseText :: LedgerStatus -> FilePath+baseText = FilePath.dropTrailingPathSeparator . toFilePath . lsBaseDir++renderStatus :: Bool -> Maybe AbsDir -> LedgerStatus -> NextStep -> T.Text+renderStatus color home s next =+  T.unlines (header : accountBlock ++ misplacedBlock) <> renderNext color next+  where+    header = bold color "Ledger: " <> T.pack (tildePath home (baseText s)) <> "   (" <> hledgerText <> ")"+    hledgerText = case lsHledger s of+      Just hl -> "hledger " <> hledgerVersionNumber (hlVersion hl) <> " found"+      Nothing -> red color "hledger not found"+    rows = [(asAccount a, counts a, state a) | a <- lsAccounts s]+    width f = maximum (0 : map (T.length . f) rows)+    accountBlock+      | null rows = []+      | otherwise =+          "" : ["  " <> T.justifyLeft (width fst3) ' ' name <> "   " <> T.justifyLeft (width snd3) ' ' n <> "   " <> st | (name, n, st) <- rows]+    fst3 (x, _, _) = x+    snd3 (_, x, _) = x+    counts a = plural (asStatements a) "statement" <> years (asYears a)+    years [] = ""+    years [y] = " (" <> tshow y <> ")"+    years (y : ys) = " (" <> tshow y <> "–" <> tshow (last ys) <> ")"+    state a+      | asWithoutRules a > 0 && not (asConstruct a) = red color "✗ no rules file"+      | otherwise =+          let missing = asJournalsMissing a+              outdated = asJournalsOutdated a+              imported = asStatements a - missing+              parts =+                [plural imported "journal" | imported > 0]+                  ++ [tshow missing <> " not imported" | missing > 0]+                  ++ [tshow outdated <> " outdated" | outdated > 0]+              txt = T.intercalate ", " parts+           in if missing + outdated > 0 then yellow color ("• " <> txt) else green color ("✓ " <> txt)+    misplacedBlock = case length (lsMisplaced s) of+      0 -> []+      n -> ["", "  " <> yellow color ("⚠ " <> plural n "file" <> " not where hledger-flow looks")]++renderNext :: Bool -> NextStep -> T.Text+renderNext color next =+  T.unlines $+    ""+      : (bold color "Next:" <> " " <> nsSummary next)+      : map ("      " <>) (["Run: " <> c | Just c <- [nsCommand next]] ++ nsDetail next ++ ["Docs: " <> d | Just d <- [nsDocs next]])++tshow :: Show a => a -> T.Text+tshow = T.pack . show++statusJSON :: SystemInfo -> Maybe FilePath -> LedgerStatus -> NextStep -> Value+statusJSON sys conf s next =+  object+    [ "schemaVersion" .= (1 :: Int),+      "environment" .= environmentJSON sys conf,+      "baseDir" .= baseText s,+      "hledger" .= fmap hledgerJSON (lsHledger s),+      "ledgerFile" .= fmap (\lf -> object ["value" .= lfValue lf, "exists" .= lfExists lf]) (lsLedgerFile s),+      "accounts" .= map accountJSON (lsAccounts s),+      "misplaced" .= [object ["path" .= mpPath m, "suggestion" .= mpSuggestion m] | m <- lsMisplaced s],+      "manualJournals" .= lsManualJournals s,+      "allYearsJournalExists" .= lsAllYearsExists s,+      "next"+        .= object+          [ "summary" .= nsSummary next,+            "command" .= nsCommand next,+            "detail" .= nsDetail next,+            "docs" .= nsDocs next+          ]+    ]+  where+    hledgerJSON hl = object ["path" .= toFilePath (hlPath hl), "version" .= hledgerVersionNumber (hlVersion hl)]+    accountJSON a =+      object+        [ "account" .= asAccount a,+          "statements" .= asStatements a,+          "years" .= asYears a,+          "rulesFile" .= asRulesFile a,+          "rulesCandidates" .= asRulesCandidates a,+          "statementsWithoutRules" .= asWithoutRules a,+          "hooks" .= object ["preprocess" .= asPreprocess a, "construct" .= asConstruct a],+          "journalsMissing" .= asJournalsMissing a,+          "journalsOutdated" .= asJournalsOutdated a+        ]++nextStepHere :: LedgerStatus -> IO NextStep+nextStepHere status = do+  year <- currentYear+  cwd <- getCurrentDir+  return (nextStep year nativeShell cwd status)++-- | The versions and paths status ran with, with full paths for bug reports.+renderEnvironment :: Bool -> SystemInfo -> Maybe FilePath -> LedgerStatus -> T.Text+renderEnvironment color sys conf s =+  T.unlines ("" : bold color "Environment:" : map ("  " <>) (renderSettings (red color) settings))+  where+    settings = environmentSettings sys (lsHledger s) conf (lsBaseDir s) ++ [coresSetting sys]++-- | Print the ledger's status as text, or as JSON for scripts and agents.+printStatus :: Maybe FilePath -> Maybe FilePath -> Bool -> BaseDir -> IO ()+printStatus hledgerPath conf json base = do+  hledger <- findHledger hledgerPath+  status <- gatherStatus hledger base+  next <- nextStepHere status+  sys <- systemInfo+  if json+    then TL.putStrLn (encodeToLazyText (statusJSON sys conf status next))+    else do+      color <- useColor stdout+      home <- (Just <$> getHomeDir) `catch` (\e -> const (return Nothing) (e :: IOException))+      T.putStr (renderStatus color home status next <> renderEnvironment color sys conf status)++-- | Print only the next step for a ledger.+printNext :: Maybe FilePath -> BaseDir -> IO ()+printNext hledgerPath base = do+  hledger <- findHledger hledgerPath+  status <- gatherStatus hledger base+  next <- nextStepHere status+  color <- useColor stdout+  T.putStr (renderNext color next)

@@ -7,13 +7,13 @@ import Control.Exception (try) import qualified Data.Text as T import qualified Data.Text.IO as T-import Hledger.Flow.BaseDir (determineBaseDir, effectiveRunDir)+import Hledger.Flow.BaseDir (determineBaseDir, effectiveRunDir, findBaseDir) import Hledger.Flow.PathHelpers import Hledger.Flow.Types (BaseDir, RunDir) import Path import Path.IO import Test.HUnit-import TestHelpers (testRoot)+import TestHelpers (testRoot, withTestDir) import Prelude hiding (readFile, writeFile)  assertSubDirsForDetermineBaseDir :: AbsDir -> BaseDir -> [Path.Path b Dir] -> IO ()@@ -167,4 +167,14 @@     )  tests :: Test-tests = TestList [testDetermineBaseDir, testRunDirs, testEffectiveRunDir]+tests = TestList [testDetermineBaseDir, testRunDirs, testEffectiveRunDir, testFindBaseDir]++testFindBaseDir :: Test+testFindBaseDir = TestCase $ withTestDir $ \tmp -> do+  let base = tmp </> [reldir|ledger|]+      deep = base </> [reldir|import/me/bank/acct/1-in/2026|]+  createDirIfMissing True deep+  found <- findBaseDir deep+  assertEqual "finds the ledger from deep inside it" (Just base) found+  none <- findBaseDir tmp+  assertEqual "no ledger above the temp dir" Nothing none

@@ -121,4 +121,13 @@     )  tests :: Test-tests = TestList [testDocURL, testShowCmdArgs, testHledgerConfArgs, testRelativeToBase, testExtractDigits, testGroupValuesBy]+tests = TestList [testDocURL, testShowCmdArgs, testHledgerConfArgs, testRelativeToBase, testExtractDigits, testGroupValuesBy, testTrimToolOutput]++testTrimToolOutput :: Test+testTrimToolOutput =+  TestList+    [ "long line" ~: trimToolOutput (T.replicate 400 "x") ~?= T.replicate 300 "x" <> "…",+      "many lines" ~: T.lines (trimToolOutput (T.unlines (map (T.pack . show) [1 .. 25 :: Int])))+        ~?= map (T.pack . show) [1 .. 20 :: Int] ++ ["… (5 more lines)"],+      "short output unchanged" ~: trimToolOutput "a\nb\n" ~?= "a\nb\n"+    ]

@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Environment.Unit (tests) where++import qualified Data.Text as T+import Hledger.Flow.Environment+import Hledger.Flow.RuntimeOptions+import Path+import Test.HUnit+import TestHelpers (defaultOpts, testRoot)++opts :: RuntimeOptions+opts = defaultOpts (testRoot </> [reldir|fin|])++testImportLines :: Test+testImportLines = TestCase $ do+  let out = renderSettings id (importSettings opts {importStartYear = Just 2024, batchSize = 20})+      line l = filter ((l <> " ") `T.isPrefixOf`) out+  assertEqual "one line per setting" 8 (length out)+  assertBool "full hledger path and version" (any ((T.pack (toFilePath [relfile|path/to/hledger|]) <> "  (1.2.3)") `T.isInfixOf`) (line "hledger"))+  assertBool "flag beside its value" (any ("2024 onwards" `T.isInfixOf`) (line "Start year") && any ("--start-year" `T.isSuffixOf`) (line "Start year"))+  assertBool "whole ledger" (any (". (whole ledger)" `T.isInfixOf`) (line "Run from"))+  -- The longest labels are 12 characters, so every value starts in column 14.+  assertBool "values line up" (all (\l -> T.index l 13 == ' ' && T.index l 14 /= ' ') out)++testMissingHledger :: Test+testMissingHledger = TestCase $ do+  let out = renderSettings (\v -> "<" <> v <> ">") (environmentSettings (sysInfo opts) Nothing Nothing (baseDir opts))+  assertBool "missing hledger styled as a problem" (any ("<not found" `T.isInfixOf`) out)+  assertBool "only that line styled" (length (filter ("<" `T.isInfixOf`) out) == 1)++testReportTables :: Test+testReportTables = TestCase $ do+  let out = renderSettings id (reportSettings opts {prettyReports = False, sequential = True})+  assertBool "ascii tables" (any ("ASCII" `T.isInfixOf`) out)+  assertBool "sequential" (any ("one file at a time" `T.isInfixOf`) out)+  assertBool "no import settings" (not (any ("Start year" `T.isPrefixOf`) out))++tests :: Test+tests = TestList [testImportLines, testMissingHledger, testReportTables]

@@ -0,0 +1,22 @@+{-# LANGUAGE QuasiQuotes #-}++module Init.Integration (tests) where++import Hledger.Flow.Init (InitOutcome (..), initLedger)+import Path+import Path.IO (doesDirExist)+import Test.HUnit hiding (Path)+import TestHelpers (withTestDir)++testInit :: Test+testInit = TestCase $ withTestDir $ \tmp -> do+  let fresh = tmp </> [reldir|fin|]+  (@?= Created fresh Nothing) =<< initLedger fresh+  doesDirExist (fresh </> [reldir|import|]) >>= assertBool "import/ created"+  (@?= AlreadyLedger fresh) =<< initLedger fresh+  (@?= InsideLedger fresh) =<< initLedger (fresh </> [reldir|import/me|])+  let nested = fresh </> [reldir|elsewhere|]+  (@?= Created nested (Just fresh)) =<< initLedger nested++tests :: Test+tests = TestList [testInit]

@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}++module ReleaseNotice.Unit (tests) where++import Control.Concurrent.MVar+import Control.Exception (AsyncException (UserInterrupt), throwIO, try)+import Control.Monad (forM_)+import Data.Aeson (encode, object, (.=))+import Data.IORef+import qualified Data.Text as T+import Data.Version (showVersion)+import Paths_hledger_flow (version)+import Hledger.Flow.ReleaseNotice (checkRelease, finishCommand, startCheck)+import Path (toFilePath)+import System.Directory (createDirectoryIfMissing)+import System.Exit (ExitCode (ExitFailure))+import System.FilePath ((</>))+import System.Timeout (timeout)+import Test.HUnit+import TestHelpers (withTestDir)++tests :: Test+tests = TestLabel "release notice" $ TestList+  [ "ignore malformed, nonstable and non-newer releases" ~: TestCase $+      forM_ [Nothing, Just "invalid", Just "{\"tag_name\":\"v0\"}",+             Just (encode (object ["tag_name" .= ("v" ++ showVersion version)])),+             Just "{\"tag_name\":\"v999-rc1\"}", Just "{\"tag_name\":\"v999x\"}",+             Just "{\"tag_name\":\"v999\",\"prerelease\":true}",+             Just "{\"tag_name\":\"v999\",\"draft\":true}"] $ \body -> do+        notice <- checkRelease (const $ pure body) (fail "unexpected ownership check")+        Nothing @=? notice+  , "verified Homebrew ownership and published formula" ~: TestCase $+      withTestDir $ \dir -> do+        let keg = toFilePath dir </> "Cellar" </> "hledger-flow" </> "1.2.3"+            exe = keg </> "bin" </> "hledger-flow"+            receipt = keg </> "INSTALL_RECEIPT.json"+            fetch formula url+              | url == "https://api.github.com/repos/apauley/hledger-flow/releases/latest" =+                  pure $ Just "{\"tag_name\":\"v999.10.0\"}"+              | url == "https://raw.githubusercontent.com/FernTrail/homebrew-tap/main/Formula/hledger-flow.rb" =+                  pure formula+              | otherwise = assertFailure ("unexpected URL " ++ url) >> pure Nothing+            check advice formula = do+              notice <- checkRelease (fetch formula) (pure exe)+              assertBool ("expected " ++ T.unpack advice) (maybe False (T.isInfixOf advice) notice)+            published = Just "  tag = \"v999.10.0\"\n"+            releases = "https://github.com/apauley/hledger-flow/releases/latest"+        createDirectoryIfMissing True (keg </> "bin")+        writeFile exe ""+        check releases published+        writeFile receipt "{\"source\":{\"tap\":\"other/tap\"}}"+        check releases published+        writeFile receipt "{\"source\":{\"tap\":\"ferntrail/tap\"}}"+        check releases Nothing+        check releases (Just "  tag = \"v999.9.0\"\n")+        check "brew update && brew upgrade ferntrail/tap/hledger-flow" published+  , "command finishes with worker still pending" ~: TestCase $ do+      started <- newEmptyMVar+      release <- newEmptyMVar+      finish <- startCheck (putMVar started () >> takeMVar release)+      takeMVar started+      success <- timeout 1000000 $ finishCommand finish (pure ())+      failure <- timeout 1000000 $ try (finishCommand finish (throwIO (ExitFailure 37)))+      Just () @=? success+      Just (Left (ExitFailure 37)) @=? failure+      putMVar release Nothing+  , "ready notice follows diagnostics and preserves the exit code" ~: TestCase $ do+      events <- newIORef ([] :: [String])+      let record msg = modifyIORef' events (++ [msg])+      result <- try $ finishCommand (record "notice") (record "diagnostic" >> throwIO (ExitFailure 23))+      Left (ExitFailure 23) @=? result+      readIORef events >>= assertEqual "order" ["diagnostic", "notice"]+  , "interrupt skips a ready notice" ~: TestCase $ do+      result <- try $ finishCommand (assertFailure "printed on interrupt") (throwIO UserInterrupt)+      Left UserInterrupt @=? result+  , "notice write failure preserves success and failure" ~: TestCase $ do+      let broken = ioError (userError "closed stderr")+      finishCommand broken (pure ())+      result <- try $ finishCommand broken (throwIO (ExitFailure 19))+      Left (ExitFailure 19) @=? result+  ]

@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}++module RulesTemplate.Unit (tests) where++import qualified Data.Text as T+import Hledger.Flow.RulesTemplate+import Test.HUnit++tests :: Test+tests =+  TestList+    [ "bom stripped" ~: templateFields (snd (splitHeader "\xFEFF\&Date,Desc,Amount")) ~?= ["date", "description", "amount"],+      "semicolons" ~: fst (splitHeader "\"Datum\";\"Omschrijving\";\"Bedrag\"") ~?= ';',+      "tabs" ~: fst (splitHeader "Date\tDesc\tAmount") ~?= '\t',+      "mapping" ~: templateFields ["Transaction Date", "Payee Name", "Amount", "Balance (ZAR)", "", "Amount"]+        ~?= ["date", "description", "amount", "balance_zar", "field5", "bank_amount"],+      "hledger's special names renamed" ~: templateFields ["Date", "Description", "Amount", "Balance", "Status", "Code"]+        ~?= ["date", "description", "amount", "bank_balance", "bank_status", "bank_code"],+      "single amount column mapped" ~: templateFields ["Date", "Desc", "Transaction Amount"] ~?= ["date", "description", "amount"],+      "debit and credit amounts left alone" ~: templateFields ["Date", "Desc", "Debit Amount", "Credit Amount"]+        ~?= ["date", "description", "debit_amount", "credit_amount"],+      "renamed columns explained" ~: fmap (T.isInfixOf "bank_balance")+        (rulesTemplate "b" "a" "x.csv" "Date,Desc,Amount,Balance\n")+        ~?= Right True,+      "data row" ~: looksLikeHeader ["2026-01-02", "Coffee", "-3.50"] ~?= False,+      "header row" ~: looksLikeHeader ["Date", "Desc", "Amount"] ~?= True,+      "template fields" ~: fmap (T.isInfixOf "fields date, description, amount\n")+        (rulesTemplate "mybank" "checking" "import/me/mybank/checking/1-in/2026/jan.csv" "Date,Desc,Amount\n1,2,3\n")+        ~?= Right True,+      "template accounts" ~: fmap (T.isInfixOf "account1 assets:mybank:checking\n")+        (rulesTemplate "mybank" "checking" "x.csv" "Date,Desc,Amount\n")+        ~?= Right True,+      "template separator" ~: fmap (T.isInfixOf "separator ;\n")+        (rulesTemplate "b" "a" "x.csv" "Date;Desc;Amount\n")+        ~?= Right True,+      "no separator line for commas" ~: fmap (T.isInfixOf "separator")+        (rulesTemplate "b" "a" "x.csv" "Date,Desc,Amount\n")+        ~?= Right False,+      "no header" ~: either (T.isInfixOf "looks like data") (const False)+        (rulesTemplate "b" "a" "x.csv" "2026-01-02,Coffee,-3.50\n") ~?= True,+      "not csv" ~: either (T.isInfixOf "isn't a CSV file") (const False)+        (rulesTemplate "b" "a" "x.pdf" "%PDF") ~?= True+    ]

@@ -8,8 +8,14 @@ import qualified CSVImport.Unit import qualified Common.Integration import qualified Common.Unit+import qualified Environment.Unit import qualified ImportHelpers.Integration+import qualified Init.Integration import qualified PathHelpers.Unit+import qualified ReleaseNotice.Unit+import qualified RulesTemplate.Unit+import qualified Status.Integration+import qualified Status.Unit import Test.HUnit import System.Exit (exitFailure) @@ -22,7 +28,13 @@       BaseDir.Integration.tests,       ImportHelpers.Integration.tests,       CSVImport.Unit.tests,-      CSVImport.Integration.tests+      CSVImport.Integration.tests,+      Status.Unit.tests,+      Status.Integration.tests,+      Init.Integration.tests,+      ReleaseNotice.Unit.tests,+      RulesTemplate.Unit.tests,+      Environment.Unit.tests     ]  main :: IO Counts

@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Status.Integration (tests) where++import Data.Maybe (isNothing)+import Data.Time.Clock (addUTCTime)+import Hledger.Flow.Common (findHledger)+import Hledger.Flow.PathHelpers (AbsFile)+import Hledger.Flow.Status+import Hledger.Flow.Status.Gather (classifyDir, gatherStatus)+import Path+import Path.IO+import Control.Monad (unless)+import System.Environment (lookupEnv, setEnv, unsetEnv)+import qualified System.Info as Sys+import System.FilePath (joinPath)+import Test.HUnit hiding (Path)+import TestHelpers (defaultHlInfo, withTestDir)++touch :: AbsFile -> IO ()+touch file = do+  createDirIfMissing True (parent file)+  writeFile (toFilePath file) "Date,Desc,Amount\n"++testClassify :: Test+testClassify = TestCase $ withTestDir $ \tmp -> do+  let ledger = tmp </> [reldir|ledger|]+      empty = tmp </> [reldir|empty|]+      other = tmp </> [reldir|other|]+  mapM_ (createDirIfMissing True) [ledger </> [reldir|import/me|], empty, other]+  writeFile (toFilePath (empty </> [relfile|.DS_Store|])) ""+  writeFile (toFilePath (other </> [relfile|notes.txt|])) ""+  (@?= InLedger ledger) =<< classifyDir (ledger </> [reldir|import/me|])+  (@?= EmptyDir) =<< classifyDir empty+  (@?= Elsewhere) =<< classifyDir other++testGather :: Test+testGather = TestCase $ withTestDir $ \base -> do+  let imp = base </> [reldir|import|]+      cardCsv = imp </> [relfile|other/bank/card/1-in/2026/c.csv|]+      cardJournal = imp </> [relfile|other/bank/card/3-journal/2026/c.journal|]+  mapM_ touch+    [ imp </> [relfile|me/mybank/checking/1-in/2025/a.csv|],+      imp </> [relfile|me/mybank/checking/1-in/2026/b.csv|],+      cardCsv,+      imp </> [relfile|bank.rules|],+      cardJournal,+      imp </> [relfile|me/mybank/jan.csv|],+      imp </> [relfile|me/_manual_/2026/pre-import.journal|]+    ]+  now <- getModificationTime cardCsv+  setModificationTime cardJournal (addUTCTime (-3600) now)+  unsetEnv "LEDGER_FILE"+  s <- gatherStatus (Just defaultHlInfo) base+  map asAccount (lsAccounts s) @?= ["me/mybank/checking", "other/bank/card"]+  case lsAccounts s of+    [checking, card] -> do+      (asStatements checking, asYears checking, asRulesFile checking, asWithoutRules checking, asJournalsMissing checking)+        @?= (2, [2025, 2026], Nothing, 2, 2)+      asRulesCandidates checking @?= [joinPath ["import", "me", "mybank", "checking", "mybank-checking.rules"], joinPath ["import", "mybank.rules"]]+      (asRulesFile card, asWithoutRules card, asJournalsMissing card, asJournalsOutdated card)+        @?= (Just (joinPath ["import", "bank.rules"]), 0, 0, 1)+    _ -> assertFailure "expected two accounts"+  map mpPath (lsMisplaced s) @?= [joinPath ["import", "me", "mybank", "jan.csv"]]+  lsManualJournals s @?= 1+  lsLedgerFile s @?= Nothing+  setEnv "LEDGER_FILE" (toFilePath (base </> [relfile|missing.journal|]))+  s2 <- gatherStatus Nothing base+  unsetEnv "LEDGER_FILE"+  fmap lfExists (lsLedgerFile s2) @?= Just False+  lsAllYearsExists s2 @?= False++testLedgerFileTilde :: Test+testLedgerFileTilde = TestCase $ unless (Sys.os == "mingw32") $ withTestDir $ \base -> do+  oldHome <- lookupEnv "HOME"+  writeFile (toFilePath (base </> [relfile|x.journal|])) ""+  createDirIfMissing True (base </> [reldir|import|])+  setEnv "HOME" (toFilePath base)+  setEnv "LEDGER_FILE" "~/x.journal"+  s <- gatherStatus Nothing base+  unsetEnv "LEDGER_FILE"+  maybe (unsetEnv "HOME") (setEnv "HOME") oldHome+  fmap lfExists (lsLedgerFile s) @?= Just True++testFindHledgerMissing :: Test+testFindHledgerMissing = TestCase $ do+  r <- findHledger (Just "/nonexistent/hledger")+  assertBool "Nothing for a missing path" (isNothing r)++tests :: Test+tests = TestList [testClassify, testGather, testFindHledgerMissing, testLedgerFileTilde]

@@ -0,0 +1,140 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}++module Status.Unit (tests, blank, acct) where++import Data.Aeson (Value (..))+import qualified Data.Aeson.Key as Key+import qualified Data.Aeson.KeyMap as KeyMap+import Data.List (sort)+import qualified Data.Text as T+import Hledger.Flow.Common (Shell (..))+import Hledger.Flow.Status.Render (renderStatus, statusJSON)+import Hledger.Flow.Status+import Path+import qualified System.FilePath as FilePath+import Test.HUnit+import TestHelpers (defaultHlInfo, testRoot, testSystemInfo)++blank :: LedgerStatus+blank =+  LedgerStatus+    { lsBaseDir = testRoot </> [reldir|fin|],+      lsHledger = Just defaultHlInfo,+      lsLedgerFile = Just (LedgerFile "/x" True),+      lsAccounts = [],+      lsMisplaced = [],+      lsManualJournals = 0,+      lsAllYearsExists = True,+      lsNeedsReconciliation = False+    }++acct :: AccountStatus+acct =+  AccountStatus+    { asAccount = "me/mybank/checking",+      asStatements = 1,+      asYears = [2026],+      asRulesFile = Just "import/me/mybank/checking/mybank-checking.rules",+      asRulesCandidates = ["import/me/mybank/checking/mybank-checking.rules", "import/mybank.rules"],+      asWithoutRules = 0,+      asPreprocess = False,+      asConstruct = False,+      asJournalsMissing = 0,+      asJournalsOutdated = 0+    }++native :: FilePath -> FilePath+native = FilePath.joinPath . FilePath.splitDirectories++testSuggest :: Test+testSuggest =+  TestList+    [ suggestPlacement ["me", "mybank", "jan.csv"] ~?= native "import/me/mybank/<account>/1-in/<year>/jan.csv",+      suggestPlacement ["jan.csv"] ~?= native "import/<owner>/<bank>/<account>/1-in/<year>/jan.csv",+      suggestPlacement ["me", "mybank", "checking", "2026", "jan.csv"] ~?= native "import/me/mybank/checking/1-in/2026/jan.csv",+      suggestPlacement ["me", "mybank", "checking", "1-in", "jan.csv"] ~?= native "import/me/mybank/checking/1-in/<year>/jan.csv"+    ]++testMisplacedUpperCase :: Test+testMisplacedUpperCase = TestCase $ do+  let root = testRoot </> [reldir|fin/import|]+      files =+        [ root </> [relfile|me/mybank/JAN.CSV|],+          root </> [relfile|me/mybank/checking/1-in/2026/feb.csv|],+          root </> [relfile|me/mybank/checking/2-preprocessed/2026/feb.csv|],+          root </> [relfile|me/mybank/checking/3-journal/2026/feb.journal|],+          root </> [relfile|me/mybank/checking/3-journal/2026/mar.csv|],+          root </> [relfile|me/mybank/notes.md|]+        ]+  map mpPath (misplacedFiles root files) @?=+    map native ["import/me/mybank/JAN.CSV", "import/me/mybank/checking/3-journal/2026/mar.csv"]++atRoot :: LedgerStatus -> NextStep+atRoot = nextStep 2026 Posix (lsBaseDir blank)++summaryOf :: LedgerStatus -> T.Text+summaryOf = nsSummary . atRoot++commandOf :: LedgerStatus -> Maybe T.Text+commandOf = nsCommand . atRoot++allYears :: T.Text+allYears = T.pack (toFilePath (lsBaseDir blank </> [relfile|all-years.journal|]))++testRules :: Test+testRules =+  TestList+    [ "1 hledger missing" ~: summaryOf blank {lsHledger = Nothing} ~?= "Install hledger, or pass its location with --hledger-path",+      "2 empty ledger" ~: summaryOf blank ~?= "Put your first statement in import/<owner>/<bank>/<account>/1-in/<year>/",+      "2 example uses current year" ~: nsDetail (atRoot blank) ~?= ["For example: import/me/mybank/checking/1-in/2026/statement.csv", "Then check with: hledger-flow status"],+      "2 skipped for manual-only ledger" ~: summaryOf blank {lsManualJournals = 1} ~?= "Generate reports, or explore with hledger",+      "5 import when all-years.journal is missing" ~: commandOf blank {lsManualJournals = 1, lsAllYearsExists = False} ~?= Just "hledger-flow import",+      "3 misplaced" ~: summaryOf blank {lsMisplaced = [Misplaced "import/a.csv" "x"]} ~?= "Move 1 file to where hledger-flow looks",+      "3 misplaced plural" ~: summaryOf blank {lsMisplaced = [Misplaced "import/a.csv" "x", Misplaced "import/b.csv" "y"]} ~?= "Move 2 files to where hledger-flow looks",+      "3 detail" ~: nsDetail (atRoot blank {lsMisplaced = [Misplaced "import/a.csv" "x"]}) ~?= ["import/a.csv → x"],+      "4 rules" ~: commandOf blank {lsAccounts = [acct {asWithoutRules = 1, asRulesFile = Nothing}]} ~?= Just "hledger-flow status --rules-template me/mybank/checking",+      "4 summary" ~: summaryOf blank {lsAccounts = [acct {asWithoutRules = 1, asRulesFile = Nothing}]} ~?= "Create import/me/mybank/checking/mybank-checking.rules (rules for me/mybank/checking)",+      "4 powershell literal account" ~:+        nsCommand (nextStep 2026 PowerShell (lsBaseDir blank) blank {lsAccounts = [acct {asWithoutRules = 1, asAccount = "me/Bob's Bank/Lee’s $(example)"}]})+          ~?= Just "hledger-flow status --rules-template 'me/Bob''s Bank/Lee’’s $(example)'",+      "4 skipped with construct" ~: commandOf blank {lsAccounts = [acct {asWithoutRules = 1, asConstruct = True}]} ~?= Just "hledger-flow report",+      "5 import" ~: summaryOf blank {lsAccounts = [acct {asJournalsMissing = 1, asJournalsOutdated = 1}]} ~?= "Import 2 new or changed statements",+      "5 import singular" ~: summaryOf blank {lsAccounts = [acct {asJournalsMissing = 1}]} ~?= "Import 1 new or changed statement",+      "6 posix" ~: commandOf blank {lsAccounts = [acct], lsLedgerFile = Nothing} ~?= Just ("export LEDGER_FILE='" <> allYears <> "'"),+      "6 windows" ~: nsCommand (nextStep 2026 PowerShell (lsBaseDir blank) blank {lsAccounts = [acct], lsLedgerFile = Nothing}) ~?= Just ("$env:LEDGER_FILE = '" <> allYears <> "'"),+      "6 set but missing" ~: nsDetail (atRoot blank {lsAccounts = [acct], lsLedgerFile = Just (LedgerFile "/nope.journal" False)}) ~?= ["LEDGER_FILE is set to /nope.journal, which doesn't exist."],+      "7 done" ~: commandOf blank {lsAccounts = [acct]} ~?= Just "hledger-flow report"+    ]++testVersion :: Test+testVersion =+  TestList+    [ hledgerVersionNumber "hledger 1.50.2, mac-aarch64" ~?= "1.50.2",+      hledgerVersionNumber "1.50" ~?= "1.50"+    ]++tests :: Test+testRenderNoColour :: Test+testRenderNoColour = TestCase $ do+  let s = blank {lsAccounts = [acct {asWithoutRules = 1, asRulesFile = Nothing}]}+      out = renderStatus False Nothing s (atRoot s)+  assertBool "account line" ("me/mybank/checking" `T.isInfixOf` out && "✗ no rules file" `T.isInfixOf` out)+  assertBool "next step" ("Next: Create import/me/mybank/checking/mybank-checking.rules" `T.isInfixOf` out)+  assertBool "no escapes" (not ("\ESC" `T.isInfixOf` out))++testRenderPending :: Test+testRenderPending = TestCase $ do+  let render a = renderStatus False Nothing blank {lsAccounts = [a]} (atRoot blank)+  assertBool "nothing imported yet" ("• 1 not imported" `T.isInfixOf` render acct {asJournalsMissing = 1})+  assertBool "mixed" ("• 11 journals, 1 not imported, 2 outdated" `T.isInfixOf` render acct {asStatements = 12, asJournalsMissing = 1, asJournalsOutdated = 2})+  assertBool "clean" ("✓ 1 journal" `T.isInfixOf` render acct)++testJSONShape :: Test+testJSONShape = TestCase $ case statusJSON testSystemInfo Nothing blank (atRoot blank) of+  Object o ->+    sort (map Key.toText (KeyMap.keys o))+      @?= ["accounts", "allYearsJournalExists", "baseDir", "environment", "hledger", "ledgerFile", "manualJournals", "misplaced", "next", "schemaVersion"]+  _ -> assertFailure "status JSON is an object"++tests = TestList [testSuggest, testMisplacedUpperCase, testRules, testVersion, testRenderNoColour, testRenderPending, testJSONShape]