Replace system-filepath with path

app/Main.hs

@@ -1,42 +1,47 @@
 {-# 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
+data ImportParams = ImportParams { maybeImportBaseDir :: Maybe TurtlePath
                                  , importUseRunDir :: 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)
 data BaseCommand = Version | Command { mainParams :: MainParams, command :: Command } deriving (Show)
 
 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
@@ -50,10 +55,11 @@ toRuntimeOptionsImport mainParams' subParams' = do
 
 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.hfVersion = versionInfo'
                            , RT.hledgerInfo = hli
@@ -67,21 +73,21 @@ baseCommandParser = (Command <$> verboseParser <*> commandParser)
   <|> flag' Version (long "version" <> short 'V' <> help "Display version information")
 
 commandParser :: Parser Command
-commandParser = fmap Import (subcommand "import" "Uses hledger with your own rules and/or scripts to convert electronic statements into categorised journal files" subcommandParserImport)
-  <|> fmap Report (subcommand "report" "Generate Reports" subcommandParserReport)
+commandParser = 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")
 
 subcommandParserReport :: Parser ReportParams
 subcommandParserReport = ReportParams
-  <$> optional (argPath "basedir" "The hledger-flow base directory")
+  <$> optional (Turtle.argPath "basedir" "The hledger-flow base directory")

package.yaml

@@ -1,5 +1,5 @@
 name:                hledger-flow
-version:             0.13.2.0
+version:             0.14.0.0
 synopsis:            An hledger workflow focusing on automated statement import and classification.
 category:            Finance, Console
 license:             GPL-3
@@ -31,6 +31,9 @@ library:
   - -Wall
   dependencies:
   - turtle
+  - path
+  - path-io
+  - exceptions
   - text
   - foldl
   - containers
@@ -52,6 +55,7 @@ executables:
 
     dependencies:
     - hledger-flow
+    - path
     - turtle
     - text
     - optparse-applicative
@@ -66,6 +70,8 @@ tests:
     - -with-rtsopts=-N
     dependencies:
     - hledger-flow
+    - path
+    - path-io
     - turtle
     - HUnit
     - containers

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