diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,30 @@ # Changelog for [hledger-flow](https://github.com/apauley/hledger-flow) +## 0.14.0 + +- Add a new performance-related command-line option to import: `--new-files-only`. [PR #89](https://github.com/apauley/hledger-flow/pull/89) + + Don't regenerate transaction files if they are + already present. This applies to hledger journal + files as well as files produced by the preprocess and + construct scripts. + +- Generate monthly versions of the income statement in reports. A contribution by [Max Linke](https://github.com/apauley/hledger-flow/pull/88) + +- Switch some usages of system-filepath over to [path](https://github.com/apauley/hledger-flow/pull/87) + + hledger-flow started as a collection of bash scripts that I translated into Haskell with the help of [Turtle](https://hackage.haskell.org/package/turtle). + + Turtle uses the now deprecated [system-filepath](https://hackage.haskell.org/package/system-filepath) to represent all paths. + + I've had many filepath-related issues in hledger-flow. + They were related to issues such as that 2 instances of the same directory would not be treated as equal, because one could have a trailing slash and the other not. + Another issue that popped up was knowing wether a path is a file or a directory, and if it is absolute or relative. + + All of these issues are articulated in the `path` library: + https://github.com/commercialhaskell/path + + ## 0.13.2 Improve support for importing a subset of journals: start importing only from the directory given as argument, diff --git a/README.org b/README.org --- a/README.org +++ b/README.org @@ -72,7 +72,7 @@ =hledger-flow= is intended for you if: - You are interested in getting started with - [[http://hledger.org/][hledger]] and you wouldn't mind pointers to the + [[http://hledger.org/][hledger]] or [[https://www.ledger-cli.org/][ledger-cli]] and you wouldn't mind pointers to the right docs along the way. - You want a way to organise your finances into a structure that will be maintainable over the long term. @@ -85,17 +85,35 @@ - You appreciate the fact that all your financial information stays within your control. +* About This Documentation + +The rest of this file documents how to use =hledger-flow=, and it has probably outgrown what should be in a README file. + +If you can spare some time to contribute to this project, please consider converting these docs to something more suitable, +such as [[https://github.com/apauley/hledger-flow/issues/47][Read the Docs]]. + * How do I install it? :PROPERTIES: :CUSTOM_ID: how-do-i-install-it :END: The easiest way to get it running is to download [[https://github.com/apauley/hledger-flow/releases][the latest release]] -for your OS, and copy the =hledger-flow= executable to a directory in your PATH. +for your OS (Linux or Mac OS X), and copy the =hledger-flow= executable to a directory in your PATH. Then just run it and see what it tells you to do. You can also compile it yourself by following the [[https://github.com/apauley/hledger-flow/blob/master/CONTRIBUTING.org#build-the-project][build instructions]]. +** Windows Support + +Currently =hledger-flow= does not work on Windows. + +This [[https://github.com/apauley/hledger-flow/issues?q=is%3Aissue+is%3Aopen+label%3Awindows][list of issues]] describes some of the details of what doesn't work. + +I believe it wouldn't take too much effort to fix those issues, but I'm going to leave Windows support +for other contributors. + +Please send me some pull requests if you would like =hledger-flow= to work on Windows. + * How Stable is it? :PROPERTIES: :CUSTOM_ID: how-stable-is-it @@ -104,6 +122,10 @@ We're not close to a 1.0 release yet, which means that we can still make changes if needed. +As an example, the command-line switches we use will probably change over time. +Some switches change the behaviour of the program - the default behaviour will probably change between releases. +The names of these command-line options can change, or they can be removed when it is no longer needed. + That being said, some parts have been used and tested extensively and are likely to remain stable. Have a look at the "Stability of this Feature" sections in the feature reference below. @@ -267,17 +289,17 @@ A checking account at mybank: #+BEGIN_EXAMPLE - # Saved as: import/john/mybank/checking/mybank-checking.rules - include ../../../mybank-shared.rules - account1 Assets:Current:John:MyBank:Checking +# Saved as: import/john/mybank/checking/mybank-checking.rules +include ../../../mybank-shared.rules +account1 Assets:Current:John:MyBank:Checking #+END_EXAMPLE Another account at mybank: #+BEGIN_EXAMPLE - # Saved as: import/alice/mybank/savings/mybank-savings.rules - include ../../../mybank-shared.rules - account1 Assets:Current:Alice:MyBank:Savings +# Saved as: import/alice/mybank/savings/mybank-savings.rules +include ../../../mybank-shared.rules +account1 Assets:Current:Alice:MyBank:Savings #+END_EXAMPLE Where =import/mybank-shared.rules= may define some shared attributes: @@ -299,7 +321,7 @@ with the fields defined more or less like this: #+BEGIN_EXAMPLE - fields date, description, amount, balance, account1, account2 +fields date, description, amount, balance, account1, account2 #+END_EXAMPLE *** Stability of this Feature @@ -341,11 +363,21 @@ An opening balance may look something like this: #+BEGIN_EXAMPLE - 2018-06-01 Savings Account Opening Balance +2018-06-01 Savings Account Opening Balance assets:Current:MyBank:Savings $102.01 equity:Opening Balances:MyBank:Savings #+END_EXAMPLE + +*** A Note of Caution Regarding Closing Balances + +When closing your balances it may result in some =hledger= queries showing zero-values, or there could be issues with balance assertions. + +Please have a look at the upstream =hledger= documentation on closing balances, e.g here: +https://hledger.org/hledger.html#close-usage + +Some of the gotchas you may run into are also described in [[https://github.com/apauley/hledger-flow/issues/79][this hledger-flow issue]]. + *** Closing Balances :PROPERTIES: :CUSTOM_ID: closing-balances @@ -361,7 +393,7 @@ A closing balance may look something like this: #+BEGIN_EXAMPLE - 2018-06-01 Savings Account Closing Balance +2018-06-01 Savings Account Closing Balance assets:Current:MyBank:Savings $-234.56 = $0.00 equity:Closing Balances:MyBank:Savings #+END_EXAMPLE @@ -402,10 +434,14 @@ :CUSTOM_ID: stability-of-this-feature-2 :END: -The opening balances file works well in my opinion, I don't expect it to -change. I'm only using closing balances in one or two places, so maybe -that could do with some suggestions from people who use this more than -myself. +Closing balances sometimes result in [[https://github.com/apauley/hledger-flow/issues/79][unexpected query results]]. +In future we may change how/where the generated files include the closing journal. + +We may also need to suggest some naming conventions for opening and closing balances so that reports can exclude +some of these transactions. + +It is also possible that we might want to change the name/location of the closing journal, +but we'll try to avoid this if possible, because that would require users to rename their existing files. ** Price Files :PROPERTIES: diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -1,26 +1,32 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} module Main where -import Turtle hiding (switch) -import Prelude hiding (FilePath, putStrLn) +import Path +import qualified Turtle as Turtle hiding (switch) +import Prelude hiding (putStrLn) import Options.Applicative +import Hledger.Flow.PathHelpers (TurtlePath) import Hledger.Flow.Common +import Hledger.Flow.BaseDir import qualified Hledger.Flow.RuntimeOptions as RT import Hledger.Flow.Reports import Hledger.Flow.CSVImport -data ImportParams = ImportParams { maybeImportBaseDir :: Maybe FilePath - , importUseRunDir :: Bool } deriving (Show) +data ImportParams = ImportParams { maybeImportBaseDir :: Maybe TurtlePath + , importUseRunDir :: Bool + , onlyNewFiles :: Bool + } deriving (Show) -data ReportParams = ReportParams { maybeReportBaseDir :: Maybe FilePath } deriving (Show) +data ReportParams = ReportParams { maybeReportBaseDir :: Maybe TurtlePath } deriving (Show) data Command = Import ImportParams | Report ReportParams deriving (Show) data MainParams = MainParams { verbosity :: Int - , hledgerPathOpt :: Maybe FilePath + , hledgerPathOpt :: Maybe TurtlePath , showOpts :: Bool , sequential :: Bool } deriving (Show) @@ -28,19 +34,21 @@ main :: IO () main = do - cmd <- options "An hledger workflow focusing on automated statement import and classification:\nhttps://github.com/apauley/hledger-flow#readme" baseCommandParser + cmd <- Turtle.options "An hledger workflow focusing on automated statement import and classification:\nhttps://github.com/apauley/hledger-flow#readme" baseCommandParser case cmd of - Version -> stdout $ select versionInfo + Version -> Turtle.stdout $ Turtle.select versionInfo Command mainParams' (Import subParams) -> toRuntimeOptionsImport mainParams' subParams >>= importCSVs Command mainParams' (Report subParams) -> toRuntimeOptionsReport mainParams' subParams >>= generateReports toRuntimeOptionsImport :: MainParams -> ImportParams -> IO RT.RuntimeOptions toRuntimeOptionsImport mainParams' subParams' = do - (bd, runDir) <- determineBaseDir $ maybeImportBaseDir subParams' + let maybeBD = maybeImportBaseDir subParams' :: Maybe TurtlePath + (bd, runDir) <- determineBaseDir maybeBD hli <- hledgerInfoFromPath $ hledgerPathOpt mainParams' return RT.RuntimeOptions { RT.baseDir = bd , RT.importRunDir = runDir , RT.useRunDir = importUseRunDir subParams' + , RT.onlyNewFiles = onlyNewFiles subParams' , RT.hfVersion = versionInfo' , RT.hledgerInfo = hli , RT.sysInfo = systemInfo @@ -50,11 +58,13 @@ toRuntimeOptionsReport :: MainParams -> ReportParams -> IO RT.RuntimeOptions toRuntimeOptionsReport mainParams' subParams' = do - (bd, _) <- determineBaseDir $ maybeReportBaseDir subParams' + let maybeBD = maybeReportBaseDir subParams' :: Maybe TurtlePath + (bd, _) <- determineBaseDir maybeBD hli <- hledgerInfoFromPath $ hledgerPathOpt mainParams' return RT.RuntimeOptions { RT.baseDir = bd - , RT.importRunDir = "./" + , RT.importRunDir = [reldir|.|] , RT.useRunDir = False + , RT.onlyNewFiles = False , RT.hfVersion = versionInfo' , RT.hledgerInfo = hli , RT.sysInfo = systemInfo @@ -67,21 +77,22 @@ <|> 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 = fmap Import (Turtle.subcommand "import" "Uses hledger with your own rules and/or scripts to convert electronic statements into categorised journal files" subcommandParserImport) + <|> fmap Report (Turtle.subcommand "report" "Generate Reports" subcommandParserReport) verboseParser :: Parser MainParams verboseParser = MainParams <$> (length <$> many (flag' () (long "verbose" <> short 'v' <> help "Print more verbose output"))) - <*> optional (optPath "hledger-path" 'H' "The full path to an hledger executable") + <*> optional (Turtle.optPath "hledger-path" 'H' "The full path to an hledger executable") <*> switch (long "show-options" <> help "Print the options this program will run with") <*> switch (long "sequential" <> help "Disable parallel processing") subcommandParserImport :: Parser ImportParams subcommandParserImport = ImportParams - <$> optional (argPath "dir" "The directory to import. Use the base directory for a full import or a sub-directory for a partial import. Defaults to the current directory. This behaviour is changing: see --enable-future-rundir") + <$> optional (Turtle.argPath "dir" "The directory to import. Use the base directory for a full import or a sub-directory for a partial import. Defaults to the current directory. This behaviour is changing: see --enable-future-rundir") <*> switch (long "enable-future-rundir" <> help "Enable the future (0.14.x) default behaviour now: start importing only from the directory that was given as an argument, or the currect directory. Previously a full import was always done. This switch will be removed in 0.14.x") + <*> switch (long "new-files-only" <> help "Don't regenerate transaction files if they are already present. This applies to hledger journal files as well as files produced by the preprocess and construct scripts.") subcommandParserReport :: Parser ReportParams subcommandParserReport = ReportParams - <$> optional (argPath "basedir" "The hledger-flow base directory") + <$> optional (Turtle.argPath "basedir" "The hledger-flow base directory") diff --git a/hledger-flow.cabal b/hledger-flow.cabal --- a/hledger-flow.cabal +++ b/hledger-flow.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2. +-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- --- hash: 735099a4aed6ae3be8f511959f660740e93a66852c0a4aeb4b1d3b29e7a951c8 +-- hash: 7b720ae822cc4e9d6e1e1b3e96ab162130e20c432bfd91e151bd2355f271ac54 name: hledger-flow -version: 0.13.2.0 +version: 0.14.0.0 synopsis: An hledger workflow focusing on automated statement import and classification. description: Please see the README on GitHub at category: Finance, Console @@ -29,9 +29,12 @@ library exposed-modules: + Hledger.Flow.BaseDir Hledger.Flow.Common Hledger.Flow.CSVImport + Hledger.Flow.DocHelpers Hledger.Flow.Import.Types + Hledger.Flow.PathHelpers Hledger.Flow.Reports Hledger.Flow.RuntimeOptions Hledger.Flow.Types @@ -43,7 +46,10 @@ build-depends: base >=4.7 && <5 , containers + , exceptions , foldl + , path + , path-io , stm , text , time @@ -62,6 +68,7 @@ base >=4.7 && <5 , hledger-flow , optparse-applicative + , path , text , turtle default-language: Haskell2010 @@ -70,6 +77,7 @@ type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: + BaseDir.Integration Common.Integration Common.Unit CSVImport.Integration @@ -85,6 +93,8 @@ , containers , foldl , hledger-flow + , path + , path-io , stm , text , turtle diff --git a/src/Hledger/Flow/BaseDir.hs b/src/Hledger/Flow/BaseDir.hs new file mode 100644 --- /dev/null +++ b/src/Hledger/Flow/BaseDir.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + +module Hledger.Flow.BaseDir where + +import Path +import Path.IO +import Hledger.Flow.Types (HasBaseDir, BaseDir, RunDir, baseDir) +import Hledger.Flow.PathHelpers + +import Data.Maybe + +import Control.Monad.Catch (MonadThrow, throwM) +import Control.Monad.IO.Class (MonadIO) + + +import qualified Turtle as Turtle (stripPrefix) + +determineBaseDir :: Maybe TurtlePath -> IO (BaseDir, RunDir) +determineBaseDir suppliedDir = do + pwd <- getCurrentDir + determineBaseDir' pwd suppliedDir + +determineBaseDir' :: AbsDir -> Maybe TurtlePath -> IO (BaseDir, RunDir) +determineBaseDir' pwd (Just suppliedDir) = do + absDir <- turtleToAbsDir pwd suppliedDir + determineBaseDirFromStartDir absDir +determineBaseDir' pwd Nothing = determineBaseDirFromStartDir pwd + +determineBaseDirFromStartDir :: AbsDir -> IO (BaseDir, RunDir) +determineBaseDirFromStartDir startDir = determineBaseDirFromStartDir' startDir startDir + +determineBaseDirFromStartDir' :: (MonadIO m, MonadThrow m) => AbsDir -> AbsDir -> m (BaseDir, RunDir) +determineBaseDirFromStartDir' startDir possibleBaseDir = do + _ <- if (parent possibleBaseDir == possibleBaseDir) then throwM (MissingBaseDir startDir) else return () + foundBaseDir <- doesDirExist $ possibleBaseDir [reldir|import|] + if foundBaseDir then + do + runDir <- makeRelative possibleBaseDir startDir + return (possibleBaseDir, runDir) + else determineBaseDirFromStartDir' startDir $ parent possibleBaseDir + +relativeToBase :: HasBaseDir o => o -> TurtlePath -> TurtlePath +relativeToBase opts = relativeToBase' $ pathToTurtle (baseDir opts) + +relativeToBase' :: TurtlePath -> TurtlePath -> TurtlePath +relativeToBase' bd p = if forceTrailingSlash bd == forceTrailingSlash p then "./" else + fromMaybe p $ Turtle.stripPrefix (forceTrailingSlash bd) p + +turtleBaseDir :: HasBaseDir o => o -> TurtlePath +turtleBaseDir opts = pathToTurtle $ baseDir opts + +effectiveRunDir :: BaseDir -> RunDir -> Bool -> AbsDir +effectiveRunDir bd rd useRunDir = do + let baseImportDir = bd [Path.reldir|import|] + let absRunDir = bd rd + if useRunDir + then if absRunDir == bd then baseImportDir else absRunDir + else baseImportDir diff --git a/src/Hledger/Flow/CSVImport.hs b/src/Hledger/Flow/CSVImport.hs --- a/src/Hledger/Flow/CSVImport.hs +++ b/src/Hledger/Flow/CSVImport.hs @@ -4,109 +4,146 @@ ( importCSVs ) where -import Turtle hiding (stdout, stderr, proc, procStrictWithErr) -import Prelude hiding (FilePath, putStrLn, take) +import qualified Turtle as Turtle hiding (stdout, stderr, proc, procStrictWithErr) +import Turtle ((%), (), (<.>)) +import Prelude hiding (putStrLn, take) import qualified Data.Text as T import qualified Data.List.NonEmpty as NonEmpty import qualified Hledger.Flow.Types as FlowTypes import Hledger.Flow.Import.Types +import Hledger.Flow.BaseDir (relativeToBase, effectiveRunDir) +import Hledger.Flow.PathHelpers (TurtlePath, pathToTurtle) +import Hledger.Flow.DocHelpers (docURL) import Hledger.Flow.Common import Hledger.Flow.RuntimeOptions import Control.Concurrent.STM +import Control.Monad +type FileWasGenerated = Bool + importCSVs :: RuntimeOptions -> IO () -importCSVs opts = sh ( +importCSVs opts = Turtle.sh ( do - ch <- liftIO newTChanIO - logHandle <- fork $ consoleChannelLoop ch - liftIO $ if (showOptions opts) then channelOutLn ch (repr opts) else return () - liftIO $ logVerbose opts ch "Starting import" - (journals, diff) <- time $ liftIO $ importCSVs' opts ch - liftIO $ channelOutLn ch $ format ("Imported "%d%" journals in "%s) (length journals) $ repr diff - liftIO $ terminateChannelLoop ch - wait logHandle + ch <- Turtle.liftIO newTChanIO + logHandle <- Turtle.fork $ consoleChannelLoop ch + Turtle.liftIO $ if (showOptions opts) then channelOutLn ch (Turtle.repr opts) else return () + Turtle.liftIO $ logVerbose opts ch "Starting import" + (journals, diff) <- Turtle.time $ Turtle.liftIO $ importCSVs' opts ch + let generatedJournals = filter snd journals + Turtle.liftIO $ channelOutLn ch $ Turtle.format ("Imported "%Turtle.d%"/"%Turtle.d%" journals in "%Turtle.s) (length generatedJournals) (length journals) $ Turtle.repr diff + Turtle.liftIO $ terminateChannelLoop ch + Turtle.wait logHandle ) pathSeparators :: [Char] pathSeparators = ['/', '\\', ':'] -inputFilePattern :: Pattern Text -inputFilePattern = contains (once (oneOf pathSeparators) <> asciiCI "1-in" <> once (oneOf pathSeparators) <> plus digit <> once (oneOf pathSeparators)) +inputFilePattern :: Turtle.Pattern T.Text +inputFilePattern = Turtle.contains (Turtle.once (Turtle.oneOf pathSeparators) <> Turtle.asciiCI "1-in" <> Turtle.once (Turtle.oneOf pathSeparators) <> Turtle.plus Turtle.digit <> Turtle.once (Turtle.oneOf pathSeparators)) -importCSVs' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> IO [FilePath] +importCSVs' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> IO [(TurtlePath, FileWasGenerated)] importCSVs' opts ch = do - let baseImportDir = forceTrailingSlash $ (baseDir opts) "import" - let runDir = forceTrailingSlash $ collapse $ (baseDir opts) (importRunDir opts) - let effectiveDir = if useRunDir opts - then if (forceTrailingSlash $ runDir "import") == baseImportDir then baseImportDir else runDir - else baseImportDir - channelOutLn ch $ format ("Collecting input files from "%fp) effectiveDir - (inputFiles, diff) <- time $ single . shellToList . onlyFiles $ find inputFilePattern effectiveDir + let effectiveDir = effectiveRunDir (baseDir opts) (importRunDir opts) (useRunDir opts) + channelOutLn ch $ Turtle.format ("Collecting input files from "%Turtle.fp) $ pathToTurtle effectiveDir + (inputFiles, diff) <- Turtle.time $ Turtle.single . shellToList . onlyFiles $ Turtle.find inputFilePattern (pathToTurtle effectiveDir) let fileCount = length inputFiles if (fileCount == 0) then do - let msg = format ("I couldn't find any input files underneath "%fp + let msg = Turtle.format ("I couldn't find any input files underneath "%Turtle.fp %"\n\nhledger-flow expects to find its input files in specifically\nnamed directories.\n\n"% - "Have a look at the documentation for a detailed explanation:\n"%s) effectiveDir (docURL "input-files") + "Have a look at the documentation for a detailed explanation:\n"%Turtle.s) (pathToTurtle effectiveDir) (docURL "input-files") errExit 1 ch msg [] else do - channelOutLn ch $ format ("Found "%d%" input files in "%s%". Proceeding with import...") fileCount (repr diff) - let actions = map (extractAndImport opts ch) inputFiles :: [IO FilePath] + channelOutLn ch $ Turtle.format ("Found "%Turtle.d%" input files in "%Turtle.s%". Proceeding with import...") fileCount (Turtle.repr diff) + let actions = map (extractAndImport opts ch) inputFiles :: [IO (TurtlePath, FileWasGenerated)] importedJournals <- parAwareActions opts actions - _ <- writeIncludesUpTo opts ch effectiveDir importedJournals + _ <- writeIncludesUpTo opts ch (pathToTurtle effectiveDir) $ fmap fst importedJournals _ <- writeToplevelAllYearsInclude opts return importedJournals -extractAndImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> IO FilePath +extractAndImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> IO (TurtlePath, FileWasGenerated) extractAndImport opts ch inputFile = do case extractImportDirs inputFile of Right importDirs -> importCSV opts ch importDirs inputFile Left errorMessage -> do - errExit 1 ch errorMessage inputFile + errExit 1 ch errorMessage (inputFile, False) -importCSV :: RuntimeOptions -> TChan FlowTypes.LogMessage -> ImportDirs -> FilePath -> IO FilePath +importCSV :: RuntimeOptions -> TChan FlowTypes.LogMessage -> ImportDirs -> TurtlePath -> IO (TurtlePath, FileWasGenerated) importCSV opts ch importDirs srcFile = do let preprocessScript = accountDir importDirs "preprocess" let constructScript = accountDir importDirs "construct" let bankName = importDirLine bankDir importDirs let accountName = importDirLine accountDir importDirs let ownerName = importDirLine ownerDir importDirs - csvFile <- preprocessIfNeeded opts ch preprocessScript bankName accountName ownerName srcFile - doCustomConstruct <- verboseTestFile opts ch constructScript - let importFun = if doCustomConstruct - then customConstruct opts ch constructScript bankName accountName ownerName - else hledgerImport opts ch + (csvFile, preprocessHappened) <- preprocessIfNeeded opts ch preprocessScript bankName accountName ownerName srcFile let journalOut = changePathAndExtension "3-journal" "journal" csvFile - mktree $ directory journalOut - importFun csvFile journalOut + shouldImport <- if onlyNewFiles opts && not preprocessHappened + then not <$> verboseTestFile opts ch journalOut + else return True -preprocessIfNeeded :: RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> IO FilePath -preprocessIfNeeded opts ch script bank account owner src = do - shouldPreprocess <- verboseTestFile opts ch script - if shouldPreprocess - then preprocess opts ch script bank account owner src - else return src + importFun <- if shouldImport + then constructOrImport opts ch constructScript bankName accountName ownerName + else do + _ <- logNewFileSkip opts ch "import" journalOut + return $ \_p1 _p2 -> return journalOut + Turtle.mktree $ Turtle.directory journalOut + out <- importFun csvFile journalOut + return (out, shouldImport) -preprocess :: RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> IO FilePath -preprocess opts ch script bank account owner src = do +constructOrImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> Turtle.Line -> Turtle.Line -> Turtle.Line -> IO (TurtlePath -> TurtlePath -> IO TurtlePath) +constructOrImport opts ch constructScript bankName accountName ownerName = do + constructScriptExists <- verboseTestFile opts ch constructScript + if constructScriptExists + then return $ customConstruct opts ch constructScript bankName accountName ownerName + else return $ hledgerImport opts ch + +preprocessIfNeeded :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> Turtle.Line -> Turtle.Line -> Turtle.Line -> TurtlePath -> IO (TurtlePath, Bool) +preprocessIfNeeded opts ch script bank account owner src = do let csvOut = changePathAndExtension "2-preprocessed" "csv" src - mktree $ directory csvOut - let args = [format fp src, format fp csvOut, lineToText bank, lineToText account, lineToText owner] + scriptExists <- verboseTestFile opts ch script + shouldProceed <- if onlyNewFiles opts + then do + targetExists <- verboseTestFile opts ch csvOut + return $ scriptExists && not targetExists + else return scriptExists + if shouldProceed + then do + out <- preprocess opts ch script bank account owner src csvOut + return (out, True) + else do + _ <- logNewFileSkip opts ch "preprocess" csvOut + return (src, False) + +logNewFileSkip :: RuntimeOptions -> TChan FlowTypes.LogMessage -> T.Text -> TurtlePath -> IO () +logNewFileSkip opts ch logIdentifier absTarget = + Control.Monad.when (onlyNewFiles opts) $ do + let relativeTarget = relativeToBase opts absTarget + logVerbose opts ch + $ Turtle.format + ("Skipping " % Turtle.s + % " - only creating new files and this output file already exists: '" + % Turtle.fp + % "'") logIdentifier relativeTarget + +preprocess :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> Turtle.Line -> Turtle.Line -> Turtle.Line -> TurtlePath -> TurtlePath -> IO TurtlePath +preprocess opts ch script bank account owner src csvOut = do + Turtle.mktree $ Turtle.directory csvOut + let args = [Turtle.format Turtle.fp src, Turtle.format Turtle.fp csvOut, Turtle.lineToText bank, Turtle.lineToText account, Turtle.lineToText owner] let relScript = relativeToBase opts script let relSrc = relativeToBase opts src - let cmdLabel = format ("executing '"%fp%"' on '"%fp%"'") relScript relSrc - _ <- timeAndExitOnErr opts ch cmdLabel channelOut channelErr (parAwareProc opts) (format fp script, args, empty) + let cmdLabel = Turtle.format ("executing '"%Turtle.fp%"' on '"%Turtle.fp%"'") relScript relSrc + _ <- timeAndExitOnErr opts ch cmdLabel channelOut channelErr (parAwareProc opts) (Turtle.format Turtle.fp script, args, Turtle.empty) return csvOut -hledgerImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> IO FilePath +hledgerImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> TurtlePath -> IO TurtlePath hledgerImport opts ch csvSrc journalOut = do case extractImportDirs csvSrc of Right importDirs -> hledgerImport' opts ch importDirs csvSrc journalOut Left errorMessage -> do errExit 1 ch errorMessage csvSrc -hledgerImport' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> ImportDirs -> FilePath -> FilePath -> IO FilePath +hledgerImport' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> ImportDirs -> TurtlePath -> TurtlePath -> IO TurtlePath hledgerImport' opts ch importDirs csvSrc journalOut = do let candidates = rulesFileCandidates csvSrc importDirs maybeRulesFile <- firstExistingFile candidates @@ -114,31 +151,31 @@ case maybeRulesFile of Just rf -> do let relRules = relativeToBase opts rf - let hledger = format fp $ FlowTypes.hlPath . hledgerInfo $ opts :: Text - let args = ["print", "--rules-file", format fp rf, "--file", format fp csvSrc, "--output-file", format fp journalOut] - let cmdLabel = format ("importing '"%fp%"' using rules file '"%fp%"'") relCSV relRules - _ <- timeAndExitOnErr opts ch cmdLabel channelOut channelErr (parAwareProc opts) (hledger, args, empty) + let hledger = Turtle.format Turtle.fp $ FlowTypes.hlPath . hledgerInfo $ opts :: T.Text + let args = ["print", "--rules-file", Turtle.format Turtle.fp rf, "--file", Turtle.format Turtle.fp csvSrc, "--output-file", Turtle.format Turtle.fp journalOut] + let cmdLabel = Turtle.format ("importing '"%Turtle.fp%"' using rules file '"%Turtle.fp%"'") relCSV relRules + _ <- timeAndExitOnErr opts ch cmdLabel channelOut channelErr (parAwareProc opts) (hledger, args, Turtle.empty) return journalOut Nothing -> do let relativeCandidates = map (relativeToBase opts) candidates - let candidatesTxt = T.intercalate "\n" $ map (format fp) relativeCandidates - let msg = format ("I couldn't find an hledger rules file while trying to import\n"%fp - %"\n\nI will happily use the first rules file I can find from any one of these "%d%" files:\n"%s - %"\n\nHere is a bit of documentation about rules files that you may find helpful:\n"%s) + let candidatesTxt = T.intercalate "\n" $ map (Turtle.format Turtle.fp) relativeCandidates + let msg = Turtle.format ("I couldn't find an hledger rules file while trying to import\n"%Turtle.fp + %"\n\nI will happily use the first rules file I can find from any one of these "%Turtle.d%" files:\n"%Turtle.s + %"\n\nHere is a bit of documentation about rules files that you may find helpful:\n"%Turtle.s) relCSV (length candidates) candidatesTxt (docURL "rules-files") errExit 1 ch msg csvSrc -rulesFileCandidates :: FilePath -> ImportDirs -> [FilePath] +rulesFileCandidates :: TurtlePath -> ImportDirs -> [TurtlePath] rulesFileCandidates csvSrc importDirs = statementSpecificRulesFiles csvSrc importDirs ++ generalRulesFiles importDirs -importDirLines :: (ImportDirs -> FilePath) -> ImportDirs -> [Line] -importDirLines dirFun importDirs = NonEmpty.toList $ textToLines $ format fp $ dirname $ dirFun importDirs +importDirLines :: (ImportDirs -> TurtlePath) -> ImportDirs -> [Turtle.Line] +importDirLines dirFun importDirs = NonEmpty.toList $ Turtle.textToLines $ Turtle.format Turtle.fp $ Turtle.dirname $ dirFun importDirs -importDirLine :: (ImportDirs -> FilePath) -> ImportDirs -> Line +importDirLine :: (ImportDirs -> TurtlePath) -> ImportDirs -> Turtle.Line importDirLine dirFun importDirs = foldl (<>) "" $ importDirLines dirFun importDirs -generalRulesFiles :: ImportDirs -> [FilePath] +generalRulesFiles :: ImportDirs -> [TurtlePath] generalRulesFiles importDirs = do let bank = importDirLines bankDir importDirs let account = importDirLines accountDir importDirs @@ -147,27 +184,27 @@ let bankRulesFile = importDir importDirs buildFilename bank "rules" [accountRulesFile, bankRulesFile] -statementSpecificRulesFiles :: FilePath -> ImportDirs -> [FilePath] +statementSpecificRulesFiles :: TurtlePath -> ImportDirs -> [TurtlePath] statementSpecificRulesFiles csvSrc importDirs = do - let srcSuffix = snd $ T.breakOnEnd "_" (format fp (basename csvSrc)) + let srcSuffix = snd $ T.breakOnEnd "_" (Turtle.format Turtle.fp (Turtle.basename csvSrc)) if ((T.take 3 srcSuffix) == "rfo") then do - let srcSpecificFilename = fromText srcSuffix <.> "rules" + let srcSpecificFilename = Turtle.fromText srcSuffix <.> "rules" map ( srcSpecificFilename) [accountDir importDirs, bankDir importDirs, importDir importDirs] else [] -customConstruct :: RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> Line -> Line -> Line -> FilePath -> FilePath -> IO FilePath +customConstruct :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> Turtle.Line -> Turtle.Line -> Turtle.Line -> TurtlePath -> TurtlePath -> IO TurtlePath customConstruct opts ch constructScript bank account owner csvSrc journalOut = do - let script = format fp constructScript :: Text + let script = Turtle.format Turtle.fp constructScript :: T.Text let relScript = relativeToBase opts constructScript - let constructArgs = [format fp csvSrc, "-", lineToText bank, lineToText account, lineToText owner] - let constructCmdText = format ("Running: "%fp%" "%s) relScript (showCmdArgs constructArgs) - let stdLines = inprocWithErrFun (channelErrLn ch) (script, constructArgs, empty) - let hledger = format fp $ FlowTypes.hlPath . hledgerInfo $ opts :: Text - let args = ["print", "--ignore-assertions", "--file", "-", "--output-file", format fp journalOut] + let constructArgs = [Turtle.format Turtle.fp csvSrc, "-", Turtle.lineToText bank, Turtle.lineToText account, Turtle.lineToText owner] + let constructCmdText = Turtle.format ("Running: "%Turtle.fp%" "%Turtle.s) relScript (showCmdArgs constructArgs) + let stdLines = inprocWithErrFun (channelErrLn ch) (script, constructArgs, Turtle.empty) + let hledger = Turtle.format Turtle.fp $ FlowTypes.hlPath . hledgerInfo $ opts :: T.Text + let args = ["print", "--ignore-assertions", "--file", "-", "--output-file", Turtle.format Turtle.fp journalOut] let relSrc = relativeToBase opts csvSrc - let cmdLabel = format ("executing '"%fp%"' on '"%fp%"'") relScript relSrc + let cmdLabel = Turtle.format ("executing '"%Turtle.fp%"' on '"%Turtle.fp%"'") relScript relSrc _ <- timeAndExitOnErr' opts ch cmdLabel [constructCmdText] channelOut channelErr (parAwareProc opts) (hledger, args, stdLines) return journalOut diff --git a/src/Hledger/Flow/Common.hs b/src/Hledger/Flow/Common.hs --- a/src/Hledger/Flow/Common.hs +++ b/src/Hledger/Flow/Common.hs @@ -2,8 +2,10 @@ module Hledger.Flow.Common where -import Turtle -import Prelude hiding (FilePath, putStrLn) +import qualified Turtle as Turtle +import Turtle ((%), (), (<.>)) + +import Prelude hiding (putStrLn) import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Text.Read as T @@ -20,8 +22,14 @@ import Data.Function (on) import qualified Data.List as List (nub, null, sort, sortBy, groupBy) import Data.Ord (comparing) + import Hledger.Flow.Types import qualified Hledger.Flow.Import.Types as IT + +import Hledger.Flow.PathHelpers (TurtlePath) +import Hledger.Flow.BaseDir (turtleBaseDir, relativeToBase, relativeToBase') +import Hledger.Flow.DocHelpers (docURL) + import Control.Concurrent.STM import qualified Data.List.NonEmpty as NE @@ -29,12 +37,12 @@ import qualified Data.Version as Version (showVersion) import qualified System.Info as Sys -type InputFileBundle = Map.Map FilePath [FilePath] +type InputFileBundle = Map.Map TurtlePath [TurtlePath] -versionInfo :: NE.NonEmpty Line -versionInfo = textToLines versionInfo' +versionInfo :: NE.NonEmpty Turtle.Line +versionInfo = Turtle.textToLines versionInfo' -versionInfo' :: Text +versionInfo' :: T.Text versionInfo' = T.pack ("hledger-flow " ++ Version.showVersion version ++ " " ++ os systemInfo ++ " " ++ arch systemInfo ++ " " ++ compilerName systemInfo ++ " " ++ @@ -47,16 +55,16 @@ , compilerVersion = Sys.compilerVersion } -hledgerPathFromOption :: Maybe FilePath -> IO FilePath +hledgerPathFromOption :: Maybe TurtlePath -> IO TurtlePath hledgerPathFromOption pathOption = do case pathOption of Just h -> do - isOnDisk <- testfile h + isOnDisk <- Turtle.testfile h if isOnDisk then return h else do - let msg = format ("Unable to find hledger at "%fp) h + let msg = Turtle.format ("Unable to find hledger at "%Turtle.fp) h errExit' 1 (T.hPutStrLn H.stderr) msg h Nothing -> do - maybeH <- which "hledger" + maybeH <- Turtle.which "hledger" case maybeH of Just h -> return h Nothing -> do @@ -65,52 +73,52 @@ <> "There are a number of installation options on the hledger website: https://hledger.org/download.html" errExit' 1 (T.hPutStrLn H.stderr) msg "/" -hledgerVersionFromPath :: FilePath -> IO Text -hledgerVersionFromPath hlp = fmap (T.strip . linesToText) (single $ shellToList $ inproc (format fp hlp) ["--version"] empty) +hledgerVersionFromPath :: TurtlePath -> IO T.Text +hledgerVersionFromPath hlp = fmap (T.strip . Turtle.linesToText) (Turtle.single $ shellToList $ Turtle.inproc (Turtle.format Turtle.fp hlp) ["--version"] Turtle.empty) -hledgerInfoFromPath :: Maybe FilePath -> IO HledgerInfo +hledgerInfoFromPath :: Maybe TurtlePath -> IO HledgerInfo hledgerInfoFromPath pathOption = do hlp <- hledgerPathFromOption pathOption hlv <- hledgerVersionFromPath hlp return $ HledgerInfo hlp hlv -showCmdArgs :: [Text] -> Text +showCmdArgs :: [T.Text] -> T.Text showCmdArgs args = T.intercalate " " (map escapeArg args) -escapeArg :: Text -> Text +escapeArg :: T.Text -> T.Text escapeArg a = if (T.count " " a > 0) then "'" <> a <> "'" else a -dummyLogger :: TChan LogMessage -> Text -> IO () +dummyLogger :: TChan LogMessage -> T.Text -> IO () dummyLogger _ _ = return () -channelOut :: TChan LogMessage -> Text -> IO () +channelOut :: TChan LogMessage -> T.Text -> IO () channelOut ch txt = atomically $ writeTChan ch $ StdOut txt -channelOutLn :: TChan LogMessage -> Text -> IO () +channelOutLn :: TChan LogMessage -> T.Text -> IO () channelOutLn ch txt = channelOut ch (txt <> "\n") -channelErr :: TChan LogMessage -> Text -> IO () +channelErr :: TChan LogMessage -> T.Text -> IO () channelErr ch txt = atomically $ writeTChan ch $ StdErr txt -channelErrLn :: TChan LogMessage -> Text -> IO () +channelErrLn :: TChan LogMessage -> T.Text -> IO () channelErrLn ch txt = channelErr ch (txt <> "\n") -errExit :: Int -> TChan LogMessage -> Text -> a -> IO a +errExit :: Int -> TChan LogMessage -> T.Text -> a -> IO a errExit exitStatus ch = errExit' exitStatus (channelErrLn ch) -errExit' :: Int -> (Text -> IO ()) -> Text -> a -> IO a +errExit' :: Int -> (T.Text -> IO ()) -> T.Text -> a -> IO a errExit' exitStatus logFun errorMessage dummyReturnValue = do logFun errorMessage - sleep 0.1 - _ <- exit $ ExitFailure exitStatus + Turtle.sleep 0.1 + _ <- Turtle.exit $ Turtle.ExitFailure exitStatus return dummyReturnValue -timestampPrefix :: Text -> IO Text +timestampPrefix :: T.Text -> IO T.Text timestampPrefix txt = do t <- getZonedTime - return $ format (s%"\thledger-flow "%s) (repr t) txt + return $ Turtle.format (Turtle.s%"\thledger-flow "%Turtle.s) (Turtle.repr t) txt -logToChannel :: TChan LogMessage -> Text -> IO () +logToChannel :: TChan LogMessage -> T.Text -> IO () logToChannel ch msg = do ts <- timestampPrefix msg channelErrLn ch ts @@ -130,90 +138,83 @@ terminateChannelLoop :: TChan LogMessage -> IO () terminateChannelLoop ch = atomically $ writeTChan ch Terminate -logVerbose :: HasVerbosity o => o -> TChan LogMessage -> Text -> IO () +logVerbose :: HasVerbosity o => o -> TChan LogMessage -> T.Text -> IO () logVerbose opts ch msg = if (verbose opts) then logToChannel ch msg else return () -descriptiveOutput :: Text -> Text -> Text +descriptiveOutput :: T.Text -> T.Text -> T.Text descriptiveOutput outputLabel outTxt = do if not (T.null outTxt) - then format (s%":\n"%s%"\n") outputLabel outTxt + then Turtle.format (Turtle.s%":\n"%Turtle.s%"\n") outputLabel outTxt else "" -logTimedAction :: HasVerbosity o => o -> TChan LogMessage -> Text -> [Text] - -> (TChan LogMessage -> Text -> IO ()) -> (TChan LogMessage -> Text -> IO ()) +logTimedAction :: HasVerbosity o => o -> TChan LogMessage -> T.Text -> [T.Text] + -> (TChan LogMessage -> T.Text -> IO ()) -> (TChan LogMessage -> T.Text -> IO ()) -> IO FullOutput -> IO FullTimedOutput logTimedAction opts ch cmdLabel extraCmdLabels stdoutLogger stderrLogger action = do - logVerbose opts ch $ format ("Begin: "%s) cmdLabel + logVerbose opts ch $ Turtle.format ("Begin: "%Turtle.s) cmdLabel if (List.null extraCmdLabels) then return () else logVerbose opts ch $ T.intercalate "\n" extraCmdLabels - timed@((ec, stdOut, stdErr), diff) <- time action + timed@((ec, stdOut, stdErr), diff) <- Turtle.time action stdoutLogger ch stdOut stderrLogger ch stdErr - logVerbose opts ch $ format ("End: "%s%" "%s%" ("%s%")") cmdLabel (repr ec) (repr diff) + logVerbose opts ch $ Turtle.format ("End: "%Turtle.s%" "%Turtle.s%" ("%Turtle.s%")") cmdLabel (Turtle.repr ec) (Turtle.repr diff) return timed -timeAndExitOnErr :: (HasSequential o, HasVerbosity o) => o -> TChan LogMessage -> Text - -> (TChan LogMessage -> Text -> IO ()) -> (TChan LogMessage -> Text -> IO ()) +timeAndExitOnErr :: (HasSequential o, HasVerbosity o) => o -> TChan LogMessage -> T.Text + -> (TChan LogMessage -> T.Text -> IO ()) -> (TChan LogMessage -> T.Text -> IO ()) -> ProcFun -> ProcInput -> IO FullTimedOutput timeAndExitOnErr opts ch cmdLabel = timeAndExitOnErr' opts ch cmdLabel [] -timeAndExitOnErr' :: (HasSequential o, HasVerbosity o) => o -> TChan LogMessage -> Text -> [Text] - -> (TChan LogMessage -> Text -> IO ()) -> (TChan LogMessage -> Text -> IO ()) +timeAndExitOnErr' :: (HasSequential o, HasVerbosity o) => o -> TChan LogMessage -> T.Text -> [T.Text] + -> (TChan LogMessage -> T.Text -> IO ()) -> (TChan LogMessage -> T.Text -> IO ()) -> ProcFun -> ProcInput -> IO FullTimedOutput timeAndExitOnErr' opts ch cmdLabel extraCmdLabels stdoutLogger stderrLogger procFun (cmd, args, stdInput) = do let action = procFun cmd args stdInput timed@((ec, stdOut, stdErr), _) <- logTimedAction opts ch cmdLabel extraCmdLabels stdoutLogger stderrLogger action case ec of - ExitFailure i -> do - let cmdText = format (s%" "%s) cmd $ showCmdArgs args + Turtle.ExitFailure i -> do + let cmdText = Turtle.format (Turtle.s%" "%Turtle.s) cmd $ showCmdArgs args let msgOut = descriptiveOutput "Standard output" stdOut let msgErr = descriptiveOutput "Error output" stdErr - let exitMsg = format ("\n=== Begin Error: "%s%" ===\nExternal command:\n"%s%"\nExit code "%d%"\n" - %s%s%"=== End Error: "%s%" ===\n") cmdLabel cmdText i msgOut msgErr cmdLabel + let exitMsg = Turtle.format ("\n=== Begin Error: "%Turtle.s%" ===\nExternal command:\n"%Turtle.s%"\nExit code "%Turtle.d%"\n" + %Turtle.s%Turtle.s%"=== End Error: "%Turtle.s%" ===\n") cmdLabel cmdText i msgOut msgErr cmdLabel errExit i ch exitMsg timed - ExitSuccess -> return timed + Turtle.ExitSuccess -> return timed procWithEmptyOutput :: ProcFun procWithEmptyOutput cmd args stdinput = do - ec <- proc cmd args stdinput + ec <- Turtle.proc cmd args stdinput return (ec, T.empty, T.empty) parAwareProc :: HasSequential o => o -> ProcFun -parAwareProc opts = if (sequential opts) then procWithEmptyOutput else procStrictWithErr +parAwareProc opts = if (sequential opts) then procWithEmptyOutput else Turtle.procStrictWithErr parAwareActions :: HasSequential o => o -> [IO a] -> IO [a] parAwareActions opts = parAwareFun opts where - parAwareFun op = if (sequential op) then sequence else single . shellToList . parallel + parAwareFun op = if (sequential op) then sequence else Turtle.single . shellToList . Turtle.parallel -inprocWithErrFun :: (Text -> IO ()) -> ProcInput -> Shell Line +inprocWithErrFun :: (T.Text -> IO ()) -> ProcInput -> Turtle.Shell Turtle.Line inprocWithErrFun errFun (cmd, args, standardInput) = do - result <- inprocWithErr cmd args standardInput + result <- Turtle.inprocWithErr cmd args standardInput case result of Right ln -> return ln Left ln -> do - (liftIO . errFun . lineToText) ln - empty + (Turtle.liftIO . errFun . Turtle.lineToText) ln + Turtle.empty -verboseTestFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> FilePath -> IO Bool +verboseTestFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> TurtlePath -> IO Bool verboseTestFile opts ch p = do - fileExists <- testfile p + fileExists <- Turtle.testfile p let rel = relativeToBase opts p if fileExists - then logVerbose opts ch $ format ("Found a " %fp%" file at '"%fp%"'") (basename rel) rel - else logVerbose opts ch $ format ("Did not find a "%fp%" file at '"%fp%"'") (basename rel) rel + then logVerbose opts ch $ Turtle.format ("Found '"%Turtle.fp%"'") rel + else logVerbose opts ch $ Turtle.format ("Looked for but did not find '"%Turtle.fp%"'") rel return fileExists -relativeToBase :: HasBaseDir o => o -> FilePath -> FilePath -relativeToBase opts = relativeToBase' (baseDir opts) - -relativeToBase' :: FilePath -> FilePath -> FilePath -relativeToBase' bd p = if forceTrailingSlash bd == forceTrailingSlash p then "./" else - fromMaybe p $ stripPrefix (forceTrailingSlash bd) p - groupPairs' :: (Eq a, Ord a) => [(a, b)] -> [(a, [b])] groupPairs' = map (\ll -> (fst . head $ ll, map snd ll)) . List.groupBy ((==) `on` fst) . List.sortBy (comparing fst) @@ -227,25 +228,25 @@ groupValuesBy :: (Ord k, Ord v) => (v -> k) -> [v] -> Map.Map k [v] groupValuesBy keyFun = groupPairs . pairBy keyFun -initialIncludeFilePath :: FilePath -> FilePath -initialIncludeFilePath p = (parent . parent . parent) p includeFileName p +initialIncludeFilePath :: TurtlePath -> TurtlePath +initialIncludeFilePath p = (Turtle.parent . Turtle.parent . Turtle.parent) p includeFileName p -parentIncludeFilePath :: FilePath -> FilePath -parentIncludeFilePath p = (parent . parent) p (filename p) +parentIncludeFilePath :: TurtlePath -> TurtlePath +parentIncludeFilePath p = (Turtle.parent . Turtle.parent) p (Turtle.filename p) -allYearsPath :: FilePath -> FilePath -allYearsPath = allYearsPath' directory +allYearsPath :: TurtlePath -> TurtlePath +allYearsPath = allYearsPath' Turtle.directory -allYearsPath' :: (FilePath -> FilePath) -> FilePath -> FilePath +allYearsPath' :: (TurtlePath -> TurtlePath) -> TurtlePath -> TurtlePath allYearsPath' dir p = dir p "all-years.journal" -allYearsFileName :: FilePath +allYearsFileName :: TurtlePath allYearsFileName = "all-years" <.> "journal" -groupIncludeFiles :: [FilePath] -> (InputFileBundle, InputFileBundle) +groupIncludeFiles :: [TurtlePath] -> (InputFileBundle, InputFileBundle) groupIncludeFiles = allYearIncludeFiles . groupIncludeFilesPerYear -groupIncludeFilesPerYear :: [FilePath] -> InputFileBundle +groupIncludeFilesPerYear :: [TurtlePath] -> InputFileBundle groupIncludeFilesPerYear [] = Map.empty groupIncludeFilesPerYear ps@(p:_) = case extractImportDirs p of Right _ -> (groupValuesBy initialIncludeFilePath) ps @@ -254,268 +255,216 @@ allYearIncludeFiles :: InputFileBundle -> (InputFileBundle, InputFileBundle) allYearIncludeFiles m = (m, yearsIncludeMap $ Map.keys m) -yearsIncludeMap :: [FilePath] -> InputFileBundle +yearsIncludeMap :: [TurtlePath] -> InputFileBundle yearsIncludeMap = groupValuesBy allYearsPath -docURL :: Line -> Text -docURL = format ("https://github.com/apauley/hledger-flow#"%l) - -lsDirs :: FilePath -> Shell FilePath -lsDirs = onlyDirs . ls +lsDirs :: TurtlePath -> Turtle.Shell TurtlePath +lsDirs = onlyDirs . Turtle.ls -onlyDirs :: Shell FilePath -> Shell FilePath -onlyDirs = excludeHiddenFiles . excludeWeirdPaths . filterPathsByFileStatus isDirectory +onlyDirs :: Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath +onlyDirs = excludeHiddenFiles . excludeWeirdPaths . filterPathsByFileStatus Turtle.isDirectory -onlyFiles :: Shell FilePath -> Shell FilePath -onlyFiles = excludeHiddenFiles . filterPathsByFileStatus isRegularFile +onlyFiles :: Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath +onlyFiles = excludeHiddenFiles . filterPathsByFileStatus Turtle.isRegularFile -filterPathsByFileStatus :: (FileStatus -> Bool) -> Shell FilePath -> Shell FilePath +filterPathsByFileStatus :: (Turtle.FileStatus -> Bool) -> Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath filterPathsByFileStatus filepred files = do files' <- shellToList files filtered <- filterPathsByFileStatus' filepred [] files' - select filtered + Turtle.select filtered -filterPathsByFileStatus' :: (FileStatus -> Bool) -> [FilePath] -> [FilePath] -> Shell [FilePath] +filterPathsByFileStatus' :: (Turtle.FileStatus -> Bool) -> [TurtlePath] -> [TurtlePath] -> Turtle.Shell [TurtlePath] filterPathsByFileStatus' _ acc [] = return acc filterPathsByFileStatus' filepred acc (file:files) = do - filestat <- stat file + filestat <- Turtle.stat file let filtered = if (filepred filestat) then file:acc else acc filterPathsByFileStatus' filepred filtered files -filterPaths :: (FilePath -> IO Bool) -> [FilePath] -> Shell [FilePath] +filterPaths :: (TurtlePath -> IO Bool) -> [TurtlePath] -> Turtle.Shell [TurtlePath] filterPaths = filterPaths' [] -filterPaths' :: [FilePath] -> (FilePath -> IO Bool) -> [FilePath] -> Shell [FilePath] +filterPaths' :: [TurtlePath] -> (TurtlePath -> IO Bool) -> [TurtlePath] -> Turtle.Shell [TurtlePath] filterPaths' acc _ [] = return acc filterPaths' acc filepred (file:files) = do - shouldInclude <- liftIO $ filepred file + shouldInclude <- Turtle.liftIO $ filepred file let filtered = if shouldInclude then file:acc else acc filterPaths' filtered filepred files -excludeHiddenFiles :: Shell FilePath -> Shell FilePath +excludeHiddenFiles :: Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath excludeHiddenFiles paths = do p <- paths - case (match (prefix ".") $ format fp $ filename p) of - [] -> select [p] - _ -> select [] + case (Turtle.match (Turtle.prefix ".") $ Turtle.format Turtle.fp $ Turtle.filename p) of + [] -> Turtle.select [p] + _ -> Turtle.select [] -excludeWeirdPaths :: Shell FilePath -> Shell FilePath -excludeWeirdPaths = findtree (suffix $ noneOf "_") +excludeWeirdPaths :: Turtle.Shell TurtlePath -> Turtle.Shell TurtlePath +excludeWeirdPaths = Turtle.findtree (Turtle.suffix $ Turtle.noneOf "_") -firstExistingFile :: [FilePath] -> IO (Maybe FilePath) +firstExistingFile :: [TurtlePath] -> IO (Maybe TurtlePath) firstExistingFile files = do case files of [] -> return Nothing file:fs -> do - exists <- testfile file + exists <- Turtle.testfile file if exists then return (Just file) else firstExistingFile fs -basenameLine :: FilePath -> Shell Line -basenameLine path = case (textToLine $ format fp $ basename path) of - Nothing -> die $ format ("Unable to determine basename from path: "%fp%"\n") path +basenameLine :: TurtlePath -> Turtle.Shell Turtle.Line +basenameLine path = case (Turtle.textToLine $ Turtle.format Turtle.fp $ Turtle.basename path) of + Nothing -> Turtle.die $ Turtle.format ("Unable to determine basename from path: "%Turtle.fp%"\n") path Just bn -> return bn -buildFilename :: [Line] -> Text -> FilePath -buildFilename identifiers ext = fromText (T.intercalate "-" (map lineToText identifiers)) <.> ext +buildFilename :: [Turtle.Line] -> T.Text -> TurtlePath +buildFilename identifiers ext = Turtle.fromText (T.intercalate "-" (map Turtle.lineToText identifiers)) <.> ext -shellToList :: Shell a -> Shell [a] -shellToList files = fold files Fold.list +shellToList :: Turtle.Shell a -> Turtle.Shell [a] +shellToList files = Turtle.fold files Fold.list -includeFileName :: FilePath -> FilePath -includeFileName = (<.> "journal") . fromText . (format (fp%"-include")) . dirname +includeFileName :: TurtlePath -> TurtlePath +includeFileName = (<.> "journal") . Turtle.fromText . (Turtle.format (Turtle.fp%"-include")) . Turtle.dirname -toIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> InputFileBundle -> IO (Map.Map FilePath Text) +toIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> InputFileBundle -> IO (Map.Map TurtlePath 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"] return $ (addPreamble . toIncludeFiles' preMap postMap) m -extraIncludes :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [FilePath] -> [Text] -> [FilePath] -> [FilePath] -> IO InputFileBundle +extraIncludes :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [TurtlePath] -> [T.Text] -> [TurtlePath] -> [TurtlePath] -> IO InputFileBundle extraIncludes opts ch = extraIncludes' opts ch Map.empty -extraIncludes' :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> InputFileBundle -> [FilePath] -> [Text] -> [FilePath] -> [FilePath] -> IO InputFileBundle +extraIncludes' :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> InputFileBundle -> [TurtlePath] -> [T.Text] -> [TurtlePath] -> [TurtlePath] -> IO InputFileBundle extraIncludes' _ _ acc [] _ _ _ = return acc extraIncludes' opts ch acc (file:files) extraSuffixes manualFiles prices = do extra <- extraIncludesForFile opts ch file extraSuffixes manualFiles prices extraIncludes' opts ch (Map.unionWith (++) acc extra) files extraSuffixes manualFiles prices -extraIncludesForFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> FilePath -> [Text] -> [FilePath] -> [FilePath] -> IO InputFileBundle +extraIncludesForFile :: (HasVerbosity o, HasBaseDir o) => o -> TChan LogMessage -> TurtlePath -> [T.Text] -> [TurtlePath] -> [TurtlePath] -> IO InputFileBundle extraIncludesForFile opts ch file extraSuffixes manualFiles prices = do - let dirprefix = fromText $ fst $ T.breakOn "-" $ format fp $ basename file - let fileNames = map (\suff -> fromText $ format (fp%"-"%s) dirprefix suff) extraSuffixes - let suffixFiles = map (directory file ) fileNames - let suffixDirFiles = map (directory file "_manual_" dirprefix ) manualFiles - let priceFiles = map (directory file ".." "prices" dirprefix ) prices + let dirprefix = Turtle.fromText $ fst $ T.breakOn "-" $ Turtle.format Turtle.fp $ Turtle.basename file + let fileNames = map (\suff -> Turtle.fromText $ Turtle.format (Turtle.fp%"-"%Turtle.s) dirprefix suff) extraSuffixes + let suffixFiles = map (Turtle.directory file ) fileNames + let suffixDirFiles = map (Turtle.directory file "_manual_" dirprefix ) manualFiles + let priceFiles = map (Turtle.directory file ".." "prices" dirprefix ) prices let extraFiles = suffixFiles ++ suffixDirFiles ++ priceFiles - filtered <- single $ filterPaths testfile extraFiles - let logMsg = format ("Looking for possible extra include files for '"%fp%"' among these "%d%" options: "%s%". Found "%d%": "%s) - (relativeToBase opts file) (length extraFiles) (repr $ relativeFilesAsText opts extraFiles) - (length filtered) (repr $ relativeFilesAsText opts filtered) + filtered <- Turtle.single $ filterPaths Turtle.testfile extraFiles + let logMsg = Turtle.format ("Looking for possible extra include files for '"%Turtle.fp%"' among these "%Turtle.d%" options: "%Turtle.s%". Found "%Turtle.d%": "%Turtle.s) + (relativeToBase opts file) (length extraFiles) (Turtle.repr $ relativeFilesAsText opts extraFiles) + (length filtered) (Turtle.repr $ relativeFilesAsText opts filtered) logVerbose opts ch logMsg return $ Map.fromList [(file, filtered)] -relativeFilesAsText :: HasBaseDir o => o -> [FilePath] -> [Text] -relativeFilesAsText opts ps = map ((format fp) . (relativeToBase opts)) ps +relativeFilesAsText :: HasBaseDir o => o -> [TurtlePath] -> [T.Text] +relativeFilesAsText opts ps = map ((Turtle.format Turtle.fp) . (relativeToBase opts)) ps -toIncludeFiles' :: InputFileBundle -> InputFileBundle -> InputFileBundle -> Map.Map FilePath Text +toIncludeFiles' :: InputFileBundle -> InputFileBundle -> InputFileBundle -> Map.Map TurtlePath T.Text toIncludeFiles' preMap postMap = Map.mapWithKey $ generatedIncludeText preMap postMap -addPreamble :: Map.Map FilePath Text -> Map.Map FilePath Text +addPreamble :: Map.Map TurtlePath T.Text -> Map.Map TurtlePath T.Text addPreamble = Map.map (\txt -> includePreamble <> "\n" <> txt) -toIncludeLine :: FilePath -> FilePath -> Text -toIncludeLine base file = format ("!include "%fp) $ relativeToBase' base file +toIncludeLine :: TurtlePath -> TurtlePath -> T.Text +toIncludeLine base file = Turtle.format ("!include "%Turtle.fp) $ relativeToBase' base file -generatedIncludeText :: InputFileBundle -> InputFileBundle -> FilePath -> [FilePath] -> Text +generatedIncludeText :: InputFileBundle -> InputFileBundle -> TurtlePath -> [TurtlePath] -> T.Text generatedIncludeText preMap postMap outputFile fs = do let preFiles = fromMaybe [] $ Map.lookup outputFile preMap let files = List.nub . List.sort $ fs let postFiles = fromMaybe [] $ Map.lookup outputFile postMap - let lns = map (toIncludeLine $ directory outputFile) $ preFiles ++ files ++ postFiles + let lns = map (toIncludeLine $ Turtle.directory outputFile) $ preFiles ++ files ++ postFiles T.intercalate "\n" $ lns ++ [""] -includePreamble :: Text +includePreamble :: T.Text includePreamble = "### Generated by hledger-flow - DO NOT EDIT ###\n" -groupAndWriteIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [FilePath] -> IO [FilePath] +groupAndWriteIncludeFiles :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> [TurtlePath] -> IO [TurtlePath] groupAndWriteIncludeFiles opts ch = writeFileMap opts ch . groupIncludeFiles -writeFiles :: IO (Map.Map FilePath Text) -> IO [FilePath] +writeFiles :: IO (Map.Map TurtlePath T.Text) -> IO [TurtlePath] writeFiles fileMap = do m <- fileMap writeFiles' m -writeFiles' :: Map.Map FilePath Text -> IO [FilePath] +writeFiles' :: Map.Map TurtlePath T.Text -> IO [TurtlePath] writeFiles' fileMap = do writeTextMap fileMap return $ Map.keys fileMap -writeTextMap :: Map.Map FilePath Text -> IO () -writeTextMap = Map.foldlWithKey (\a k v -> a <> writeTextFile k v) (return ()) +writeTextMap :: Map.Map TurtlePath T.Text -> IO () +writeTextMap = Map.foldlWithKey (\a k v -> a <> Turtle.writeTextFile k v) (return ()) -writeFileMap :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> (InputFileBundle, InputFileBundle) -> IO [FilePath] +writeFileMap :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> (InputFileBundle, InputFileBundle) -> IO [TurtlePath] writeFileMap opts ch (m, allYears) = do _ <- writeFiles' $ (addPreamble . toIncludeFiles' Map.empty Map.empty) allYears writeFiles . (toIncludeFiles opts ch) $ m -writeIncludesUpTo :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> FilePath -> [FilePath] -> IO [FilePath] +writeIncludesUpTo :: (HasBaseDir o, HasVerbosity o) => o -> TChan LogMessage -> TurtlePath -> [TurtlePath] -> IO [TurtlePath] writeIncludesUpTo _ _ _ [] = return [] writeIncludesUpTo opts ch stopAt journalFiles = do - let shouldStop = any (\dir -> dir == stopAt) $ map parent journalFiles + let shouldStop = any (\dir -> dir == stopAt) $ map Turtle.parent journalFiles if shouldStop then return journalFiles else do newJournalFiles <- groupAndWriteIncludeFiles opts ch journalFiles writeIncludesUpTo opts ch stopAt newJournalFiles -writeToplevelAllYearsInclude :: (HasBaseDir o, HasVerbosity o) => o -> IO [FilePath] +writeToplevelAllYearsInclude :: (HasBaseDir o, HasVerbosity o) => o -> IO [TurtlePath] writeToplevelAllYearsInclude opts = do - let allTop = Map.singleton (baseDir opts allYearsFileName) ["import" allYearsFileName] + let allTop = Map.singleton (turtleBaseDir opts allYearsFileName) ["import" allYearsFileName] writeFiles' $ (addPreamble . toIncludeFiles' Map.empty Map.empty) allTop -changeExtension :: Text -> FilePath -> FilePath -changeExtension ext path = (dropExtension path) <.> ext +changeExtension :: T.Text -> TurtlePath -> TurtlePath +changeExtension ext path = (Turtle.dropExtension path) <.> ext -changePathAndExtension :: FilePath -> Text -> FilePath -> FilePath +changePathAndExtension :: TurtlePath -> T.Text -> TurtlePath -> TurtlePath changePathAndExtension newOutputLocation newExt = (changeOutputPath newOutputLocation) . (changeExtension newExt) -changeOutputPath :: FilePath -> FilePath -> FilePath -changeOutputPath newOutputLocation srcFile = mconcat $ map changeSrcDir $ splitDirectories srcFile +changeOutputPath :: TurtlePath -> TurtlePath -> TurtlePath +changeOutputPath newOutputLocation srcFile = mconcat $ map changeSrcDir $ Turtle.splitDirectories srcFile where changeSrcDir file = if (file == "1-in/" || file == "2-preprocessed/") then newOutputLocation else file -errorMessageBaseDir :: FilePath -> Text -errorMessageBaseDir startDir = format ("\nUnable to find an hledger-flow import directory at '"%fp - %"' (or in any of its parent directories).\n\n" - %"Have a look at the documentation for more information:\n"%s%"\n") - startDir (docURL "getting-started") - -determineBaseDir :: Maybe FilePath -> IO (FilePath, FilePath) -determineBaseDir (Just suppliedDir) = determineBaseDir' suppliedDir -determineBaseDir Nothing = pwd >>= determineBaseDir' - -determineBaseDir' :: FilePath -> IO (FilePath, FilePath) -determineBaseDir' startDir = do - currentDir <- pwd - let absoluteStartDir = if relative startDir then collapse (currentDir startDir) else startDir - ebd <- determineBaseDirFromAbsoluteStartDir absoluteStartDir - case ebd of - Right bd -> return bd - Left t -> die t - -determineBaseDirFromAbsoluteStartDir :: FilePath -> IO (Either Text (FilePath, FilePath)) -determineBaseDirFromAbsoluteStartDir absoluteStartDir = determineBaseDirFromAbsoluteStartDir' absoluteStartDir absoluteStartDir - -determineBaseDirFromAbsoluteStartDir' :: FilePath -> FilePath -> IO (Either Text (FilePath, FilePath)) -determineBaseDirFromAbsoluteStartDir' startDir possibleBaseDir = do - possibleBDExists <- testdir possibleBaseDir - if not possibleBDExists then return $ Left $ format ("The provided directory does not exist: "%fp) possibleBaseDir - else - if relative startDir || relative possibleBaseDir then - return $ Left $ format ("Internal error: found a relative path when expecting only absolute paths:\n"%fp%"\n"%fp%"\n") startDir possibleBaseDir - else do - foundBaseDir <- testdir $ possibleBaseDir "import" - if foundBaseDir then - do - let baseD = forceTrailingSlash possibleBaseDir - let runDir = forceTrailingSlash $ relativeToBase' baseD startDir - return $ Right $ (baseD, runDir) - else do - let doneSearching = (possibleBaseDir `elem` ["/", "./"]) - if doneSearching - then return $ Left $ errorMessageBaseDir startDir - else determineBaseDirFromAbsoluteStartDir' startDir $ parent possibleBaseDir - - -dirOrPwd :: Maybe FilePath -> IO FilePath -dirOrPwd maybeBaseDir = fmap forceTrailingSlash (fromMaybe pwd $ fmap realpath maybeBaseDir) - -forceTrailingSlash :: FilePath -> FilePath -forceTrailingSlash p = directory (p "temp") - -importDirBreakdown :: FilePath -> [FilePath] +importDirBreakdown :: TurtlePath -> [TurtlePath] importDirBreakdown = importDirBreakdown' [] -importDirBreakdown' :: [FilePath] -> FilePath -> [FilePath] +importDirBreakdown' :: [TurtlePath] -> TurtlePath -> [TurtlePath] importDirBreakdown' acc path = do - let dir = directory path - if (dirname dir == "import" || (dirname dir == "")) + let dir = Turtle.directory path + if (Turtle.dirname dir == "import" || (Turtle.dirname dir == "")) then dir:acc - else importDirBreakdown' (dir:acc) $ parent dir + else importDirBreakdown' (dir:acc) $ Turtle.parent dir -extractImportDirs :: FilePath -> Either Text IT.ImportDirs +extractImportDirs :: TurtlePath -> Either T.Text IT.ImportDirs extractImportDirs inputFile = do case importDirBreakdown inputFile of [bd,owner,bank,account,filestate,year] -> Right $ IT.ImportDirs bd owner bank account filestate year _ -> do - Left $ format ("I couldn't find the right number of directories between \"import\" and the input file:\n"%fp + Left $ Turtle.format ("I couldn't find the right number of directories between \"import\" and the input file:\n"%Turtle.fp %"\n\nhledger-flow expects to find input files in this structure:\n"% "import/owner/bank/account/filestate/year/trxfile\n\n"% - "Have a look at the documentation for a detailed explanation:\n"%s) inputFile (docURL "input-files") + "Have a look at the documentation for a detailed explanation:\n"%Turtle.s) inputFile (docURL "input-files") -listOwners :: HasBaseDir o => o -> Shell FilePath -listOwners opts = fmap basename $ lsDirs $ (baseDir opts) "import" +listOwners :: HasBaseDir o => o -> Turtle.Shell TurtlePath +listOwners opts = fmap Turtle.basename $ lsDirs $ (turtleBaseDir opts) "import" -intPath :: Integer -> FilePath -intPath = fromText . (format d) +intPath :: Integer -> TurtlePath +intPath = Turtle.fromText . (Turtle.format Turtle.d) -includeYears :: TChan LogMessage -> FilePath -> IO [Integer] +includeYears :: TChan LogMessage -> TurtlePath -> IO [Integer] includeYears ch includeFile = do - txt <- readTextFile includeFile + txt <- Turtle.readTextFile includeFile case includeYears' txt of Left msg -> do channelErrLn ch msg return [] Right years -> return years -includeYears' :: Text -> Either Text [Integer] +includeYears' :: T.Text -> Either T.Text [Integer] includeYears' txt = case partitionEithers (includeYears'' txt) of (errors, []) -> do - let msg = format ("Unable to extract years from the following text:\n"%s%"\nErrors:\n"%s) txt (T.intercalate "\n" $ map T.pack errors) + let msg = Turtle.format ("Unable to extract years from the following text:\n"%Turtle.s%"\nErrors:\n"%Turtle.s) txt (T.intercalate "\n" $ map T.pack errors) Left msg (_, years) -> Right years -includeYears'' :: Text -> [Either String Integer] +includeYears'' :: T.Text -> [Either String Integer] includeYears'' txt = map extractDigits (T.lines txt) -extractDigits :: Text -> Either String Integer +extractDigits :: T.Text -> Either String Integer extractDigits txt = fmap fst $ (T.decimal . (T.filter isDigit)) txt diff --git a/src/Hledger/Flow/DocHelpers.hs b/src/Hledger/Flow/DocHelpers.hs new file mode 100644 --- /dev/null +++ b/src/Hledger/Flow/DocHelpers.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hledger.Flow.DocHelpers where + +import qualified Data.Text as T (Text) +import qualified Turtle as Turtle (Line, format, l) +import Turtle ((%)) + +docURL :: Turtle.Line -> T.Text +docURL = Turtle.format ("https://github.com/apauley/hledger-flow#"%Turtle.l) diff --git a/src/Hledger/Flow/Import/Types.hs b/src/Hledger/Flow/Import/Types.hs --- a/src/Hledger/Flow/Import/Types.hs +++ b/src/Hledger/Flow/Import/Types.hs @@ -1,13 +1,12 @@ module Hledger.Flow.Import.Types where -import Turtle -import Prelude hiding (FilePath, putStrLn) +import Hledger.Flow.PathHelpers (TurtlePath) -data ImportDirs = ImportDirs { importDir :: FilePath - , ownerDir :: FilePath - , bankDir :: FilePath - , accountDir :: FilePath - , stateDir :: FilePath - , yearDir :: FilePath +data ImportDirs = ImportDirs { importDir :: TurtlePath + , ownerDir :: TurtlePath + , bankDir :: TurtlePath + , accountDir :: TurtlePath + , stateDir :: TurtlePath + , yearDir :: TurtlePath } deriving (Show) diff --git a/src/Hledger/Flow/PathHelpers.hs b/src/Hledger/Flow/PathHelpers.hs new file mode 100644 --- /dev/null +++ b/src/Hledger/Flow/PathHelpers.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Hledger.Flow.PathHelpers where + +import Control.Monad.Catch (MonadThrow, Exception, throwM) +import Control.Monad.IO.Class (MonadIO) + +import qualified Data.Text as T +import qualified Path as Path +import qualified Path.IO as Path +import qualified Turtle as Turtle + +import Hledger.Flow.DocHelpers (docURL) + +type TurtlePath = Turtle.FilePath + +type AbsFile = Path.Path Path.Abs Path.File +type RelFile = Path.Path Path.Rel Path.File +type AbsDir = Path.Path Path.Abs Path.Dir +type RelDir = Path.Path Path.Rel Path.Dir + +data PathException = MissingBaseDir AbsDir | InvalidTurtleDir TurtlePath + deriving (Eq) + +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" ++ + T.unpack (docURL "getting-started") + show (InvalidTurtleDir d) = "Expected a directory but got this instead: " ++ Turtle.encodeString d + +instance Exception PathException + +fromTurtleAbsFile :: MonadThrow m => TurtlePath -> m AbsFile +fromTurtleAbsFile turtlePath = Path.parseAbsFile $ Turtle.encodeString turtlePath + +fromTurtleRelFile :: MonadThrow m => TurtlePath -> m RelFile +fromTurtleRelFile turtlePath = Path.parseRelFile $ Turtle.encodeString turtlePath + +fromTurtleAbsDir :: MonadThrow m => TurtlePath -> m AbsDir +fromTurtleAbsDir turtlePath = Path.parseAbsDir $ Turtle.encodeString turtlePath + +fromTurtleRelDir :: MonadThrow m => TurtlePath -> m RelDir +fromTurtleRelDir turtlePath = Path.parseRelDir $ Turtle.encodeString turtlePath + +turtleToAbsDir :: (MonadIO m, MonadThrow m) => AbsDir -> TurtlePath -> m AbsDir +turtleToAbsDir baseDir p = do + isDir <- Turtle.testdir p + if isDir + then Path.resolveDir baseDir $ Turtle.encodeString p + else throwM $ InvalidTurtleDir p + +pathToTurtle :: Path.Path b t -> TurtlePath +pathToTurtle = Turtle.decodeString . Path.toFilePath + +forceTrailingSlash :: TurtlePath -> TurtlePath +forceTrailingSlash p = Turtle.directory (p Turtle. "temp") diff --git a/src/Hledger/Flow/Reports.hs b/src/Hledger/Flow/Reports.hs --- a/src/Hledger/Flow/Reports.hs +++ b/src/Hledger/Flow/Reports.hs @@ -4,51 +4,56 @@ ( generateReports ) where -import Turtle hiding (stdout, stderr, proc) -import Prelude hiding (FilePath, putStrLn, writeFile) +import qualified Turtle as Turtle hiding (stdout, stderr, proc) +import Turtle ((%), (), (<.>)) +import Prelude hiding (putStrLn, writeFile) + import Hledger.Flow.RuntimeOptions import Hledger.Flow.Common +import Hledger.Flow.BaseDir (turtleBaseDir, relativeToBase) + import Control.Concurrent.STM import Data.Either import Data.Maybe import qualified Data.Text as T import qualified Hledger.Flow.Types as FlowTypes +import Hledger.Flow.PathHelpers (TurtlePath) import qualified Data.List as List -data ReportParams = ReportParams { ledgerFile :: FilePath +data ReportParams = ReportParams { ledgerFile :: TurtlePath , reportYears :: [Integer] - , outputDir :: FilePath + , outputDir :: TurtlePath } deriving (Show) -type ReportGenerator = RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> Integer -> IO (Either FilePath FilePath) +type ReportGenerator = RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> TurtlePath -> Integer -> IO (Either TurtlePath TurtlePath) generateReports :: RuntimeOptions -> IO () -generateReports opts = sh ( +generateReports opts = Turtle.sh ( do - ch <- liftIO newTChanIO - logHandle <- fork $ consoleChannelLoop ch - liftIO $ if (showOptions opts) then channelOutLn ch (repr opts) else return () - (reports, diff) <- time $ liftIO $ generateReports' opts ch + ch <- Turtle.liftIO newTChanIO + logHandle <- Turtle.fork $ consoleChannelLoop ch + Turtle.liftIO $ if (showOptions opts) then channelOutLn ch (Turtle.repr opts) else return () + (reports, diff) <- Turtle.time $ Turtle.liftIO $ generateReports' opts ch let failedAttempts = lefts reports - let failedText = if List.null failedAttempts then "" else format ("(and attempted to write "%d%" more) ") $ length failedAttempts - liftIO $ channelOutLn ch $ format ("Generated "%d%" reports "%s%"in "%s) (length (rights reports)) failedText $ repr diff - liftIO $ terminateChannelLoop ch - wait logHandle + let failedText = if List.null failedAttempts then "" else Turtle.format ("(and attempted to write "%Turtle.d%" more) ") $ length failedAttempts + Turtle.liftIO $ channelOutLn ch $ Turtle.format ("Generated "%Turtle.d%" reports "%Turtle.s%"in "%Turtle.s) (length (rights reports)) failedText $ Turtle.repr diff + Turtle.liftIO $ terminateChannelLoop ch + Turtle.wait logHandle ) -generateReports' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> IO [Either FilePath FilePath] +generateReports' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> IO [Either TurtlePath TurtlePath] generateReports' opts ch = do let wipMsg = "Report generation is still a work-in-progress - please let me know how this can be more useful.\n\n" <> "Keep an eye out for report-related pull requests and issues, and feel free to submit some of your own:\n" <> "https://github.com/apauley/hledger-flow/pulls\n" <> "https://github.com/apauley/hledger-flow/issues\n" channelOutLn ch wipMsg - owners <- single $ shellToList $ listOwners opts - ledgerEnvValue <- need "LEDGER_FILE" :: IO (Maybe Text) - let hledgerJournal = fromMaybe (baseDir opts allYearsFileName) $ fmap fromText ledgerEnvValue - hledgerJournalExists <- testfile hledgerJournal - _ <- if not hledgerJournalExists then die $ format ("Unable to find journal file: "%fp%"\nIs your LEDGER_FILE environment variable set correctly?") hledgerJournal else return () + owners <- Turtle.single $ shellToList $ listOwners opts + ledgerEnvValue <- Turtle.need "LEDGER_FILE" :: IO (Maybe T.Text) + let hledgerJournal = fromMaybe (turtleBaseDir opts allYearsFileName) $ fmap Turtle.fromText ledgerEnvValue + hledgerJournalExists <- Turtle.testfile hledgerJournal + _ <- if not hledgerJournalExists then Turtle.die $ Turtle.format ("Unable to find journal file: "%Turtle.fp%"\nIs your LEDGER_FILE environment variable set correctly?") hledgerJournal else return () let journalWithYears = journalFile opts [] let aggregateReportDir = outputReportDir opts ["all"] aggregateYears <- includeYears ch journalWithYears @@ -59,77 +64,81 @@ ownerParams <- ownerParameters opts ch owners let ownerWithAggregateParams = (if length owners > 1 then [aggregateParams] else []) ++ ownerParams let sharedOptions = ["--pretty-tables", "--depth", "2"] - let ownerWithAggregateReports = List.concat $ fmap (reportActions opts ch [incomeStatement sharedOptions, balanceSheet sharedOptions]) ownerWithAggregateParams + let ownerWithAggregateReports = List.concat $ fmap (reportActions opts ch [incomeStatement sharedOptions, incomeMonthlyStatement sharedOptions, balanceSheet sharedOptions]) ownerWithAggregateParams let ownerOnlyReports = List.concat $ fmap (reportActions opts ch [accountList, unknownTransactions]) ownerParams parAwareActions opts (aggregateOnlyReports ++ ownerWithAggregateReports ++ ownerOnlyReports) -reportActions :: RuntimeOptions -> TChan FlowTypes.LogMessage -> [ReportGenerator] -> ReportParams -> [IO (Either FilePath FilePath)] +reportActions :: RuntimeOptions -> TChan FlowTypes.LogMessage -> [ReportGenerator] -> ReportParams -> [IO (Either TurtlePath TurtlePath)] reportActions opts ch reports (ReportParams journal years reportsDir) = do y <- years map (\r -> r opts ch journal reportsDir y) reports accountList :: ReportGenerator -accountList opts ch journal reportsDir year = do +accountList opts ch journal baseOutDir year = do let reportArgs = ["accounts"] - generateReport opts ch journal reportsDir year ("accounts" <.> "txt") reportArgs (not . T.null) + generateReport opts ch journal year (baseOutDir intPath year) ("accounts" <.> "txt") reportArgs (not . T.null) unknownTransactions :: ReportGenerator -unknownTransactions opts ch journal reportsDir year = do +unknownTransactions opts ch journal baseOutDir year = do let reportArgs = ["print", "unknown"] - generateReport opts ch journal reportsDir year ("unknown-transactions" <.> "txt") reportArgs (not . T.null) + generateReport opts ch journal year (baseOutDir intPath year) ("unknown-transactions" <.> "txt") reportArgs (not . T.null) -incomeStatement :: [Text] -> ReportGenerator -incomeStatement sharedOptions opts ch journal reportsDir year = do +incomeStatement :: [T.Text] -> ReportGenerator +incomeStatement sharedOptions opts ch journal baseOutDir year = do let reportArgs = ["incomestatement"] ++ sharedOptions - generateReport opts ch journal reportsDir year ("income-expenses" <.> "txt") reportArgs (not . T.null) + generateReport opts ch journal year (baseOutDir intPath year) ("income-expenses" <.> "txt") reportArgs (not . T.null) -balanceSheet :: [Text] -> ReportGenerator -balanceSheet sharedOptions opts ch journal reportsDir year = do +incomeMonthlyStatement :: [T.Text] -> ReportGenerator +incomeMonthlyStatement sharedOptions opts ch journal baseOutDir year = do + let reportArgs = ["incomestatement"] ++ sharedOptions ++ ["--monthly"] + generateReport opts ch journal year (baseOutDir intPath year "monthly") ("income-expenses" <.> "txt") reportArgs (not . T.null) + +balanceSheet :: [T.Text] -> ReportGenerator +balanceSheet sharedOptions opts ch journal baseOutDir year = do let reportArgs = ["balancesheet"] ++ sharedOptions ++ ["--flat"] - generateReport opts ch journal reportsDir year ("balance-sheet" <.> "txt") reportArgs (not . T.null) + generateReport opts ch journal year (baseOutDir intPath year) ("balance-sheet" <.> "txt") reportArgs (not . T.null) transferBalance :: ReportGenerator -transferBalance opts ch journal reportsDir year = do +transferBalance opts ch journal baseOutDir year = do let reportArgs = ["balance", "--pretty-tables", "--quarterly", "--flat", "--no-total", "transfer"] - generateReport opts ch journal reportsDir year ("transfer-balance" <.> "txt") reportArgs (\txt -> (length $ T.lines txt) > 4) + generateReport opts ch journal year (baseOutDir intPath year) ("transfer-balance" <.> "txt") reportArgs (\txt -> (length $ T.lines txt) > 4) -generateReport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> FilePath -> Integer -> FilePath -> [Text] -> (Text -> Bool) -> IO (Either FilePath FilePath) -generateReport opts ch journal baseOutDir year fileName args successCheck = do - let reportsDir = baseOutDir intPath year - mktree reportsDir +generateReport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> Integer -> TurtlePath -> TurtlePath -> [T.Text] -> (T.Text -> Bool) -> IO (Either TurtlePath TurtlePath) +generateReport opts ch journal year reportsDir fileName args successCheck = do + Turtle.mktree reportsDir let outputFile = reportsDir fileName let relativeJournal = relativeToBase opts journal let relativeOutputFile = relativeToBase opts outputFile - let reportArgs = ["--file", format fp journal, "--period", repr year] ++ args - let reportDisplayArgs = ["--file", format fp relativeJournal, "--period", repr year] ++ args - let hledger = format fp $ FlowTypes.hlPath . hledgerInfo $ opts :: Text - let cmdLabel = format ("hledger "%s) $ showCmdArgs reportDisplayArgs - ((exitCode, stdOut, _), _) <- timeAndExitOnErr opts ch cmdLabel dummyLogger channelErr procStrictWithErr (hledger, reportArgs, empty) + let reportArgs = ["--file", Turtle.format Turtle.fp journal, "--period", Turtle.repr year] ++ args + let reportDisplayArgs = ["--file", Turtle.format Turtle.fp relativeJournal, "--period", Turtle.repr year] ++ args + let hledger = Turtle.format Turtle.fp $ FlowTypes.hlPath . hledgerInfo $ opts :: T.Text + let cmdLabel = Turtle.format ("hledger "%Turtle.s) $ showCmdArgs reportDisplayArgs + ((exitCode, stdOut, _), _) <- timeAndExitOnErr opts ch cmdLabel dummyLogger channelErr Turtle.procStrictWithErr (hledger, reportArgs, mempty) if (successCheck stdOut) then do - writeTextFile outputFile (cmdLabel <> "\n\n"<> stdOut) - logVerbose opts ch $ format ("Wrote "%fp) $ relativeOutputFile + Turtle.writeTextFile outputFile (cmdLabel <> "\n\n"<> stdOut) + logVerbose opts ch $ Turtle.format ("Wrote "%Turtle.fp) $ relativeOutputFile return $ Right outputFile else do - channelErrLn ch $ format ("Did not write '"%fp%"' ("%s%") "%s) relativeOutputFile cmdLabel (repr exitCode) - exists <- testfile outputFile - if exists then rm outputFile else return () + channelErrLn ch $ Turtle.format ("Did not write '"%Turtle.fp%"' ("%Turtle.s%") "%Turtle.s) relativeOutputFile cmdLabel (Turtle.repr exitCode) + exists <- Turtle.testfile outputFile + if exists then Turtle.rm outputFile else return () return $ Left outputFile -journalFile :: RuntimeOptions -> [FilePath] -> FilePath -journalFile opts dirs = (foldl () (baseDir opts) ("import":dirs)) allYearsFileName +journalFile :: RuntimeOptions -> [TurtlePath] -> TurtlePath +journalFile opts dirs = (foldl () (turtleBaseDir opts) ("import":dirs)) allYearsFileName -outputReportDir :: RuntimeOptions -> [FilePath] -> FilePath -outputReportDir opts dirs = foldl () (baseDir opts) ("reports":dirs) +outputReportDir :: RuntimeOptions -> [TurtlePath] -> TurtlePath +outputReportDir opts dirs = foldl () (turtleBaseDir opts) ("reports":dirs) -ownerParameters :: RuntimeOptions -> TChan FlowTypes.LogMessage -> [FilePath] -> IO [ReportParams] +ownerParameters :: RuntimeOptions -> TChan FlowTypes.LogMessage -> [TurtlePath] -> IO [ReportParams] ownerParameters opts ch owners = do let actions = map (ownerParameters' opts ch) owners parAwareActions opts actions -ownerParameters' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> FilePath -> IO ReportParams +ownerParameters' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath-> IO ReportParams ownerParameters' opts ch owner = do let ownerJournal = journalFile opts [owner] years <- includeYears ch ownerJournal diff --git a/src/Hledger/Flow/RuntimeOptions.hs b/src/Hledger/Flow/RuntimeOptions.hs --- a/src/Hledger/Flow/RuntimeOptions.hs +++ b/src/Hledger/Flow/RuntimeOptions.hs @@ -1,14 +1,15 @@ module Hledger.Flow.RuntimeOptions where -import Turtle -import Prelude hiding (FilePath, putStrLn) +import qualified Data.Text as T +import Prelude hiding (putStrLn) import Hledger.Flow.Types -data RuntimeOptions = RuntimeOptions { baseDir :: FilePath - , importRunDir :: FilePath +data RuntimeOptions = RuntimeOptions { baseDir :: BaseDir + , importRunDir :: RunDir , useRunDir :: Bool - , hfVersion :: Text + , onlyNewFiles :: Bool + , hfVersion :: T.Text , hledgerInfo :: HledgerInfo , sysInfo :: SystemInfo , verbose :: Bool @@ -18,10 +19,13 @@ deriving (Show) instance HasVerbosity RuntimeOptions where - verbose (RuntimeOptions _ _ _ _ _ _ v _ _) = v + verbose (RuntimeOptions _ _ _ _ _ _ _ v _ _) = v instance HasSequential RuntimeOptions where - sequential (RuntimeOptions _ _ _ _ _ _ _ _ sq) = sq + sequential (RuntimeOptions _ _ _ _ _ _ _ _ _ sq) = sq instance HasBaseDir RuntimeOptions where - baseDir (RuntimeOptions bd _ _ _ _ _ _ _ _) = bd + baseDir (RuntimeOptions bd _ _ _ _ _ _ _ _ _) = bd + +instance HasRunDir RuntimeOptions where + importRunDir (RuntimeOptions _ rd _ _ _ _ _ _ _ _) = rd diff --git a/src/Hledger/Flow/Types.hs b/src/Hledger/Flow/Types.hs --- a/src/Hledger/Flow/Types.hs +++ b/src/Hledger/Flow/Types.hs @@ -4,19 +4,24 @@ module Hledger.Flow.Types where -import Turtle -import Prelude hiding (FilePath, putStrLn) +import qualified Turtle as Turtle (ExitCode, NominalDiffTime, Shell, Line) +import qualified Data.Text as T import Data.Version -data LogMessage = StdOut Text | StdErr Text | Terminate deriving (Show) -type FullOutput = (ExitCode, Text, Text) -type FullTimedOutput = (FullOutput, NominalDiffTime) +import Hledger.Flow.PathHelpers -type ProcFun = Text -> [Text] -> Shell Line -> IO FullOutput -type ProcInput = (Text, [Text], Shell Line) +type BaseDir = AbsDir +type RunDir = RelDir -data HledgerInfo = HledgerInfo { hlPath :: FilePath - , hlVersion :: Text +data LogMessage = StdOut T.Text | StdErr T.Text | Terminate deriving (Show) +type FullOutput = (Turtle.ExitCode, T.Text, T.Text) +type FullTimedOutput = (FullOutput, Turtle.NominalDiffTime) + +type ProcFun = T.Text -> [T.Text] -> Turtle.Shell Turtle.Line -> IO FullOutput +type ProcInput = (T.Text, [T.Text], Turtle.Shell Turtle.Line) + +data HledgerInfo = HledgerInfo { hlPath :: TurtlePath + , hlVersion :: T.Text } deriving (Show) @@ -31,7 +36,10 @@ verbose :: a -> Bool class HasBaseDir a where - baseDir :: a -> FilePath + baseDir :: a -> BaseDir + +class HasRunDir a where + importRunDir :: a -> RunDir class HasSequential a where sequential :: a -> Bool diff --git a/test/BaseDir/Integration.hs b/test/BaseDir/Integration.hs new file mode 100644 --- /dev/null +++ b/test/BaseDir/Integration.hs @@ -0,0 +1,121 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE QuasiQuotes #-} + +module BaseDir.Integration (tests) where + +import Control.Exception (try) +import Test.HUnit + +import Path +import Path.IO + +import qualified Turtle as Turtle +import qualified Data.Text as T + +import Hledger.Flow.Common +import Hledger.Flow.Types (BaseDir, RunDir) +import Hledger.Flow.BaseDir (determineBaseDir) +import Hledger.Flow.PathHelpers + +assertSubDirsForDetermineBaseDir :: AbsDir -> BaseDir -> [Path.Path b Dir] -> IO () +assertSubDirsForDetermineBaseDir initialPwd expectedBaseDir importDirs = do + _ <- sequence $ map (assertDetermineBaseDir initialPwd expectedBaseDir) importDirs + return () + +assertDetermineBaseDir :: AbsDir -> BaseDir -> Path.Path b Dir -> IO () +assertDetermineBaseDir initialPwd expectedBaseDir subDir = do + setCurrentDir initialPwd + (bd1, runDir1) <- determineBaseDir $ Just $ pathToTurtle subDir + assertFindTestFileUsingRundir bd1 runDir1 + + setCurrentDir subDir + (bd2, runDir2) <- determineBaseDir Nothing + assertFindTestFileUsingRundir bd2 runDir2 + + (bd3, runDir3) <- determineBaseDir $ Just "." + assertFindTestFileUsingRundir bd3 runDir3 + + (bd4, runDir4) <- determineBaseDir $ Just "./" + assertFindTestFileUsingRundir bd4 runDir4 + + setCurrentDir initialPwd + let msg dir = "determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - " ++ (show dir) + _ <- sequence $ map (\dir -> assertEqual (msg dir) expectedBaseDir dir) [bd1, bd2, bd3, bd4] + return () + +assertFindTestFileUsingRundir :: BaseDir -> RunDir -> IO () +assertFindTestFileUsingRundir baseDir runDir = do + let absRunDir = baseDir runDir + + found <- Turtle.single $ fmap head $ shellToList $ Turtle.find (Turtle.has "test-file.txt") $ pathToTurtle absRunDir + fileContents <- Turtle.readTextFile found + assertEqual "We should find our test file by searching from the returned runDir" (T.pack $ "The expected base dir is " ++ show baseDir) fileContents + +assertCurrentDirVariations :: AbsDir -> RelDir -> IO () +assertCurrentDirVariations absoluteTempDir bdRelativeToTempDir = do + let absBaseDir = absoluteTempDir bdRelativeToTempDir + + setCurrentDir absBaseDir + (bd1, runDir1) <- determineBaseDir Nothing + (bd2, runDir2) <- determineBaseDir $ Just "." + (bd3, runDir3) <- determineBaseDir $ Just "./" + (bd4, runDir4) <- determineBaseDir $ Just $ pathToTurtle absBaseDir + + let msg label dir = "When pwd is the base dir, determineBaseDir returns the same " ++ label ++ ", regardless of the input variation. " ++ (show dir) + _ <- sequence $ map (\dir -> assertEqual (msg "baseDir" dir) absBaseDir dir) [bd1, bd2, bd3, bd4] + _ <- sequence $ map (\dir -> assertEqual (msg "runDir" dir) [reldir|.|] dir) [runDir1, runDir2, runDir3, runDir4] + return () + +testBaseDirWithTempDir :: AbsDir -> AbsDir -> IO () +testBaseDirWithTempDir initialPwd absoluteTempDir = do + error1 <- try $ determineBaseDir $ Just "/path/to/dir" + assertEqual "determineBaseDir produces an error message when given a non-existant dir" (Left $ InvalidTurtleDir "/path/to/dir") error1 + + let unrelatedDir = absoluteTempDir [reldir|unrelated|] + createDir unrelatedDir + + bdUnrelated <- try $ determineBaseDir $ Just (pathToTurtle unrelatedDir) + assertEqual "determineBaseDir produces an error message when it cannot find a baseDir" (Left $ MissingBaseDir unrelatedDir) bdUnrelated + + let baseDir = [reldir|bd1|] + let importDir = baseDir [reldir|import|] + let ownerDir = importDir [reldir|john|] + let bankDir = ownerDir [reldir|mybank|] + let accDir = bankDir [reldir|myacc|] + let inDir = accDir [reldir|1-in|] + let yearDir = inDir [reldir|2019|] + let subDirs = [yearDir, inDir, accDir, bankDir, ownerDir, importDir, baseDir] :: [RelDir] + + createDirIfMissing True $ absoluteTempDir yearDir + + let fictionalDir = absoluteTempDir ownerDir [reldir|fictionalDir|] + errorSub <- try $ determineBaseDir $ Just $ pathToTurtle fictionalDir + assertEqual "determineBaseDir produces an error message when given a non-existant subdir of a valid basedir" (Left $ InvalidTurtleDir $ pathToTurtle fictionalDir) errorSub + + assertCurrentDirVariations absoluteTempDir baseDir + + relativeTempDir <- makeRelative initialPwd absoluteTempDir + let subDirsRelativeToTop = map (relativeTempDir ) subDirs + let absoluteSubDirs = map (absoluteTempDir ) subDirs + + let absoluteBaseDir = absoluteTempDir baseDir + + Turtle.writeTextFile (pathToTurtle $ absoluteTempDir yearDir [relfile|test-file.txt|]) (T.pack $ "The expected base dir is " ++ show absoluteBaseDir) + + assertSubDirsForDetermineBaseDir absoluteTempDir absoluteBaseDir subDirs + assertSubDirsForDetermineBaseDir absoluteTempDir absoluteBaseDir absoluteSubDirs + assertSubDirsForDetermineBaseDir initialPwd absoluteBaseDir subDirsRelativeToTop + return () + +testDetermineBaseDir :: Test +testDetermineBaseDir = TestCase ( + do + initialPwd <- getCurrentDir + let tmpbase = initialPwd [reldir|test|] [reldir|tmp|] + createDirIfMissing True tmpbase + withTempDir tmpbase "hlflowtest" $ testBaseDirWithTempDir initialPwd + ) + +tests :: Test +tests = TestList [testDetermineBaseDir] diff --git a/test/CSVImport/Integration.hs b/test/CSVImport/Integration.hs --- a/test/CSVImport/Integration.hs +++ b/test/CSVImport/Integration.hs @@ -5,24 +5,27 @@ import Test.HUnit import Turtle -import Prelude hiding (FilePath) import qualified Data.Map.Strict as Map import qualified Data.List as List (sort) import TestHelpers import Hledger.Flow.Common +import Hledger.Flow.PathHelpers import Control.Concurrent.STM testExtraIncludesForFile :: Test testExtraIncludesForFile = TestCase ( sh ( do - tmpdir <- using (mktempdir "." "hlflow") - let importedJournals = map (tmpdir ) journalFiles :: [FilePath] + currentDir <- pwd + tmpdir <- using (mktempdir currentDir "hlflow") + tmpdirAbsPath <- fromTurtleAbsDir tmpdir + + let importedJournals = map (tmpdir ) journalFiles :: [TurtlePath] let accountDir = "import/john/bogartbank/savings" let opening = tmpdir accountDir "2017-opening.journal" let closing = tmpdir accountDir "2017-closing.journal" - let hidden = map (tmpdir ) hiddenFiles :: [FilePath] + let hidden = map (tmpdir ) hiddenFiles :: [TurtlePath] touchAll $ importedJournals ++ hidden let accountInclude = tmpdir accountDir "2017-include.journal" @@ -30,18 +33,18 @@ ch <- liftIO newTChanIO - extraOpening1 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["opening.journal"] [] [] + extraOpening1 <- liftIO $ extraIncludesForFile (defaultOpts tmpdirAbsPath) ch accountInclude ["opening.journal"] [] [] liftIO $ assertEqual "The opening journal should not be included when it is not on disk" expectedEmpty extraOpening1 - extraClosing1 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["closing.journal"] [] [] + extraClosing1 <- liftIO $ extraIncludesForFile (defaultOpts tmpdirAbsPath) ch accountInclude ["closing.journal"] [] [] liftIO $ assertEqual "The closing journal should not be included when it is not on disk" expectedEmpty extraClosing1 touchAll [opening, closing] - extraOpening2 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["opening.journal"] [] [] + extraOpening2 <- liftIO $ extraIncludesForFile (defaultOpts tmpdirAbsPath) ch accountInclude ["opening.journal"] [] [] liftIO $ assertEqual "The opening journal should be included when it is on disk" [(accountInclude, [opening])] extraOpening2 - extraClosing2 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch accountInclude ["closing.journal"] [] [] + extraClosing2 <- liftIO $ extraIncludesForFile (defaultOpts tmpdirAbsPath) ch accountInclude ["closing.journal"] [] [] liftIO $ assertEqual "The closing journal should be included when it is on disk" [(accountInclude, [closing])] extraClosing2 )) @@ -49,8 +52,11 @@ testExtraIncludesPrices = TestCase ( sh ( do - tmpdir <- using (mktempdir "." "hlflow") - let importedJournals = map (tmpdir ) journalFiles :: [FilePath] + currentDir <- pwd + tmpdir <- using (mktempdir currentDir "hlflow") + tmpdirAbsPath <- fromTurtleAbsDir tmpdir + + let importedJournals = map (tmpdir ) journalFiles :: [TurtlePath] touchAll $ importedJournals let priceFile = "prices" "2020" "prices.journal" @@ -60,13 +66,13 @@ ch <- liftIO newTChanIO - price1 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch includeFile [] [] ["prices.journal"] + price1 <- liftIO $ extraIncludesForFile (defaultOpts tmpdirAbsPath) ch includeFile [] [] ["prices.journal"] liftIO $ assertEqual "The price file should not be included when it is not on disk" expectedEmpty price1 touchAll [tmpdir priceFile] let expectedPricePath = tmpdir "import" ".." priceFile - price2 <- liftIO $ extraIncludesForFile (defaultOpts tmpdir) ch includeFile [] [] ["prices.journal"] + price2 <- liftIO $ extraIncludesForFile (defaultOpts tmpdirAbsPath) ch includeFile [] [] ["prices.journal"] liftIO $ assertEqual "The price file should be included when it is on disk" [(includeFile, [expectedPricePath])] price2 )) @@ -74,7 +80,10 @@ testIncludesPrePost = TestCase ( sh ( do - tmpdir <- using (mktempdir "." "hlflow") + currentDir <- pwd + tmpdir <- using (mktempdir currentDir "hlflow") + tmpdirAbsPath <- fromTurtleAbsDir tmpdir + let ownerDir = tmpdir "import" "john" let includeFile = ownerDir "2019-include.journal" let pre = ownerDir "_manual_" "2019" "pre-import.journal" @@ -85,7 +94,7 @@ ownerDir "bank2" "2019-include.journal"] ch <- liftIO newTChanIO - fileMap <- liftIO $ toIncludeFiles (defaultOpts tmpdir) ch includeMap + fileMap <- liftIO $ toIncludeFiles (defaultOpts tmpdirAbsPath) ch includeMap let expectedText = includePreamble <> "\n" <> "!include _manual_/2019/pre-import.journal\n" <> "!include bank1/2019-include.journal\n" @@ -99,7 +108,10 @@ testIncludesOpeningClosing = TestCase ( sh ( do - tmpdir <- using (mktempdir "." "hlflow") + currentDir <- pwd + tmpdir <- using (mktempdir currentDir "hlflow") + tmpdirAbsPath <- fromTurtleAbsDir tmpdir + let ownerDir = tmpdir "import/john" let accountDir = ownerDir "bank1" "savings" let includeFile = accountDir "2019-include.journal" @@ -110,7 +122,7 @@ let includeMap = Map.singleton includeFile [accountDir "3-journal" "2019" "2019-01-30.journal"] ch <- liftIO newTChanIO - fileMap <- liftIO $ toIncludeFiles (defaultOpts tmpdir) ch includeMap + fileMap <- liftIO $ toIncludeFiles (defaultOpts tmpdirAbsPath) ch includeMap let expectedText = includePreamble <> "\n" <> "!include 2019-opening.journal\n" <> "!include 3-journal/2019/2019-01-30.journal\n" @@ -123,7 +135,10 @@ testIncludesPrices = TestCase ( sh ( do - tmpdir <- using (mktempdir "." "hlflow") + currentDir <- pwd + tmpdir <- using (mktempdir currentDir "hlflow") + tmpdirAbsPath <- fromTurtleAbsDir tmpdir + let importDir = tmpdir "import" let includeFile = importDir "2020-include.journal" let prices = tmpdir "prices" "2020" "prices.journal" @@ -134,7 +149,7 @@ let includeMap = Map.singleton includeFile [importDir "john" "2020-include.journal"] ch <- liftIO newTChanIO - fileMap <- liftIO $ toIncludeFiles (defaultOpts tmpdir) ch includeMap + fileMap <- liftIO $ toIncludeFiles (defaultOpts tmpdirAbsPath) ch includeMap let expectedText = includePreamble <> "\n" <> "!include _manual_/2020/pre-import.journal\n" <> "!include john/2020-include.journal\n" @@ -148,10 +163,13 @@ testWriteIncludeFiles = TestCase ( sh ( do - tmpdir <- using (mktempdir "." "hlflow") - let importedJournals = map (tmpdir ) journalFiles :: [FilePath] - let extras = map (tmpdir ) extraFiles :: [FilePath] - let hidden = map (tmpdir ) hiddenFiles :: [FilePath] + currentDir <- pwd + tmpdir <- using (mktempdir currentDir "hlflow") + tmpdirAbsPath <- fromTurtleAbsDir tmpdir + + let importedJournals = map (tmpdir ) journalFiles :: [TurtlePath] + let extras = map (tmpdir ) extraFiles :: [TurtlePath] + let hidden = map (tmpdir ) hiddenFiles :: [TurtlePath] touchAll $ importedJournals ++ extras ++ hidden let jane1 = tmpdir "import/jane/bogartbank/checking/2018-include.journal" @@ -175,7 +193,7 @@ john1, john2, john3, john4, john5, john6, john7, john8] ch <- liftIO newTChanIO - reportedAsWritten <- liftIO $ groupAndWriteIncludeFiles (defaultOpts tmpdir) ch importedJournals + reportedAsWritten <- liftIO $ groupAndWriteIncludeFiles (defaultOpts tmpdirAbsPath) ch importedJournals liftIO $ assertEqual "groupAndWriteIncludeFiles should return which files it wrote" expectedIncludes reportedAsWritten let allYears = [tmpdir "import/jane/bogartbank/checking/all-years.journal", diff --git a/test/CSVImport/Unit.hs b/test/CSVImport/Unit.hs --- a/test/CSVImport/Unit.hs +++ b/test/CSVImport/Unit.hs @@ -1,21 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE QuasiQuotes #-} module CSVImport.Unit where import Test.HUnit +import Path import Turtle -import Prelude hiding (FilePath) import qualified Data.Map.Strict as Map import Control.Concurrent.STM import TestHelpers +import Hledger.Flow.PathHelpers (TurtlePath) import Hledger.Flow.Common import Data.Either import qualified Data.Text as T -groupedJaneBogart :: Map.Map FilePath [FilePath] +groupedJaneBogart :: Map.Map TurtlePath [TurtlePath] groupedJaneBogart = [ ("./import/jane/bogartbank/checking/2018-include.journal", ["import/jane/bogartbank/checking/3-journal/2018/2018-12-30.journal"]), @@ -26,7 +28,7 @@ ("./import/jane/bogartbank/savings/2018-include.journal", ["import/jane/bogartbank/savings/3-journal/2018/2018-01-30.journal"])] -groupedJaneOther :: Map.Map FilePath [FilePath] +groupedJaneOther :: Map.Map TurtlePath [TurtlePath] groupedJaneOther = [ ("./import/jane/otherbank/creditcard/2017-include.journal", ["import/jane/otherbank/creditcard/3-journal/2017/2017-12-30.journal"]), @@ -37,7 +39,7 @@ ("./import/jane/otherbank/investments/2019-include.journal", ["import/jane/otherbank/investments/3-journal/2019/2019-01-30.journal"])] -groupedJohnBogart :: Map.Map FilePath [FilePath] +groupedJohnBogart :: Map.Map TurtlePath [TurtlePath] groupedJohnBogart = [ ("./import/john/bogartbank/checking/2018-include.journal", ["import/john/bogartbank/checking/3-journal/2018/2018-11-30.journal", @@ -53,7 +55,7 @@ ["import/john/bogartbank/savings/3-journal/2018/2018-02-30.journal", "import/john/bogartbank/savings/3-journal/2018/2018-01-30.journal"])] -groupedJohnOther :: Map.Map FilePath [FilePath] +groupedJohnOther :: Map.Map TurtlePath [TurtlePath] groupedJohnOther = [ ("./import/john/otherbank/creditcard/2017-include.journal", ["import/john/otherbank/creditcard/3-journal/2017/2017-12-30.journal"]), @@ -64,7 +66,7 @@ ("./import/john/otherbank/investments/2019-include.journal", ["import/john/otherbank/investments/3-journal/2019/2019-01-30.journal"])] -groupedIncludeFiles :: Map.Map FilePath [FilePath] +groupedIncludeFiles :: Map.Map TurtlePath [TurtlePath] groupedIncludeFiles = groupedJaneBogart <> groupedJaneOther <> groupedJohnBogart <> groupedJohnOther @@ -99,21 +101,21 @@ testGroupIncludeFilesTinySet = TestCase ( do let journals1 = [ "import/jane/bogartbank/savings/3-journals/2017/2017-12-30.journal"] - let expected1 = [("./import/jane/bogartbank/savings/2017-include.journal", journals1)] :: Map.Map FilePath [FilePath] + let expected1 = [("./import/jane/bogartbank/savings/2017-include.journal", journals1)] :: Map.Map TurtlePath [TurtlePath] let expectedAllYears1 = [("./import/jane/bogartbank/savings/all-years.journal", ["./import/jane/bogartbank/savings/2017-include.journal"])] let (group1, allYears1) = groupIncludeFiles journals1 assertEqual "groupIncludeFiles small allYears 1" expectedAllYears1 allYears1 assertEqual "groupIncludeFiles small set 1" expected1 group1 - let journals2 = [(fst . head . Map.toList) expected1] :: [FilePath] - let expected2 = [("./import/jane/bogartbank/2017-include.journal", journals2)] :: Map.Map FilePath [FilePath] + let journals2 = [(fst . head . Map.toList) expected1] :: [TurtlePath] + let expected2 = [("./import/jane/bogartbank/2017-include.journal", journals2)] :: Map.Map TurtlePath [TurtlePath] let expectedAllYears2 = [("./import/jane/bogartbank/all-years.journal", ["./import/jane/bogartbank/2017-include.journal"])] let (group2, allYears2) = groupIncludeFiles journals2 assertEqual "groupIncludeFiles small allYears 2" expectedAllYears2 allYears2 assertEqual "groupIncludeFiles small set 2" expected2 group2 - let journals3 = [(fst . head . Map.toList) expected2] :: [FilePath] - let expected3 = [("./import/jane/2017-include.journal", journals3)] :: Map.Map FilePath [FilePath] + let journals3 = [(fst . head . Map.toList) expected2] :: [TurtlePath] + let expected3 = [("./import/jane/2017-include.journal", journals3)] :: Map.Map TurtlePath [TurtlePath] let expectedAllYears3 = [("./import/jane/all-years.journal", ["./import/jane/2017-include.journal"])] let (group3, allYears3) = groupIncludeFiles journals3 assertEqual "groupIncludeFiles small allYears 3" expectedAllYears3 allYears3 @@ -420,7 +422,7 @@ "!include import/john/bogartbank/savings/3-journal/2018/2018-02-30.journal\n")] ch <- newTChanIO - txt <- toIncludeFiles (defaultOpts ".") ch groupedJohnBogart + txt <- toIncludeFiles (defaultOpts [absdir|/|]) ch groupedJohnBogart assertEqual "Convert a grouped map of paths, to a map with text contents for each file" expected txt) tests :: Test diff --git a/test/Common/Integration.hs b/test/Common/Integration.hs --- a/test/Common/Integration.hs +++ b/test/Common/Integration.hs @@ -5,11 +5,10 @@ import Test.HUnit import Turtle -import Prelude hiding (FilePath) import qualified Data.List as List (sort) -import qualified Data.Text as T import TestHelpers +import Hledger.Flow.PathHelpers (TurtlePath) import Hledger.Flow.Common testHiddenFiles :: Test @@ -19,9 +18,9 @@ let tmpbase = "." "test" "tmp" mktree tmpbase tmpdir <- using (mktempdir tmpbase "hlflowtest") - let tmpJournals = map (tmpdir ) journalFiles :: [FilePath] - let tmpExtras = map (tmpdir ) extraFiles :: [FilePath] - let tmpHidden = map (tmpdir ) hiddenFiles :: [FilePath] + let tmpJournals = map (tmpdir ) journalFiles :: [TurtlePath] + let tmpExtras = map (tmpdir ) extraFiles :: [TurtlePath] + let tmpHidden = map (tmpdir ) hiddenFiles :: [TurtlePath] let onDisk = List.sort $ tmpJournals ++ tmpExtras ++ tmpHidden touchAll onDisk filtered <- (fmap List.sort) $ shellToList $ onlyFiles $ select onDisk @@ -30,113 +29,6 @@ ) ) -assertSubDirsForDetermineBaseDir :: FilePath -> FilePath -> [FilePath] -> IO () -assertSubDirsForDetermineBaseDir initialPwd expectedBaseDir importDirs = do - _ <- sequence $ map (assertDetermineBaseDir initialPwd expectedBaseDir) importDirs - return () - -assertDetermineBaseDir :: FilePath -> FilePath -> FilePath -> IO () -assertDetermineBaseDir initialPwd expectedBaseDir subDir = do - cd initialPwd - (bd1, runDir1) <- determineBaseDir $ Just subDir - assertFindTestFileUsingRundir bd1 runDir1 - - cd subDir - (bd2, runDir2) <- determineBaseDir Nothing - assertFindTestFileUsingRundir bd2 runDir2 - - (bd3, runDir3) <- determineBaseDir $ Just "." - assertFindTestFileUsingRundir bd3 runDir3 - - (bd4, runDir4) <- determineBaseDir $ Just "./" - assertFindTestFileUsingRundir bd4 runDir4 - - cd initialPwd - let msg = format ("determineBaseDir searches from pwd upwards until it finds a dir containing 'import' - "%fp) subDir - _ <- sequence $ map (assertEqual (T.unpack msg) expectedBaseDir) [bd1, bd2, bd3, bd4] - return () - -assertFindTestFileUsingRundir :: FilePath -> FilePath -> IO () -assertFindTestFileUsingRundir baseDir runDir = do - let absRunDir = baseDir runDir - let dirTestMsg = format ("Directories should end with a slash: "%fp) - _ <- sequence $ map (\dir -> assertEqual (T.unpack $ dirTestMsg dir) (forceTrailingSlash dir) dir) [baseDir, runDir, absRunDir] - - found <- single $ fmap head $ shellToList $ find (has "test-file.txt") absRunDir - fileContents <- readTextFile found - assertEqual "We should find our test file by searching from the returned runDir" (format ("The expected base dir is "%fp) baseDir) fileContents - -assertCurrentDirVariations :: FilePath -> FilePath -> IO () -assertCurrentDirVariations absoluteTempDir bdRelativeToTempDir = do - let absBaseDirNoTrailingSlash = absoluteTempDir bdRelativeToTempDir - let absBaseDirWithTrailingSlash = forceTrailingSlash absBaseDirNoTrailingSlash - assertEqual "Test the test: with and without slashes should really be that" '/' (T.last $ format fp absBaseDirWithTrailingSlash) - assertBool "Test the test: with and without slashes should really be that" ('/' /= (T.last $ format fp absBaseDirNoTrailingSlash)) - - cd absBaseDirNoTrailingSlash - (bd1, runDir1) <- liftIO $ determineBaseDir Nothing - (bd2, runDir2) <- liftIO $ determineBaseDir $ Just "." - (bd3, runDir3) <- liftIO $ determineBaseDir $ Just "./" - (bd4, runDir4) <- liftIO $ determineBaseDir $ Just absBaseDirNoTrailingSlash - (bd5, runDir5) <- liftIO $ determineBaseDir $ Just absBaseDirWithTrailingSlash - - let msg label dir = format ("When pwd is the base dir, determineBaseDir returns the same "%s%", regardless of the input variation. "%s%": "%fp) label label dir - _ <- sequence $ map (\dir -> assertEqual (T.unpack $ msg "baseDir" dir) (forceTrailingSlash dir) dir) [bd1, bd2, bd3, bd4,bd5] - _ <- sequence $ map (\dir -> assertEqual (T.unpack $ msg "runDir" dir) "./" dir) [runDir1, runDir2, runDir3, runDir4, runDir5] - -- _ <- sequence $ map (\dir -> assertEqual (T.unpack $ msg "runDir" dir) "./" dir) [runDir2, runDir3, runDir4, runDir5] - return () - -testDetermineBaseDir :: Test -testDetermineBaseDir = TestCase ( - sh ( - do - error1 <- liftIO $ determineBaseDirFromAbsoluteStartDir "/path/to/dir" - liftIO $ assertEqual "determineBaseDir produces an error message when given a non-existant dir" (Left "The provided directory does not exist: /path/to/dir") error1 - - initialPwd <- fmap forceTrailingSlash pwd - let tmpbase = initialPwd "test" "tmp" - mktree tmpbase - absoluteTempDir <- fmap forceTrailingSlash $ using (mktempdir tmpbase "hlflowtest") - - let unrelatedDir = absoluteTempDir "unrelated" - mkdir unrelatedDir - - bdUnrelated <- liftIO $ determineBaseDirFromAbsoluteStartDir unrelatedDir - liftIO $ assertEqual "determineBaseDir produces an error message when it cannot find a baseDir" (Left $ errorMessageBaseDir unrelatedDir) bdUnrelated - - let baseDir = "bd1" - let importDir = baseDir "import" - let ownerDir = importDir "john" - let bankDir = ownerDir "mybank" - let accDir = bankDir "myacc" - let inDir = accDir "1-in" - let yearDir = inDir "2019" - let subDirs = [yearDir, inDir, accDir, bankDir, ownerDir, importDir, baseDir] - - mktree $ absoluteTempDir yearDir - - let fictionalDir = absoluteTempDir ownerDir "fictionalDir" - errorSub <- liftIO $ determineBaseDirFromAbsoluteStartDir fictionalDir - liftIO $ assertEqual "determineBaseDir produces an error message when given a non-existant subdir of a valid basedir" (Left $ format ("The provided directory does not exist: "%fp) fictionalDir) errorSub - - let relativeTempDir = foldl1 mappend (dropWhile (\el -> el `elem` (splitDirectories initialPwd)) (splitDirectories absoluteTempDir)) - - - let subDirsRelativeToTop = map (relativeTempDir ) subDirs - let absoluteSubDirs = map (absoluteTempDir ) subDirs - - let absoluteBaseDir = forceTrailingSlash $ absoluteTempDir baseDir - - liftIO $ assertCurrentDirVariations absoluteTempDir baseDir - - liftIO $ writeTextFile (absoluteTempDir yearDir "test-file.txt") $ format ("The expected base dir is "%fp) absoluteBaseDir - - liftIO $ assertSubDirsForDetermineBaseDir absoluteTempDir absoluteBaseDir subDirs - liftIO $ assertSubDirsForDetermineBaseDir absoluteTempDir absoluteBaseDir absoluteSubDirs - liftIO $ assertSubDirsForDetermineBaseDir initialPwd absoluteBaseDir subDirsRelativeToTop - ) - ) - testFilterPaths :: Test testFilterPaths = TestCase ( sh ( @@ -144,9 +36,9 @@ let tmpbase = "." "test" "tmp" mktree tmpbase tmpdir <- using (mktempdir tmpbase "hlflowtest") - let tmpJournals = map (tmpdir ) journalFiles :: [FilePath] - let tmpExtras = map (tmpdir ) extraFiles :: [FilePath] - let tmpHidden = map (tmpdir ) hiddenFiles :: [FilePath] + let tmpJournals = map (tmpdir ) journalFiles :: [TurtlePath] + let tmpExtras = map (tmpdir ) extraFiles :: [TurtlePath] + let tmpHidden = map (tmpdir ) hiddenFiles :: [TurtlePath] let onDisk = List.sort $ tmpJournals ++ tmpExtras ++ tmpHidden touchAll onDisk @@ -159,4 +51,4 @@ ) tests :: Test -tests = TestList [testDetermineBaseDir, testHiddenFiles, testFilterPaths] +tests = TestList [testHiddenFiles, testFilterPaths] diff --git a/test/Common/Unit.hs b/test/Common/Unit.hs --- a/test/Common/Unit.hs +++ b/test/Common/Unit.hs @@ -4,8 +4,8 @@ module Common.Unit where import Test.HUnit -import Prelude hiding (FilePath) +import Hledger.Flow.BaseDir (relativeToBase') import Hledger.Flow.Common testShowCmdArgs :: Test diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -5,15 +5,15 @@ import Test.HUnit import Turtle -import Prelude hiding (FilePath) import qualified Common.Unit import qualified Common.Integration +import qualified BaseDir.Integration import qualified CSVImport.Unit import qualified CSVImport.Integration tests :: Test -tests = TestList [Common.Unit.tests, Common.Integration.tests, CSVImport.Unit.tests, CSVImport.Integration.tests] +tests = TestList [Common.Unit.tests, Common.Integration.tests, BaseDir.Integration.tests, CSVImport.Unit.tests, CSVImport.Integration.tests] main :: IO Counts main = do diff --git a/test/TestHelpers.hs b/test/TestHelpers.hs --- a/test/TestHelpers.hs +++ b/test/TestHelpers.hs @@ -1,16 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLists #-} +{-# LANGUAGE QuasiQuotes #-} module TestHelpers where +import Path import Turtle -import Prelude hiding (FilePath) import qualified Hledger.Flow.Types as FlowTypes +import Hledger.Flow.PathHelpers (TurtlePath) import Hledger.Flow.Common import Hledger.Flow.RuntimeOptions -inputJohnBogart :: [FilePath] +inputJohnBogart :: [TurtlePath] inputJohnBogart = [ "import/john/bogartbank/savings/1-in/2017/2017-11-30.csv", "import/john/bogartbank/savings/1-in/2017/2017-12-30.csv", @@ -22,52 +24,63 @@ "import/john/bogartbank/checking/1-in/2019/2019-01-30.csv", "import/john/bogartbank/checking/1-in/2019/2019-02-30.csv"] -inputJohnOther :: [FilePath] +inputJohnOther :: [TurtlePath] inputJohnOther = [ "import/john/otherbank/creditcard/1-in/2017/2017-12-30.csv", "import/john/otherbank/creditcard/1-in/2018/2018-01-30.csv", "import/john/otherbank/investments/1-in/2018/2018-12-30.csv", "import/john/otherbank/investments/1-in/2019/2019-01-30.csv"] -inputJaneBogart :: [FilePath] +inputJaneBogart :: [TurtlePath] inputJaneBogart = [ "import/jane/bogartbank/savings/1-in/2017/2017-12-30.csv", "import/jane/bogartbank/savings/1-in/2018/2018-01-30.csv", "import/jane/bogartbank/checking/1-in/2018/2018-12-30.csv", "import/jane/bogartbank/checking/1-in/2019/2019-01-30.csv"] -inputJaneOther :: [FilePath] +inputJaneOther :: [TurtlePath] inputJaneOther = [ "import/jane/otherbank/creditcard/1-in/2017/2017-12-30.csv", "import/jane/otherbank/creditcard/1-in/2018/2018-01-30.csv", "import/jane/otherbank/investments/1-in/2018/2018-12-30.csv", "import/jane/otherbank/investments/1-in/2019/2019-01-30.csv"] -inputFiles :: [FilePath] +inputFiles :: [TurtlePath] inputFiles = inputJohnBogart <> inputJohnOther <> inputJaneBogart <> inputJaneOther -journalFiles :: [FilePath] +journalFiles :: [TurtlePath] journalFiles = toJournals inputFiles -extraFiles :: [FilePath] +extraFiles :: [TurtlePath] extraFiles = ["import/john/bogartbank/savings/2017-opening.journal"] -hiddenFiles :: [FilePath] +hiddenFiles :: [TurtlePath] hiddenFiles = [".hiddenfile", "checking/.DS_Store", "import/john/bogartbank/savings/1-in/.anotherhiddenfile", "import/john/bogartbank/checking/1-in/2018/.hidden"] defaultHlInfo :: FlowTypes.HledgerInfo defaultHlInfo = FlowTypes.HledgerInfo "/path/to/hledger" "1.2.3" -defaultOpts :: FilePath -> RuntimeOptions -defaultOpts bd = RuntimeOptions bd "./" True versionInfo' defaultHlInfo systemInfo False False False +defaultOpts :: FlowTypes.BaseDir -> RuntimeOptions +defaultOpts bd = RuntimeOptions { + baseDir = bd + , importRunDir = [reldir|./|] + , useRunDir = True + , onlyNewFiles = False + , hfVersion = versionInfo' + , hledgerInfo = defaultHlInfo + , sysInfo = systemInfo + , verbose = False + , showOptions = False + , sequential = False +} -toJournals :: [FilePath] -> [FilePath] +toJournals :: [TurtlePath] -> [TurtlePath] toJournals = map (changePathAndExtension "3-journal" "journal") -touchAll :: [FilePath] -> Shell () +touchAll :: [TurtlePath] -> Shell () touchAll = foldl (\acc file -> acc <> superTouch file) (return ()) -superTouch :: FilePath -> Shell () +superTouch :: TurtlePath -> Shell () superTouch file = do mktree $ directory file touch file