{-# LANGUAGE OverloadedStrings #-}

module Hledger.Flow.Import.CSVImport
    ( importCSVs
    ) where

import qualified 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.Import.ImportHelpers
import Hledger.Flow.Import.ImportHelpersTurtle (extractImportDirs, writeIncludesUpTo, writeToplevelAllYearsInclude)
import Hledger.Flow.PathHelpers (TurtlePath, pathToTurtle)
import Hledger.Flow.DocHelpers (docURL)
import Hledger.Flow.Common
import Hledger.Flow.Logging
import Hledger.Flow.RuntimeOptions
import Control.Concurrent.STM
import Control.Monad
import Data.Maybe (fromMaybe, isNothing)

type FileWasGenerated = Bool

importCSVs :: RuntimeOptions -> IO ()
importCSVs :: RuntimeOptions -> IO ()
importCSVs RuntimeOptions
opts = Shell () -> IO ()
forall (io :: * -> *) a. MonadIO io => Shell a -> io ()
Turtle.sh (
  do
    TChan LogMessage
ch <- IO (TChan LogMessage) -> Shell (TChan LogMessage)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO IO (TChan LogMessage)
forall a. IO (TChan a)
newTChanIO
    Async ()
logHandle <- IO () -> Shell (Async ())
forall (managed :: * -> *) a.
MonadManaged managed =>
IO a -> managed (Async a)
Turtle.fork (IO () -> Shell (Async ())) -> IO () -> Shell (Async ())
forall a b. (a -> b) -> a -> b
$ TChan LogMessage -> IO ()
consoleChannelLoop TChan LogMessage
ch
    IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO (IO () -> Shell ()) -> IO () -> Shell ()
forall a b. (a -> b) -> a -> b
$ Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RuntimeOptions -> Bool
showOptions RuntimeOptions
opts) (TChan LogMessage -> Text -> IO ()
channelOutLn TChan LogMessage
ch (RuntimeOptions -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr RuntimeOptions
opts))
    IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO (IO () -> Shell ()) -> IO () -> Shell ()
forall a b. (a -> b) -> a -> b
$ RuntimeOptions -> TChan LogMessage -> Text -> IO ()
forall o. HasVerbosity o => o -> TChan LogMessage -> Text -> IO ()
logVerbose RuntimeOptions
opts TChan LogMessage
ch Text
"Starting import"
    ([(TurtlePath, Bool)]
journals, NominalDiffTime
diff) <- Shell [(TurtlePath, Bool)]
-> Shell ([(TurtlePath, Bool)], NominalDiffTime)
forall (io :: * -> *) a.
MonadIO io =>
io a -> io (a, NominalDiffTime)
Turtle.time (Shell [(TurtlePath, Bool)]
 -> Shell ([(TurtlePath, Bool)], NominalDiffTime))
-> Shell [(TurtlePath, Bool)]
-> Shell ([(TurtlePath, Bool)], NominalDiffTime)
forall a b. (a -> b) -> a -> b
$ IO [(TurtlePath, Bool)] -> Shell [(TurtlePath, Bool)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO (IO [(TurtlePath, Bool)] -> Shell [(TurtlePath, Bool)])
-> IO [(TurtlePath, Bool)] -> Shell [(TurtlePath, Bool)]
forall a b. (a -> b) -> a -> b
$ RuntimeOptions -> TChan LogMessage -> IO [(TurtlePath, Bool)]
importCSVs' RuntimeOptions
opts TChan LogMessage
ch
    let generatedJournals :: [(TurtlePath, Bool)]
generatedJournals = ((TurtlePath, Bool) -> Bool)
-> [(TurtlePath, Bool)] -> [(TurtlePath, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (TurtlePath, Bool) -> Bool
forall a b. (a, b) -> b
snd [(TurtlePath, Bool)]
journals
    IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO (IO () -> Shell ()) -> IO () -> Shell ()
forall a b. (a -> b) -> a -> b
$ TChan LogMessage -> Text -> IO ()
channelOutLn TChan LogMessage
ch (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (Int -> Int -> Text -> Text)
-> Int -> Int -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (Int -> Int -> Text -> Text) (Int -> Int -> Text -> Text)
"Imported "Format (Int -> Int -> Text -> Text) (Int -> Int -> Text -> Text)
-> Format (Int -> Text -> Text) (Int -> Int -> Text -> Text)
-> Format (Int -> Text -> Text) (Int -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Int -> Text -> Text) (Int -> Int -> Text -> Text)
forall n r. Integral n => Format r (n -> r)
Turtle.dFormat (Int -> Text -> Text) (Int -> Int -> Text -> Text)
-> Format (Int -> Text -> Text) (Int -> Text -> Text)
-> Format (Int -> Text -> Text) (Int -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Int -> Text -> Text) (Int -> Text -> Text)
"/"Format (Int -> Text -> Text) (Int -> Int -> Text -> Text)
-> Format (Text -> Text) (Int -> Text -> Text)
-> Format (Text -> Text) (Int -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Int -> Text -> Text)
forall n r. Integral n => Format r (n -> r)
Turtle.dFormat (Text -> Text) (Int -> Int -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (Int -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
" journals in "Format (Text -> Text) (Int -> Int -> Text -> Text)
-> Format Text (Text -> Text)
-> Format Text (Int -> Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Text -> Text)
forall r. Format r (Text -> r)
Turtle.s) ([(TurtlePath, Bool)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TurtlePath, Bool)]
generatedJournals) ([(TurtlePath, Bool)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(TurtlePath, Bool)]
journals) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr NominalDiffTime
diff
    IO () -> Shell ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO (IO () -> Shell ()) -> IO () -> Shell ()
forall a b. (a -> b) -> a -> b
$ TChan LogMessage -> IO ()
terminateChannelLoop TChan LogMessage
ch
    Async () -> Shell ()
forall (io :: * -> *) a. MonadIO io => Async a -> io a
Turtle.wait Async ()
logHandle
  )

importCSVs' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> IO [(TurtlePath, FileWasGenerated)]
importCSVs' :: RuntimeOptions -> TChan LogMessage -> IO [(TurtlePath, Bool)]
importCSVs' RuntimeOptions
opts TChan LogMessage
ch = do
  let effectiveDir :: AbsDir
effectiveDir = AbsDir -> RunDir -> AbsDir
effectiveRunDir (RuntimeOptions -> AbsDir
baseDir RuntimeOptions
opts) (RuntimeOptions -> RunDir
importRunDir RuntimeOptions
opts)
  let startYearMsg :: Text
startYearMsg = Text -> (Integer -> Text) -> Maybe Integer -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
" " (Format Text (Integer -> Text) -> Integer -> Text
forall r. Format Text r -> r
Turtle.format (Format (Integer -> Text) (Integer -> Text)
" (for the year " Format (Integer -> Text) (Integer -> Text)
-> Format Text (Integer -> Text) -> Format Text (Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format Text (Integer -> Text)
forall n r. Integral n => Format r (n -> r)
Turtle.d Format Text (Integer -> Text)
-> Format Text Text -> Format Text (Integer -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format Text Text
" and onwards) ")) (RuntimeOptions -> Maybe Integer
importStartYear RuntimeOptions
opts)
  TChan LogMessage -> Text -> IO ()
channelOutLn TChan LogMessage
ch (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (Text -> TurtlePath -> Text)
-> Text -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (Text -> TurtlePath -> Text) (Text -> TurtlePath -> Text)
"Collecting input files"Format (Text -> TurtlePath -> Text) (Text -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (Text -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (Text -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (TurtlePath -> Text) (Text -> TurtlePath -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat (TurtlePath -> Text) (Text -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> Text)
-> Format (TurtlePath -> Text) (Text -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (TurtlePath -> Text) (TurtlePath -> Text)
"from "Format (TurtlePath -> Text) (Text -> TurtlePath -> Text)
-> Format Text (TurtlePath -> Text)
-> Format Text (Text -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp) Text
startYearMsg (AbsDir -> TurtlePath
forall b t. Path b t -> TurtlePath
pathToTurtle AbsDir
effectiveDir)
  ([AbsFile]
inputFiles, NominalDiffTime
diff) <- IO [AbsFile] -> IO ([AbsFile], NominalDiffTime)
forall (io :: * -> *) a.
MonadIO io =>
io a -> io (a, NominalDiffTime)
Turtle.time (IO [AbsFile] -> IO ([AbsFile], NominalDiffTime))
-> IO [AbsFile] -> IO ([AbsFile], NominalDiffTime)
forall a b. (a -> b) -> a -> b
$ Integer -> AbsDir -> IO [AbsFile]
findInputFiles (Integer -> Maybe Integer -> Integer
forall a. a -> Maybe a -> a
fromMaybe Integer
0 (Maybe Integer -> Integer) -> Maybe Integer -> Integer
forall a b. (a -> b) -> a -> b
$ RuntimeOptions -> Maybe Integer
importStartYear RuntimeOptions
opts) AbsDir
effectiveDir

  let fileCount :: Int
fileCount = [AbsFile] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AbsFile]
inputFiles
  if Int
fileCount Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 Bool -> Bool -> Bool
&& Maybe Integer -> Bool
forall a. Maybe a -> Bool
isNothing (RuntimeOptions -> Maybe Integer
importStartYear RuntimeOptions
opts) then
    do
      let msg :: Text
msg = Format Text (TurtlePath -> Text -> Text)
-> TurtlePath -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (TurtlePath -> Text -> Text) (TurtlePath -> Text -> Text)
"I couldn't find any input files underneath "Format (TurtlePath -> Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (TurtlePath -> Text -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp
                        Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
"\n\nhledger-flow expects to find its input files in specifically\nnamed directories.\n\n"Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%
                        Format (Text -> Text) (Text -> Text)
"Have a look at the documentation for a detailed explanation:\n"Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format Text (Text -> Text)
-> Format Text (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Text -> Text)
forall r. Format r (Text -> r)
Turtle.s) (AbsDir -> TurtlePath
forall b t. Path b t -> TurtlePath
pathToTurtle AbsDir
effectiveDir) (Line -> Text
docURL Line
"input-files")
      Int
-> TChan LogMessage
-> Text
-> [(TurtlePath, Bool)]
-> IO [(TurtlePath, Bool)]
forall a. Int -> TChan LogMessage -> Text -> a -> IO a
errExit Int
1 TChan LogMessage
ch Text
msg []
    else
    do
      TChan LogMessage -> Text -> IO ()
channelOutLn TChan LogMessage
ch (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (Int -> Text -> Text -> Text)
-> Int -> Text -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (Int -> Text -> Text -> Text) (Int -> Text -> Text -> Text)
"Found "Format (Int -> Text -> Text -> Text) (Int -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Int -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text -> Text) (Int -> Text -> Text -> Text)
forall n r. Integral n => Format r (n -> r)
Turtle.dFormat (Text -> Text -> Text) (Int -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text -> Text) (Text -> Text -> Text)
" input files"Format (Text -> Text -> Text) (Int -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text) (Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat (Text -> Text) (Int -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
"in "Format (Text -> Text) (Int -> Text -> Text -> Text)
-> Format Text (Text -> Text)
-> Format Text (Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Text -> Text)
forall r. Format r (Text -> r)
Turtle.sFormat Text (Int -> Text -> Text -> Text)
-> Format Text Text -> Format Text (Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
". Proceeding with import...") Int
fileCount Text
startYearMsg (NominalDiffTime -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr NominalDiffTime
diff)
      let actions :: [IO (TurtlePath, Bool)]
actions = (AbsFile -> IO (TurtlePath, Bool))
-> [AbsFile] -> [IO (TurtlePath, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (RuntimeOptions
-> TChan LogMessage -> TurtlePath -> IO (TurtlePath, Bool)
extractAndImport RuntimeOptions
opts TChan LogMessage
ch (TurtlePath -> IO (TurtlePath, Bool))
-> (AbsFile -> TurtlePath) -> AbsFile -> IO (TurtlePath, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsFile -> TurtlePath
forall b t. Path b t -> TurtlePath
pathToTurtle) [AbsFile]
inputFiles :: [IO (TurtlePath, FileWasGenerated)]
      [(TurtlePath, Bool)]
importedJournals <- RuntimeOptions
-> [IO (TurtlePath, Bool)] -> IO [(TurtlePath, Bool)]
forall o a.
(HasSequential o, HasBatchSize o) =>
o -> [IO a] -> IO [a]
parAwareActions RuntimeOptions
opts [IO (TurtlePath, Bool)]
actions
      ([AbsFile]
journalsOnDisk, NominalDiffTime
journalFindTime) <- IO [AbsFile] -> IO ([AbsFile], NominalDiffTime)
forall (io :: * -> *) a.
MonadIO io =>
io a -> io (a, NominalDiffTime)
Turtle.time (IO [AbsFile] -> IO ([AbsFile], NominalDiffTime))
-> IO [AbsFile] -> IO ([AbsFile], NominalDiffTime)
forall a b. (a -> b) -> a -> b
$ AbsDir -> IO [AbsFile]
findJournalFiles AbsDir
effectiveDir
      ([TurtlePath]
_, NominalDiffTime
writeIncludeTime1) <- IO [TurtlePath] -> IO ([TurtlePath], NominalDiffTime)
forall (io :: * -> *) a.
MonadIO io =>
io a -> io (a, NominalDiffTime)
Turtle.time (IO [TurtlePath] -> IO ([TurtlePath], NominalDiffTime))
-> IO [TurtlePath] -> IO ([TurtlePath], NominalDiffTime)
forall a b. (a -> b) -> a -> b
$ RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> [TurtlePath]
-> IO [TurtlePath]
forall o.
(HasBaseDir o, HasVerbosity o) =>
o
-> TChan LogMessage
-> TurtlePath
-> [TurtlePath]
-> IO [TurtlePath]
writeIncludesUpTo RuntimeOptions
opts TChan LogMessage
ch (AbsDir -> TurtlePath
forall b t. Path b t -> TurtlePath
pathToTurtle AbsDir
effectiveDir) ([TurtlePath] -> IO [TurtlePath])
-> [TurtlePath] -> IO [TurtlePath]
forall a b. (a -> b) -> a -> b
$ (AbsFile -> TurtlePath) -> [AbsFile] -> [TurtlePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap AbsFile -> TurtlePath
forall b t. Path b t -> TurtlePath
pathToTurtle [AbsFile]
journalsOnDisk
      ([TurtlePath]
_, NominalDiffTime
writeIncludeTime2) <- IO [TurtlePath] -> IO ([TurtlePath], NominalDiffTime)
forall (io :: * -> *) a.
MonadIO io =>
io a -> io (a, NominalDiffTime)
Turtle.time (IO [TurtlePath] -> IO ([TurtlePath], NominalDiffTime))
-> IO [TurtlePath] -> IO ([TurtlePath], NominalDiffTime)
forall a b. (a -> b) -> a -> b
$ RuntimeOptions -> IO [TurtlePath]
forall o. (HasBaseDir o, HasVerbosity o) => o -> IO [TurtlePath]
writeToplevelAllYearsInclude RuntimeOptions
opts
      let includeGenTime :: NominalDiffTime
includeGenTime = NominalDiffTime
journalFindTime NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
writeIncludeTime1 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
+ NominalDiffTime
writeIncludeTime2
      TChan LogMessage -> Text -> IO ()
channelOutLn TChan LogMessage
ch (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (Int -> Text -> Text) -> Int -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (Int -> Text -> Text) (Int -> Text -> Text)
"Wrote include files for "Format (Int -> Text -> Text) (Int -> Text -> Text)
-> Format (Text -> Text) (Int -> Text -> Text)
-> Format (Text -> Text) (Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Int -> Text -> Text)
forall n r. Integral n => Format r (n -> r)
Turtle.dFormat (Text -> Text) (Int -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
" journals in "Format (Text -> Text) (Int -> Text -> Text)
-> Format Text (Text -> Text) -> Format Text (Int -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Text -> Text)
forall r. Format r (Text -> r)
Turtle.s) ([AbsFile] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AbsFile]
journalsOnDisk) (NominalDiffTime -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr NominalDiffTime
includeGenTime)
      [(TurtlePath, Bool)] -> IO [(TurtlePath, Bool)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(TurtlePath, Bool)]
importedJournals

extractAndImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> IO (TurtlePath, FileWasGenerated)
extractAndImport :: RuntimeOptions
-> TChan LogMessage -> TurtlePath -> IO (TurtlePath, Bool)
extractAndImport RuntimeOptions
opts TChan LogMessage
ch TurtlePath
inputFile = do
  case TurtlePath -> Either Text ImportDirs
extractImportDirs TurtlePath
inputFile of
    Right ImportDirs
importDirs -> RuntimeOptions
-> TChan LogMessage
-> ImportDirs
-> TurtlePath
-> IO (TurtlePath, Bool)
importCSV RuntimeOptions
opts TChan LogMessage
ch ImportDirs
importDirs TurtlePath
inputFile
    Left Text
errorMessage -> do
      Int
-> TChan LogMessage
-> Text
-> (TurtlePath, Bool)
-> IO (TurtlePath, Bool)
forall a. Int -> TChan LogMessage -> Text -> a -> IO a
errExit Int
1 TChan LogMessage
ch Text
errorMessage (TurtlePath
inputFile, Bool
False)

importCSV :: RuntimeOptions -> TChan FlowTypes.LogMessage -> ImportDirs -> TurtlePath -> IO (TurtlePath, FileWasGenerated)
importCSV :: RuntimeOptions
-> TChan LogMessage
-> ImportDirs
-> TurtlePath
-> IO (TurtlePath, Bool)
importCSV RuntimeOptions
opts TChan LogMessage
ch ImportDirs
importDirs TurtlePath
srcFile = do
  let preprocessScript :: TurtlePath
preprocessScript = ImportDirs -> TurtlePath
accountDir ImportDirs
importDirs TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
"preprocess"
  let constructScript :: TurtlePath
constructScript = ImportDirs -> TurtlePath
accountDir ImportDirs
importDirs TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
"construct"
  let bankName :: Line
bankName = (ImportDirs -> TurtlePath) -> ImportDirs -> Line
importDirLine ImportDirs -> TurtlePath
bankDir ImportDirs
importDirs
  let accountName :: Line
accountName = (ImportDirs -> TurtlePath) -> ImportDirs -> Line
importDirLine ImportDirs -> TurtlePath
accountDir ImportDirs
importDirs
  let ownerName :: Line
ownerName = (ImportDirs -> TurtlePath) -> ImportDirs -> Line
importDirLine ImportDirs -> TurtlePath
ownerDir ImportDirs
importDirs
  (TurtlePath
csvFile, Bool
preprocessHappened) <- RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Line
-> Line
-> Line
-> TurtlePath
-> IO (TurtlePath, Bool)
preprocessIfNeeded RuntimeOptions
opts TChan LogMessage
ch TurtlePath
preprocessScript Line
bankName Line
accountName Line
ownerName TurtlePath
srcFile
  let journalOut :: TurtlePath
journalOut = TurtlePath -> Text -> TurtlePath -> TurtlePath
changePathAndExtension TurtlePath
"3-journal" Text
"journal" TurtlePath
csvFile
  Bool
shouldImport <- if RuntimeOptions -> Bool
onlyNewFiles RuntimeOptions
opts Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
preprocessHappened
    then Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RuntimeOptions -> TChan LogMessage -> TurtlePath -> IO Bool
forall o.
(HasVerbosity o, HasBaseDir o) =>
o -> TChan LogMessage -> TurtlePath -> IO Bool
verboseTestFile RuntimeOptions
opts TChan LogMessage
ch TurtlePath
journalOut
    else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

  TurtlePath -> TurtlePath -> IO TurtlePath
importFun <- if Bool
shouldImport
    then RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Line
-> Line
-> Line
-> IO (TurtlePath -> TurtlePath -> IO TurtlePath)
constructOrImport RuntimeOptions
opts TChan LogMessage
ch TurtlePath
constructScript Line
bankName Line
accountName Line
ownerName
    else do
      ()
_ <- RuntimeOptions -> TChan LogMessage -> Text -> TurtlePath -> IO ()
logNewFileSkip RuntimeOptions
opts TChan LogMessage
ch Text
"import" TurtlePath
journalOut
      (TurtlePath -> TurtlePath -> IO TurtlePath)
-> IO (TurtlePath -> TurtlePath -> IO TurtlePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TurtlePath -> TurtlePath -> IO TurtlePath)
 -> IO (TurtlePath -> TurtlePath -> IO TurtlePath))
-> (TurtlePath -> TurtlePath -> IO TurtlePath)
-> IO (TurtlePath -> TurtlePath -> IO TurtlePath)
forall a b. (a -> b) -> a -> b
$ \TurtlePath
_p1 TurtlePath
_p2 -> TurtlePath -> IO TurtlePath
forall (m :: * -> *) a. Monad m => a -> m a
return TurtlePath
journalOut
  TurtlePath -> IO ()
forall (io :: * -> *). MonadIO io => TurtlePath -> io ()
Turtle.mktree (TurtlePath -> IO ()) -> TurtlePath -> IO ()
forall a b. (a -> b) -> a -> b
$ TurtlePath -> TurtlePath
Turtle.directory TurtlePath
journalOut
  TurtlePath
out <- TurtlePath -> TurtlePath -> IO TurtlePath
importFun TurtlePath
csvFile TurtlePath
journalOut
  (TurtlePath, Bool) -> IO (TurtlePath, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (TurtlePath
out, Bool
shouldImport)

constructOrImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> Turtle.Line -> Turtle.Line -> Turtle.Line -> IO (TurtlePath -> TurtlePath -> IO TurtlePath)
constructOrImport :: RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Line
-> Line
-> Line
-> IO (TurtlePath -> TurtlePath -> IO TurtlePath)
constructOrImport RuntimeOptions
opts TChan LogMessage
ch TurtlePath
constructScript Line
bankName Line
accountName Line
ownerName = do
  Bool
constructScriptExists <- RuntimeOptions -> TChan LogMessage -> TurtlePath -> IO Bool
forall o.
(HasVerbosity o, HasBaseDir o) =>
o -> TChan LogMessage -> TurtlePath -> IO Bool
verboseTestFile RuntimeOptions
opts TChan LogMessage
ch TurtlePath
constructScript
  if Bool
constructScriptExists
    then (TurtlePath -> TurtlePath -> IO TurtlePath)
-> IO (TurtlePath -> TurtlePath -> IO TurtlePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TurtlePath -> TurtlePath -> IO TurtlePath)
 -> IO (TurtlePath -> TurtlePath -> IO TurtlePath))
-> (TurtlePath -> TurtlePath -> IO TurtlePath)
-> IO (TurtlePath -> TurtlePath -> IO TurtlePath)
forall a b. (a -> b) -> a -> b
$ RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Line
-> Line
-> Line
-> TurtlePath
-> TurtlePath
-> IO TurtlePath
customConstruct RuntimeOptions
opts TChan LogMessage
ch TurtlePath
constructScript Line
bankName Line
accountName Line
ownerName
    else (TurtlePath -> TurtlePath -> IO TurtlePath)
-> IO (TurtlePath -> TurtlePath -> IO TurtlePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ((TurtlePath -> TurtlePath -> IO TurtlePath)
 -> IO (TurtlePath -> TurtlePath -> IO TurtlePath))
-> (TurtlePath -> TurtlePath -> IO TurtlePath)
-> IO (TurtlePath -> TurtlePath -> IO TurtlePath)
forall a b. (a -> b) -> a -> b
$ RuntimeOptions
-> TChan LogMessage -> TurtlePath -> TurtlePath -> IO TurtlePath
hledgerImport RuntimeOptions
opts TChan LogMessage
ch

preprocessIfNeeded :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> Turtle.Line -> Turtle.Line -> Turtle.Line -> TurtlePath -> IO (TurtlePath, Bool)
preprocessIfNeeded :: RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Line
-> Line
-> Line
-> TurtlePath
-> IO (TurtlePath, Bool)
preprocessIfNeeded RuntimeOptions
opts TChan LogMessage
ch TurtlePath
script Line
bank Line
account Line
owner TurtlePath
src = do
  let csvOut :: TurtlePath
csvOut = TurtlePath -> Text -> TurtlePath -> TurtlePath
changePathAndExtension TurtlePath
"2-preprocessed" Text
"csv" TurtlePath
src
  Bool
scriptExists <- RuntimeOptions -> TChan LogMessage -> TurtlePath -> IO Bool
forall o.
(HasVerbosity o, HasBaseDir o) =>
o -> TChan LogMessage -> TurtlePath -> IO Bool
verboseTestFile RuntimeOptions
opts TChan LogMessage
ch TurtlePath
script
  Bool
shouldProceed <- if RuntimeOptions -> Bool
onlyNewFiles RuntimeOptions
opts 
    then do
      Bool
targetExists <- RuntimeOptions -> TChan LogMessage -> TurtlePath -> IO Bool
forall o.
(HasVerbosity o, HasBaseDir o) =>
o -> TChan LogMessage -> TurtlePath -> IO Bool
verboseTestFile RuntimeOptions
opts TChan LogMessage
ch TurtlePath
csvOut
      Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool
scriptExists Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
targetExists
    else Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
scriptExists
  if Bool
shouldProceed
    then do
     TurtlePath
out <- RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Line
-> Line
-> Line
-> TurtlePath
-> TurtlePath
-> IO TurtlePath
preprocess RuntimeOptions
opts TChan LogMessage
ch TurtlePath
script Line
bank Line
account Line
owner TurtlePath
src TurtlePath
csvOut
     (TurtlePath, Bool) -> IO (TurtlePath, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (TurtlePath
out, Bool
True)
    else do
      ()
_ <- RuntimeOptions -> TChan LogMessage -> Text -> TurtlePath -> IO ()
logNewFileSkip RuntimeOptions
opts TChan LogMessage
ch Text
"preprocess" TurtlePath
csvOut
      (TurtlePath, Bool) -> IO (TurtlePath, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (TurtlePath
src, Bool
False)

logNewFileSkip :: RuntimeOptions -> TChan FlowTypes.LogMessage -> T.Text -> TurtlePath -> IO ()
logNewFileSkip :: RuntimeOptions -> TChan LogMessage -> Text -> TurtlePath -> IO ()
logNewFileSkip RuntimeOptions
opts TChan LogMessage
ch Text
logIdentifier TurtlePath
absTarget =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.when (RuntimeOptions -> Bool
onlyNewFiles RuntimeOptions
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
   let relativeTarget :: TurtlePath
relativeTarget = RuntimeOptions -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase RuntimeOptions
opts TurtlePath
absTarget
   RuntimeOptions -> TChan LogMessage -> Text -> IO ()
forall o. HasVerbosity o => o -> TChan LogMessage -> Text -> IO ()
logVerbose RuntimeOptions
opts TChan LogMessage
ch
     (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (Text -> TurtlePath -> Text)
-> Text -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format
        (Format (Text -> TurtlePath -> Text) (Text -> TurtlePath -> Text)
"Skipping " Format (Text -> TurtlePath -> Text) (Text -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (Text -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (Text -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format (TurtlePath -> Text) (Text -> TurtlePath -> Text)
forall r. Format r (Text -> r)
Turtle.s
         Format (TurtlePath -> Text) (Text -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> Text)
-> Format (TurtlePath -> Text) (Text -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format (TurtlePath -> Text) (TurtlePath -> Text)
" - only creating new files and this output file already exists: '"
         Format (TurtlePath -> Text) (Text -> TurtlePath -> Text)
-> Format Text (TurtlePath -> Text)
-> Format Text (Text -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp
         Format Text (Text -> TurtlePath -> Text)
-> Format Text Text -> Format Text (Text -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format Text Text
"'") Text
logIdentifier TurtlePath
relativeTarget

preprocess :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> Turtle.Line -> Turtle.Line -> Turtle.Line -> TurtlePath -> TurtlePath -> IO TurtlePath
preprocess :: RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Line
-> Line
-> Line
-> TurtlePath
-> TurtlePath
-> IO TurtlePath
preprocess RuntimeOptions
opts TChan LogMessage
ch TurtlePath
script Line
bank Line
account Line
owner TurtlePath
src TurtlePath
csvOut = do
  TurtlePath -> IO ()
forall (io :: * -> *). MonadIO io => TurtlePath -> io ()
Turtle.mktree (TurtlePath -> IO ()) -> TurtlePath -> IO ()
forall a b. (a -> b) -> a -> b
$ TurtlePath -> TurtlePath
Turtle.directory TurtlePath
csvOut
  let args :: [Text]
args = [Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp TurtlePath
src, Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp TurtlePath
csvOut, Line -> Text
Turtle.lineToText Line
bank, Line -> Text
Turtle.lineToText Line
account, Line -> Text
Turtle.lineToText Line
owner]
  let relScript :: TurtlePath
relScript = RuntimeOptions -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase RuntimeOptions
opts TurtlePath
script
  let relSrc :: TurtlePath
relSrc = RuntimeOptions -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase RuntimeOptions
opts TurtlePath
src
  let cmdLabel :: Text
cmdLabel = Format Text (TurtlePath -> TurtlePath -> Text)
-> TurtlePath -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format
  (TurtlePath -> TurtlePath -> Text)
  (TurtlePath -> TurtlePath -> Text)
"executing '"Format
  (TurtlePath -> TurtlePath -> Text)
  (TurtlePath -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fpFormat (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (TurtlePath -> Text) (TurtlePath -> Text)
"' on '"Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
-> Format Text (TurtlePath -> Text)
-> Format Text (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fpFormat Text (TurtlePath -> TurtlePath -> Text)
-> Format Text Text
-> Format Text (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
"'") TurtlePath
relScript TurtlePath
relSrc
  FullTimedOutput
_ <- RuntimeOptions
-> TChan LogMessage
-> Text
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO FullTimedOutput
forall o.
(HasSequential o, HasVerbosity o) =>
o
-> TChan LogMessage
-> Text
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO FullTimedOutput
timeAndExitOnErr RuntimeOptions
opts TChan LogMessage
ch Text
cmdLabel TChan LogMessage -> Text -> IO ()
channelOut TChan LogMessage -> Text -> IO ()
channelErr (RuntimeOptions -> ProcFun
forall o. HasSequential o => o -> ProcFun
parAwareProc RuntimeOptions
opts) (Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp TurtlePath
script, [Text]
args, Shell Line
forall (f :: * -> *) a. Alternative f => f a
Turtle.empty)
  TurtlePath -> IO TurtlePath
forall (m :: * -> *) a. Monad m => a -> m a
return TurtlePath
csvOut

hledgerImport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> TurtlePath -> IO TurtlePath
hledgerImport :: RuntimeOptions
-> TChan LogMessage -> TurtlePath -> TurtlePath -> IO TurtlePath
hledgerImport RuntimeOptions
opts TChan LogMessage
ch TurtlePath
csvSrc TurtlePath
journalOut = do
  case TurtlePath -> Either Text ImportDirs
extractImportDirs TurtlePath
csvSrc of
    Right ImportDirs
importDirs -> RuntimeOptions
-> TChan LogMessage
-> ImportDirs
-> TurtlePath
-> TurtlePath
-> IO TurtlePath
hledgerImport' RuntimeOptions
opts TChan LogMessage
ch ImportDirs
importDirs TurtlePath
csvSrc TurtlePath
journalOut
    Left Text
errorMessage -> do
      Int -> TChan LogMessage -> Text -> TurtlePath -> IO TurtlePath
forall a. Int -> TChan LogMessage -> Text -> a -> IO a
errExit Int
1 TChan LogMessage
ch Text
errorMessage TurtlePath
csvSrc

hledgerImport' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> ImportDirs -> TurtlePath -> TurtlePath -> IO TurtlePath
hledgerImport' :: RuntimeOptions
-> TChan LogMessage
-> ImportDirs
-> TurtlePath
-> TurtlePath
-> IO TurtlePath
hledgerImport' RuntimeOptions
opts TChan LogMessage
ch ImportDirs
importDirs TurtlePath
csvSrc TurtlePath
journalOut = do
  let candidates :: [TurtlePath]
candidates = TurtlePath -> ImportDirs -> [TurtlePath]
rulesFileCandidates TurtlePath
csvSrc ImportDirs
importDirs
  Maybe TurtlePath
maybeRulesFile <- [TurtlePath] -> IO (Maybe TurtlePath)
firstExistingFile [TurtlePath]
candidates
  let relCSV :: TurtlePath
relCSV = RuntimeOptions -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase RuntimeOptions
opts TurtlePath
csvSrc
  case Maybe TurtlePath
maybeRulesFile of
    Just TurtlePath
rf -> do
      let relRules :: TurtlePath
relRules = RuntimeOptions -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase RuntimeOptions
opts TurtlePath
rf
      let hledger :: Text
hledger = Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp (TurtlePath -> Text) -> TurtlePath -> Text
forall a b. (a -> b) -> a -> b
$ AbsFile -> TurtlePath
forall b t. Path b t -> TurtlePath
pathToTurtle (AbsFile -> TurtlePath)
-> (RuntimeOptions -> AbsFile) -> RuntimeOptions -> TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HledgerInfo -> AbsFile
FlowTypes.hlPath (HledgerInfo -> AbsFile)
-> (RuntimeOptions -> HledgerInfo) -> RuntimeOptions -> AbsFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeOptions -> HledgerInfo
hledgerInfo (RuntimeOptions -> TurtlePath) -> RuntimeOptions -> TurtlePath
forall a b. (a -> b) -> a -> b
$ RuntimeOptions
opts :: T.Text
      let args :: [Text]
args = [Text
"print", Text
"--rules-file", Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp TurtlePath
rf, Text
"--file", Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp TurtlePath
csvSrc, Text
"--output-file", Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp TurtlePath
journalOut]
      let cmdLabel :: Text
cmdLabel = Format Text (TurtlePath -> TurtlePath -> Text)
-> TurtlePath -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format
  (TurtlePath -> TurtlePath -> Text)
  (TurtlePath -> TurtlePath -> Text)
"importing '"Format
  (TurtlePath -> TurtlePath -> Text)
  (TurtlePath -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fpFormat (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (TurtlePath -> Text) (TurtlePath -> Text)
"' using rules file '"Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
-> Format Text (TurtlePath -> Text)
-> Format Text (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fpFormat Text (TurtlePath -> TurtlePath -> Text)
-> Format Text Text
-> Format Text (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
"'") TurtlePath
relCSV TurtlePath
relRules
      FullTimedOutput
_ <- RuntimeOptions
-> TChan LogMessage
-> Text
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO FullTimedOutput
forall o.
(HasSequential o, HasVerbosity o) =>
o
-> TChan LogMessage
-> Text
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO FullTimedOutput
timeAndExitOnErr RuntimeOptions
opts TChan LogMessage
ch Text
cmdLabel TChan LogMessage -> Text -> IO ()
channelOut TChan LogMessage -> Text -> IO ()
channelErr (RuntimeOptions -> ProcFun
forall o. HasSequential o => o -> ProcFun
parAwareProc RuntimeOptions
opts) (Text
hledger, [Text]
args, Shell Line
forall (f :: * -> *) a. Alternative f => f a
Turtle.empty)
      TurtlePath -> IO TurtlePath
forall (m :: * -> *) a. Monad m => a -> m a
return TurtlePath
journalOut
    Maybe TurtlePath
Nothing ->
      do
        let relativeCandidates :: [TurtlePath]
relativeCandidates = (TurtlePath -> TurtlePath) -> [TurtlePath] -> [TurtlePath]
forall a b. (a -> b) -> [a] -> [b]
map (RuntimeOptions -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase RuntimeOptions
opts) [TurtlePath]
candidates
        let candidatesTxt :: Text
candidatesTxt = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (TurtlePath -> Text) -> [TurtlePath] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp) [TurtlePath]
relativeCandidates
        let msg :: Text
msg = Format Text (TurtlePath -> Int -> Text -> Text -> Text)
-> TurtlePath -> Int -> Text -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format
  (TurtlePath -> Int -> Text -> Text -> Text)
  (TurtlePath -> Int -> Text -> Text -> Text)
"I couldn't find an hledger rules file while trying to import\n"Format
  (TurtlePath -> Int -> Text -> Text -> Text)
  (TurtlePath -> Int -> Text -> Text -> Text)
-> Format
     (Int -> Text -> Text -> Text)
     (TurtlePath -> Int -> Text -> Text -> Text)
-> Format
     (Int -> Text -> Text -> Text)
     (TurtlePath -> Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format
  (Int -> Text -> Text -> Text)
  (TurtlePath -> Int -> Text -> Text -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp
                          Format
  (Int -> Text -> Text -> Text)
  (TurtlePath -> Int -> Text -> Text -> Text)
-> Format
     (Int -> Text -> Text -> Text) (Int -> Text -> Text -> Text)
-> Format
     (Int -> Text -> Text -> Text)
     (TurtlePath -> Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Int -> Text -> Text -> Text) (Int -> Text -> Text -> Text)
"\n\nI will happily use the first rules file I can find from any one of these "Format
  (Int -> Text -> Text -> Text)
  (TurtlePath -> Int -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Int -> Text -> Text -> Text)
-> Format
     (Text -> Text -> Text) (TurtlePath -> Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text -> Text) (Int -> Text -> Text -> Text)
forall n r. Integral n => Format r (n -> r)
Turtle.dFormat
  (Text -> Text -> Text) (TurtlePath -> Int -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Text -> Text -> Text)
-> Format
     (Text -> Text -> Text) (TurtlePath -> Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text -> Text) (Text -> Text -> Text)
" files:\n"Format
  (Text -> Text -> Text) (TurtlePath -> Int -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text)
-> Format
     (Text -> Text) (TurtlePath -> Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text -> Text)
forall r. Format r (Text -> r)
Turtle.s
                          Format (Text -> Text) (TurtlePath -> Int -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format
     (Text -> Text) (TurtlePath -> Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
"\n\nHere is a bit of documentation about rules files that you may find helpful:\n"Format (Text -> Text) (TurtlePath -> Int -> Text -> Text -> Text)
-> Format Text (Text -> Text)
-> Format Text (TurtlePath -> Int -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Text -> Text)
forall r. Format r (Text -> r)
Turtle.s)
                  TurtlePath
relCSV ([TurtlePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TurtlePath]
candidates) Text
candidatesTxt (Line -> Text
docURL Line
"rules-files")
        Int -> TChan LogMessage -> Text -> TurtlePath -> IO TurtlePath
forall a. Int -> TChan LogMessage -> Text -> a -> IO a
errExit Int
1 TChan LogMessage
ch Text
msg TurtlePath
csvSrc

rulesFileCandidates :: TurtlePath -> ImportDirs -> [TurtlePath]
rulesFileCandidates :: TurtlePath -> ImportDirs -> [TurtlePath]
rulesFileCandidates TurtlePath
csvSrc ImportDirs
importDirs = TurtlePath -> ImportDirs -> [TurtlePath]
statementSpecificRulesFiles TurtlePath
csvSrc ImportDirs
importDirs [TurtlePath] -> [TurtlePath] -> [TurtlePath]
forall a. [a] -> [a] -> [a]
++ ImportDirs -> [TurtlePath]
generalRulesFiles ImportDirs
importDirs

importDirLines :: (ImportDirs -> TurtlePath) -> ImportDirs -> [Turtle.Line]
importDirLines :: (ImportDirs -> TurtlePath) -> ImportDirs -> [Line]
importDirLines ImportDirs -> TurtlePath
dirFun ImportDirs
importDirs = NonEmpty Line -> [Line]
forall a. NonEmpty a -> [a]
NonEmpty.toList (NonEmpty Line -> [Line]) -> NonEmpty Line -> [Line]
forall a b. (a -> b) -> a -> b
$ Text -> NonEmpty Line
Turtle.textToLines (Text -> NonEmpty Line) -> Text -> NonEmpty Line
forall a b. (a -> b) -> a -> b
$ Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp (TurtlePath -> Text) -> TurtlePath -> Text
forall a b. (a -> b) -> a -> b
$ TurtlePath -> TurtlePath
Turtle.dirname (TurtlePath -> TurtlePath) -> TurtlePath -> TurtlePath
forall a b. (a -> b) -> a -> b
$ ImportDirs -> TurtlePath
dirFun ImportDirs
importDirs

importDirLine :: (ImportDirs -> TurtlePath) -> ImportDirs -> Turtle.Line
importDirLine :: (ImportDirs -> TurtlePath) -> ImportDirs -> Line
importDirLine ImportDirs -> TurtlePath
dirFun ImportDirs
importDirs = (Line -> Line -> Line) -> Line -> [Line] -> Line
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Line -> Line -> Line
forall a. Semigroup a => a -> a -> a
(<>) Line
"" ([Line] -> Line) -> [Line] -> Line
forall a b. (a -> b) -> a -> b
$ (ImportDirs -> TurtlePath) -> ImportDirs -> [Line]
importDirLines ImportDirs -> TurtlePath
dirFun ImportDirs
importDirs

generalRulesFiles :: ImportDirs -> [TurtlePath]
generalRulesFiles :: ImportDirs -> [TurtlePath]
generalRulesFiles ImportDirs
importDirs = do
  let bank :: [Line]
bank = (ImportDirs -> TurtlePath) -> ImportDirs -> [Line]
importDirLines ImportDirs -> TurtlePath
bankDir ImportDirs
importDirs
  let account :: [Line]
account = (ImportDirs -> TurtlePath) -> ImportDirs -> [Line]
importDirLines ImportDirs -> TurtlePath
accountDir ImportDirs
importDirs
  let accountRulesFile :: TurtlePath
accountRulesFile = ImportDirs -> TurtlePath
accountDir ImportDirs
importDirs TurtlePath -> TurtlePath -> TurtlePath
</> [Line] -> Text -> TurtlePath
buildFilename ([Line]
bank [Line] -> [Line] -> [Line]
forall a. [a] -> [a] -> [a]
++ [Line]
account) Text
"rules"

  let bankRulesFile :: TurtlePath
bankRulesFile = ImportDirs -> TurtlePath
importDir ImportDirs
importDirs TurtlePath -> TurtlePath -> TurtlePath
</> [Line] -> Text -> TurtlePath
buildFilename [Line]
bank Text
"rules"
  [TurtlePath
accountRulesFile, TurtlePath
bankRulesFile]

statementSpecificRulesFiles :: TurtlePath -> ImportDirs -> [TurtlePath]
statementSpecificRulesFiles :: TurtlePath -> ImportDirs -> [TurtlePath]
statementSpecificRulesFiles TurtlePath
csvSrc ImportDirs
importDirs = do
  let srcSuffix :: Text
srcSuffix = (Text, Text) -> Text
forall a b. (a, b) -> b
snd ((Text, Text) -> Text) -> (Text, Text) -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> (Text, Text)
T.breakOnEnd Text
"_" (Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp (TurtlePath -> TurtlePath
Turtle.basename TurtlePath
csvSrc))

  if ((Int -> Text -> Text
T.take Int
3 Text
srcSuffix) Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"rfo")
    then
    do
      let srcSpecificFilename :: TurtlePath
srcSpecificFilename = Text -> TurtlePath
Turtle.fromText Text
srcSuffix TurtlePath -> Text -> TurtlePath
<.> Text
"rules"
      (TurtlePath -> TurtlePath) -> [TurtlePath] -> [TurtlePath]
forall a b. (a -> b) -> [a] -> [b]
map (TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
srcSpecificFilename) [ImportDirs -> TurtlePath
accountDir ImportDirs
importDirs, ImportDirs -> TurtlePath
bankDir ImportDirs
importDirs, ImportDirs -> TurtlePath
importDir ImportDirs
importDirs]
    else []

customConstruct :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> Turtle.Line -> Turtle.Line -> Turtle.Line -> TurtlePath -> TurtlePath -> IO TurtlePath
customConstruct :: RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Line
-> Line
-> Line
-> TurtlePath
-> TurtlePath
-> IO TurtlePath
customConstruct RuntimeOptions
opts TChan LogMessage
ch TurtlePath
constructScript Line
bank Line
account Line
owner TurtlePath
csvSrc TurtlePath
journalOut = do
  let script :: Text
script = Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp TurtlePath
constructScript :: T.Text
  let relScript :: TurtlePath
relScript = RuntimeOptions -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase RuntimeOptions
opts TurtlePath
constructScript
  let constructArgs :: [Text]
constructArgs = [Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp TurtlePath
csvSrc, Text
"-", Line -> Text
Turtle.lineToText Line
bank, Line -> Text
Turtle.lineToText Line
account, Line -> Text
Turtle.lineToText Line
owner]
  let constructCmdText :: Text
constructCmdText = Format Text (TurtlePath -> Text -> Text)
-> TurtlePath -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (TurtlePath -> Text -> Text) (TurtlePath -> Text -> Text)
"Running: "Format (TurtlePath -> Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (TurtlePath -> Text -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fpFormat (Text -> Text) (TurtlePath -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text) (Text -> Text)
" "Format (Text -> Text) (TurtlePath -> Text -> Text)
-> Format Text (Text -> Text)
-> Format Text (TurtlePath -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (Text -> Text)
forall r. Format r (Text -> r)
Turtle.s) TurtlePath
relScript ([Text] -> Text
showCmdArgs [Text]
constructArgs)
  let stdLines :: Shell Line
stdLines = (Text -> IO ()) -> ProcInput -> Shell Line
inprocWithErrFun (TChan LogMessage -> Text -> IO ()
channelErrLn TChan LogMessage
ch) (Text
script, [Text]
constructArgs, Shell Line
forall (f :: * -> *) a. Alternative f => f a
Turtle.empty)
  let hledger :: Text
hledger = Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp (TurtlePath -> Text) -> TurtlePath -> Text
forall a b. (a -> b) -> a -> b
$ AbsFile -> TurtlePath
forall b t. Path b t -> TurtlePath
pathToTurtle (AbsFile -> TurtlePath)
-> (RuntimeOptions -> AbsFile) -> RuntimeOptions -> TurtlePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HledgerInfo -> AbsFile
FlowTypes.hlPath (HledgerInfo -> AbsFile)
-> (RuntimeOptions -> HledgerInfo) -> RuntimeOptions -> AbsFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeOptions -> HledgerInfo
hledgerInfo (RuntimeOptions -> TurtlePath) -> RuntimeOptions -> TurtlePath
forall a b. (a -> b) -> a -> b
$ RuntimeOptions
opts :: T.Text
  let args :: [Text]
args = [Text
"print", Text
"--ignore-assertions", Text
"--file", Text
"-", Text
"--output-file", Format Text (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fp TurtlePath
journalOut]
  let relSrc :: TurtlePath
relSrc = RuntimeOptions -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase RuntimeOptions
opts TurtlePath
csvSrc
  let cmdLabel :: Text
cmdLabel = Format Text (TurtlePath -> TurtlePath -> Text)
-> TurtlePath -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format
  (TurtlePath -> TurtlePath -> Text)
  (TurtlePath -> TurtlePath -> Text)
"executing '"Format
  (TurtlePath -> TurtlePath -> Text)
  (TurtlePath -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fpFormat (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> Text)
-> Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (TurtlePath -> Text) (TurtlePath -> Text)
"' on '"Format (TurtlePath -> Text) (TurtlePath -> TurtlePath -> Text)
-> Format Text (TurtlePath -> Text)
-> Format Text (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text (TurtlePath -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fpFormat Text (TurtlePath -> TurtlePath -> Text)
-> Format Text Text
-> Format Text (TurtlePath -> TurtlePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format Text Text
"'") TurtlePath
relScript TurtlePath
relSrc
  FullTimedOutput
_ <- RuntimeOptions
-> TChan LogMessage
-> Text
-> [Text]
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO FullTimedOutput
forall o.
(HasSequential o, HasVerbosity o) =>
o
-> TChan LogMessage
-> Text
-> [Text]
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO FullTimedOutput
timeAndExitOnErr' RuntimeOptions
opts TChan LogMessage
ch Text
cmdLabel [Text
constructCmdText] TChan LogMessage -> Text -> IO ()
channelOut TChan LogMessage -> Text -> IO ()
channelErr (RuntimeOptions -> ProcFun
forall o. HasSequential o => o -> ProcFun
parAwareProc RuntimeOptions
opts) (Text
hledger, [Text]
args, Shell Line
stdLines)
  TurtlePath -> IO TurtlePath
forall (m :: * -> *) a. Monad m => a -> m a
return TurtlePath
journalOut