{-# LANGUAGE OverloadedStrings #-}

module Hledger.Flow.Reports
  ( generateReports,
  )
where

import Control.Concurrent.STM
import Data.Either
import qualified Data.List as List
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Hledger.Flow.BaseDir (relativeToBase, turtleBaseDir)
import Hledger.Flow.Common
import Hledger.Flow.Logging
import Hledger.Flow.PathHelpers (TurtlePath, pathToTurtle)
import Hledger.Flow.RuntimeOptions
import qualified Hledger.Flow.Types as FlowTypes
import Turtle ((%), (<.>), (</>))
import qualified Turtle as Turtle hiding (proc, stderr, stdout)
import Prelude hiding (putStrLn, readFile, writeFile)

data ReportParams = ReportParams
  { ReportParams -> FilePath
ledgerFile :: TurtlePath,
    ReportParams -> [Integer]
reportYears :: [Integer],
    ReportParams -> FilePath
outputDir :: TurtlePath
  }
  deriving (Int -> ReportParams -> ShowS
[ReportParams] -> ShowS
ReportParams -> FilePath
(Int -> ReportParams -> ShowS)
-> (ReportParams -> FilePath)
-> ([ReportParams] -> ShowS)
-> Show ReportParams
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReportParams -> ShowS
showsPrec :: Int -> ReportParams -> ShowS
$cshow :: ReportParams -> FilePath
show :: ReportParams -> FilePath
$cshowList :: [ReportParams] -> ShowS
showList :: [ReportParams] -> ShowS
Show)

type ReportGenerator = RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> TurtlePath -> Integer -> IO (Either TurtlePath TurtlePath)

generateReports :: RuntimeOptions -> IO ()
generateReports :: RuntimeOptions -> IO ()
generateReports 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 a. IO a -> Shell a
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 a. IO a -> Shell a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO (IO () -> Shell ()) -> IO () -> Shell ()
forall a b. (a -> b) -> a -> b
$ if (RuntimeOptions -> Bool
showOptions RuntimeOptions
opts) then TChan LogMessage -> Text -> IO ()
channelOutLn TChan LogMessage
ch (RuntimeOptions -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr RuntimeOptions
opts) else () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        ([Either FilePath FilePath]
reports, NominalDiffTime
diff) <- Shell [Either FilePath FilePath]
-> Shell ([Either FilePath FilePath], NominalDiffTime)
forall (io :: * -> *) a.
MonadIO io =>
io a -> io (a, NominalDiffTime)
Turtle.time (Shell [Either FilePath FilePath]
 -> Shell ([Either FilePath FilePath], NominalDiffTime))
-> Shell [Either FilePath FilePath]
-> Shell ([Either FilePath FilePath], NominalDiffTime)
forall a b. (a -> b) -> a -> b
$ IO [Either FilePath FilePath] -> Shell [Either FilePath FilePath]
forall a. IO a -> Shell a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO (IO [Either FilePath FilePath] -> Shell [Either FilePath FilePath])
-> IO [Either FilePath FilePath]
-> Shell [Either FilePath FilePath]
forall a b. (a -> b) -> a -> b
$ RuntimeOptions -> TChan LogMessage -> IO [Either FilePath FilePath]
generateReports' RuntimeOptions
opts TChan LogMessage
ch
        let failedAttempts :: [FilePath]
failedAttempts = [Either FilePath FilePath] -> [FilePath]
forall a b. [Either a b] -> [a]
lefts [Either FilePath FilePath]
reports
        let failedText :: Text
failedText = if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [FilePath]
failedAttempts then Text
"" else Format Text (Int -> Text) -> Int -> Text
forall r. Format Text r -> r
Turtle.format (Format (Int -> Text) (Int -> Text)
"(and attempted to write " Format (Int -> Text) (Int -> Text)
-> Format Text (Int -> Text) -> Format Text (Int -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format Text (Int -> Text)
forall n r. Integral n => Format r (n -> r)
Turtle.d Format Text (Int -> Text)
-> Format Text Text -> Format Text (Int -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format Text Text
" more) ") (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
failedAttempts
        IO () -> Shell ()
forall a. IO a -> Shell a
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 -> Text -> Text -> Text)
-> Int -> Text -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (Int -> Text -> Text -> Text) (Int -> Text -> Text -> Text)
"Generated " 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.d Format (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)
" reports " 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.s Format (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.s) ([FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Either FilePath FilePath] -> [FilePath]
forall a b. [Either a b] -> [b]
rights [Either FilePath FilePath]
reports)) Text
failedText (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 a. IO a -> Shell a
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
    )

generateReports' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> IO [Either TurtlePath TurtlePath]
generateReports' :: RuntimeOptions -> TChan LogMessage -> IO [Either FilePath FilePath]
generateReports' RuntimeOptions
opts TChan LogMessage
ch = do
  let wipMsg :: Text
wipMsg =
        Text
"These reports can be used as a starting point for more tailored reports.\n"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"The first line of each report contains the command used - change the parameters and use it in your own reports.\n"
  TChan LogMessage -> Text -> IO ()
channelOutLn TChan LogMessage
ch Text
wipMsg
  [FilePath]
owners <- Shell [FilePath] -> IO [FilePath]
forall (io :: * -> *) a. MonadIO io => Shell a -> io a
Turtle.single (Shell [FilePath] -> IO [FilePath])
-> Shell [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ Shell FilePath -> Shell [FilePath]
forall a. Shell a -> Shell [a]
shellToList (Shell FilePath -> Shell [FilePath])
-> Shell FilePath -> Shell [FilePath]
forall a b. (a -> b) -> a -> b
$ RuntimeOptions -> Shell FilePath
forall o. HasBaseDir o => o -> Shell FilePath
listOwners RuntimeOptions
opts
  Maybe Text
ledgerEnvValue <- Text -> IO (Maybe Text)
forall (io :: * -> *). MonadIO io => Text -> io (Maybe Text)
Turtle.need Text
"LEDGER_FILE" :: IO (Maybe T.Text)
  let hledgerJournal :: FilePath
hledgerJournal = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe (RuntimeOptions -> FilePath
forall o. HasBaseDir o => o -> FilePath
turtleBaseDir RuntimeOptions
opts FilePath -> ShowS
</> FilePath
allYearsFileName) (Maybe FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (Text -> FilePath) -> Maybe Text -> Maybe FilePath
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FilePath
T.unpack Maybe Text
ledgerEnvValue
  Bool
hledgerJournalExists <- FilePath -> IO Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
Turtle.testfile FilePath
hledgerJournal
  ()
_ <- if Bool -> Bool
not Bool
hledgerJournalExists then Text -> IO ()
forall (io :: * -> *) a. MonadIO io => Text -> io a
Turtle.die (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (FilePath -> Text) (FilePath -> Text)
"Unable to find journal file: " Format (FilePath -> Text) (FilePath -> Text)
-> Format Text (FilePath -> Text) -> Format Text (FilePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
Turtle.fp Format Text (FilePath -> Text)
-> Format Text Text -> Format Text (FilePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format Text Text
"\nIs your LEDGER_FILE environment variable set correctly?") FilePath
hledgerJournal else () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  let journalWithYears :: FilePath
journalWithYears = RuntimeOptions -> [FilePath] -> FilePath
journalFile RuntimeOptions
opts []
  let aggregateReportDir :: FilePath
aggregateReportDir = RuntimeOptions -> [FilePath] -> FilePath
outputReportDir RuntimeOptions
opts [FilePath
"all"]
  [Integer]
aggregateYears <- TChan LogMessage -> FilePath -> IO [Integer]
includeYears TChan LogMessage
ch FilePath
journalWithYears
  let aggregateParams :: ReportParams
aggregateParams =
        ReportParams
          { ledgerFile :: FilePath
ledgerFile = FilePath
hledgerJournal,
            reportYears :: [Integer]
reportYears = [Integer]
aggregateYears,
            outputDir :: FilePath
outputDir = FilePath
aggregateReportDir
          }
  let aggregateOnlyReports :: [IO (Either FilePath FilePath)]
aggregateOnlyReports = RuntimeOptions
-> TChan LogMessage
-> [ReportGenerator]
-> ReportParams
-> [IO (Either FilePath FilePath)]
reportActions RuntimeOptions
opts TChan LogMessage
ch [ReportGenerator
transferBalance] ReportParams
aggregateParams
  [ReportParams]
ownerParams <- RuntimeOptions
-> TChan LogMessage -> [FilePath] -> IO [ReportParams]
ownerParameters RuntimeOptions
opts TChan LogMessage
ch [FilePath]
owners
  let ownerWithAggregateParams :: [ReportParams]
ownerWithAggregateParams = (if [FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
owners Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then [ReportParams
aggregateParams] else []) [ReportParams] -> [ReportParams] -> [ReportParams]
forall a. [a] -> [a] -> [a]
++ [ReportParams]
ownerParams
  let sharedOptions :: [Text]
sharedOptions = (if RuntimeOptions -> Bool
prettyReports RuntimeOptions
opts then [Text
"--pretty-tables"] else []) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"--depth", Text
"2"]
  let ownerWithAggregateReports :: [IO (Either FilePath FilePath)]
ownerWithAggregateReports = [[IO (Either FilePath FilePath)]]
-> [IO (Either FilePath FilePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat ([[IO (Either FilePath FilePath)]]
 -> [IO (Either FilePath FilePath)])
-> [[IO (Either FilePath FilePath)]]
-> [IO (Either FilePath FilePath)]
forall a b. (a -> b) -> a -> b
$ (ReportParams -> [IO (Either FilePath FilePath)])
-> [ReportParams] -> [[IO (Either FilePath FilePath)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RuntimeOptions
-> TChan LogMessage
-> [ReportGenerator]
-> ReportParams
-> [IO (Either FilePath FilePath)]
reportActions RuntimeOptions
opts TChan LogMessage
ch [[Text] -> ReportGenerator
incomeStatement [Text]
sharedOptions, [Text] -> ReportGenerator
incomeMonthlyStatement [Text]
sharedOptions, [Text] -> ReportGenerator
balanceSheet [Text]
sharedOptions]) [ReportParams]
ownerWithAggregateParams
  let ownerOnlyReports :: [IO (Either FilePath FilePath)]
ownerOnlyReports = [[IO (Either FilePath FilePath)]]
-> [IO (Either FilePath FilePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat ([[IO (Either FilePath FilePath)]]
 -> [IO (Either FilePath FilePath)])
-> [[IO (Either FilePath FilePath)]]
-> [IO (Either FilePath FilePath)]
forall a b. (a -> b) -> a -> b
$ (ReportParams -> [IO (Either FilePath FilePath)])
-> [ReportParams] -> [[IO (Either FilePath FilePath)]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RuntimeOptions
-> TChan LogMessage
-> [ReportGenerator]
-> ReportParams
-> [IO (Either FilePath FilePath)]
reportActions RuntimeOptions
opts TChan LogMessage
ch [ReportGenerator
accountList, ReportGenerator
unknownTransactions]) [ReportParams]
ownerParams
  RuntimeOptions
-> [IO (Either FilePath FilePath)] -> IO [Either FilePath FilePath]
forall o a.
(HasSequential o, HasBatchSize o) =>
o -> [IO a] -> IO [a]
parAwareActions RuntimeOptions
opts ([IO (Either FilePath FilePath)]
aggregateOnlyReports [IO (Either FilePath FilePath)]
-> [IO (Either FilePath FilePath)]
-> [IO (Either FilePath FilePath)]
forall a. [a] -> [a] -> [a]
++ [IO (Either FilePath FilePath)]
ownerWithAggregateReports [IO (Either FilePath FilePath)]
-> [IO (Either FilePath FilePath)]
-> [IO (Either FilePath FilePath)]
forall a. [a] -> [a] -> [a]
++ [IO (Either FilePath FilePath)]
ownerOnlyReports)

reportActions :: RuntimeOptions -> TChan FlowTypes.LogMessage -> [ReportGenerator] -> ReportParams -> [IO (Either TurtlePath TurtlePath)]
reportActions :: RuntimeOptions
-> TChan LogMessage
-> [ReportGenerator]
-> ReportParams
-> [IO (Either FilePath FilePath)]
reportActions RuntimeOptions
opts TChan LogMessage
ch [ReportGenerator]
reports (ReportParams FilePath
journal [Integer]
years FilePath
reportsDir) = do
  Integer
y <- [Integer]
years
  (ReportGenerator -> IO (Either FilePath FilePath))
-> [ReportGenerator] -> [IO (Either FilePath FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (\ReportGenerator
r -> ReportGenerator
r RuntimeOptions
opts TChan LogMessage
ch FilePath
journal FilePath
reportsDir Integer
y) [ReportGenerator]
reports

accountList :: ReportGenerator
accountList :: ReportGenerator
accountList RuntimeOptions
opts TChan LogMessage
ch FilePath
journal FilePath
baseOutDir Integer
year = do
  let reportArgs :: [Text]
reportArgs = [Text
"accounts"]
  RuntimeOptions
-> TChan LogMessage
-> FilePath
-> Integer
-> FilePath
-> FilePath
-> [Text]
-> (Text -> Bool)
-> IO (Either FilePath FilePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch FilePath
journal Integer
year (FilePath
baseOutDir FilePath -> ShowS
</> Integer -> FilePath
intPath Integer
year) (FilePath
"accounts" FilePath -> ShowS
<.> FilePath
"txt") [Text]
reportArgs (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)

unknownTransactions :: ReportGenerator
unknownTransactions :: ReportGenerator
unknownTransactions RuntimeOptions
opts TChan LogMessage
ch FilePath
journal FilePath
baseOutDir Integer
year = do
  let reportArgs :: [Text]
reportArgs = [Text
"print", Text
"unknown"]
  RuntimeOptions
-> TChan LogMessage
-> FilePath
-> Integer
-> FilePath
-> FilePath
-> [Text]
-> (Text -> Bool)
-> IO (Either FilePath FilePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch FilePath
journal Integer
year (FilePath
baseOutDir FilePath -> ShowS
</> Integer -> FilePath
intPath Integer
year) (FilePath
"unknown-transactions" FilePath -> ShowS
<.> FilePath
"txt") [Text]
reportArgs (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)

incomeStatement :: [T.Text] -> ReportGenerator
incomeStatement :: [Text] -> ReportGenerator
incomeStatement [Text]
sharedOptions RuntimeOptions
opts TChan LogMessage
ch FilePath
journal FilePath
baseOutDir Integer
year = do
  let reportArgs :: [Text]
reportArgs = [Text
"incomestatement"] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sharedOptions
  RuntimeOptions
-> TChan LogMessage
-> FilePath
-> Integer
-> FilePath
-> FilePath
-> [Text]
-> (Text -> Bool)
-> IO (Either FilePath FilePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch FilePath
journal Integer
year (FilePath
baseOutDir FilePath -> ShowS
</> Integer -> FilePath
intPath Integer
year) (FilePath
"income-expenses" FilePath -> ShowS
<.> FilePath
"txt") [Text]
reportArgs (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)

incomeMonthlyStatement :: [T.Text] -> ReportGenerator
incomeMonthlyStatement :: [Text] -> ReportGenerator
incomeMonthlyStatement [Text]
sharedOptions RuntimeOptions
opts TChan LogMessage
ch FilePath
journal FilePath
baseOutDir Integer
year = do
  let reportArgs :: [Text]
reportArgs = [Text
"incomestatement"] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sharedOptions [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"--monthly"]
  RuntimeOptions
-> TChan LogMessage
-> FilePath
-> Integer
-> FilePath
-> FilePath
-> [Text]
-> (Text -> Bool)
-> IO (Either FilePath FilePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch FilePath
journal Integer
year (FilePath
baseOutDir FilePath -> ShowS
</> Integer -> FilePath
intPath Integer
year FilePath -> ShowS
</> FilePath
"monthly") (FilePath
"income-expenses" FilePath -> ShowS
<.> FilePath
"txt") [Text]
reportArgs (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)

balanceSheet :: [T.Text] -> ReportGenerator
balanceSheet :: [Text] -> ReportGenerator
balanceSheet [Text]
sharedOptions RuntimeOptions
opts TChan LogMessage
ch FilePath
journal FilePath
baseOutDir Integer
year = do
  let reportArgs :: [Text]
reportArgs = [Text
"balancesheet"] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sharedOptions [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"--flat"]
  RuntimeOptions
-> TChan LogMessage
-> FilePath
-> Integer
-> FilePath
-> FilePath
-> [Text]
-> (Text -> Bool)
-> IO (Either FilePath FilePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch FilePath
journal Integer
year (FilePath
baseOutDir FilePath -> ShowS
</> Integer -> FilePath
intPath Integer
year) (FilePath
"balance-sheet" FilePath -> ShowS
<.> FilePath
"txt") [Text]
reportArgs (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)

transferBalance :: ReportGenerator
transferBalance :: ReportGenerator
transferBalance RuntimeOptions
opts TChan LogMessage
ch FilePath
journal FilePath
baseOutDir Integer
year = do
  let reportArgs :: [Text]
reportArgs = [Text
"balance"] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (if RuntimeOptions -> Bool
prettyReports RuntimeOptions
opts then [Text
"--pretty-tables"] else []) [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
"--quarterly", Text
"--flat", Text
"--no-total", Text
"transfer"]
  RuntimeOptions
-> TChan LogMessage
-> FilePath
-> Integer
-> FilePath
-> FilePath
-> [Text]
-> (Text -> Bool)
-> IO (Either FilePath FilePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch FilePath
journal Integer
year (FilePath
baseOutDir FilePath -> ShowS
</> Integer -> FilePath
intPath Integer
year) (FilePath
"transfer-balance" FilePath -> ShowS
<.> FilePath
"txt") [Text]
reportArgs (\Text
txt -> ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> Int) -> [Text] -> Int
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.lines Text
txt) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
4)

generateReport :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> Integer -> TurtlePath -> TurtlePath -> [T.Text] -> (T.Text -> Bool) -> IO (Either TurtlePath TurtlePath)
generateReport :: RuntimeOptions
-> TChan LogMessage
-> FilePath
-> Integer
-> FilePath
-> FilePath
-> [Text]
-> (Text -> Bool)
-> IO (Either FilePath FilePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch FilePath
journal Integer
year FilePath
reportsDir FilePath
fileName [Text]
args Text -> Bool
successCheck = do
  FilePath -> IO ()
forall (io :: * -> *). MonadIO io => FilePath -> io ()
Turtle.mktree FilePath
reportsDir
  let outputFile :: FilePath
outputFile = FilePath
reportsDir FilePath -> ShowS
</> FilePath
fileName
  let relativeJournal :: FilePath
relativeJournal = RuntimeOptions -> ShowS
forall o. HasBaseDir o => o -> ShowS
relativeToBase RuntimeOptions
opts FilePath
journal
  let relativeOutputFile :: FilePath
relativeOutputFile = RuntimeOptions -> ShowS
forall o. HasBaseDir o => o -> ShowS
relativeToBase RuntimeOptions
opts FilePath
outputFile
  let reportArgs :: [Text]
reportArgs = [Text
"--file", Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
Turtle.fp FilePath
journal, Text
"--period", Integer -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr Integer
year] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
args
  let reportDisplayArgs :: [Text]
reportDisplayArgs = [Text
"--file", Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
Turtle.fp FilePath
relativeJournal, Text
"--period", Integer -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr Integer
year] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
args
  let hledger :: Text
hledger = Format Text (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
Turtle.fp (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Path Abs File -> FilePath
forall b t. Path b t -> FilePath
pathToTurtle (Path Abs File -> FilePath)
-> (RuntimeOptions -> Path Abs File) -> RuntimeOptions -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HledgerInfo -> Path Abs File
FlowTypes.hlPath (HledgerInfo -> Path Abs File)
-> (RuntimeOptions -> HledgerInfo)
-> RuntimeOptions
-> Path Abs File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RuntimeOptions -> HledgerInfo
hledgerInfo (RuntimeOptions -> FilePath) -> RuntimeOptions -> FilePath
forall a b. (a -> b) -> a -> b
$ RuntimeOptions
opts :: T.Text
  let cmdLabel :: Text
cmdLabel = Format Text (Text -> Text) -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format (Text -> Text) (Text -> Text)
"hledger " Format (Text -> Text) (Text -> Text)
-> Format Text (Text -> Text) -> Format 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) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
showCmdArgs [Text]
reportDisplayArgs
  ((ExitCode
exitCode, Text
stdOut, Text
_), NominalDiffTime
_) <- RuntimeOptions
-> TChan LogMessage
-> Text
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO (FullOutput, NominalDiffTime)
forall o.
(HasSequential o, HasVerbosity o) =>
o
-> TChan LogMessage
-> Text
-> (TChan LogMessage -> Text -> IO ())
-> (TChan LogMessage -> Text -> IO ())
-> ProcFun
-> ProcInput
-> IO (FullOutput, NominalDiffTime)
timeAndExitOnErr RuntimeOptions
opts TChan LogMessage
ch Text
cmdLabel TChan LogMessage -> Text -> IO ()
dummyLogger TChan LogMessage -> Text -> IO ()
channelErr ProcFun
forall (io :: * -> *).
MonadIO io =>
Text -> [Text] -> Shell Line -> io FullOutput
Turtle.procStrictWithErr (Text
hledger, [Text]
reportArgs, Shell Line
forall a. Monoid a => a
mempty)
  if (Text -> Bool
successCheck Text
stdOut)
    then do
      FilePath -> Text -> IO ()
T.writeFile FilePath
outputFile (Text
cmdLabel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
stdOut)
      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 (FilePath -> Text) -> FilePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (FilePath -> Text) (FilePath -> Text)
"Wrote " Format (FilePath -> Text) (FilePath -> Text)
-> Format Text (FilePath -> Text) -> Format Text (FilePath -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format Text (FilePath -> Text)
forall r. Format r (FilePath -> r)
Turtle.fp) (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ FilePath
relativeOutputFile
      Either FilePath FilePath -> IO (Either FilePath FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath FilePath -> IO (Either FilePath FilePath))
-> Either FilePath FilePath -> IO (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
outputFile
    else do
      TChan LogMessage -> Text -> IO ()
channelErrLn TChan LogMessage
ch (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (FilePath -> Text -> Text -> Text)
-> FilePath -> Text -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format
  (FilePath -> Text -> Text -> Text)
  (FilePath -> Text -> Text -> Text)
"Did not write '" Format
  (FilePath -> Text -> Text -> Text)
  (FilePath -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (FilePath -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (FilePath -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format (Text -> Text -> Text) (FilePath -> Text -> Text -> Text)
forall r. Format r (FilePath -> r)
Turtle.fp Format (Text -> Text -> Text) (FilePath -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text -> Text) (FilePath -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format (Text -> Text -> Text) (Text -> Text -> Text)
"' (" Format (Text -> Text -> Text) (FilePath -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text) (FilePath -> 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) (FilePath -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (FilePath -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
% Format (Text -> Text) (Text -> Text)
") " Format (Text -> Text) (FilePath -> Text -> Text -> Text)
-> Format Text (Text -> Text)
-> Format Text (FilePath -> 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) FilePath
relativeOutputFile Text
cmdLabel (ExitCode -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr ExitCode
exitCode)
      Bool
exists <- FilePath -> IO Bool
forall (io :: * -> *). MonadIO io => FilePath -> io Bool
Turtle.testfile FilePath
outputFile
      if Bool
exists then FilePath -> IO ()
forall (io :: * -> *). MonadIO io => FilePath -> io ()
Turtle.rm FilePath
outputFile else () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Either FilePath FilePath -> IO (Either FilePath FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath FilePath -> IO (Either FilePath FilePath))
-> Either FilePath FilePath -> IO (Either FilePath FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left FilePath
outputFile

journalFile :: RuntimeOptions -> [TurtlePath] -> TurtlePath
journalFile :: RuntimeOptions -> [FilePath] -> FilePath
journalFile RuntimeOptions
opts [FilePath]
dirs = ((FilePath -> ShowS) -> FilePath -> [FilePath] -> FilePath
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FilePath -> ShowS
(</>) (RuntimeOptions -> FilePath
forall o. HasBaseDir o => o -> FilePath
turtleBaseDir RuntimeOptions
opts) (FilePath
"import" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
dirs)) FilePath -> ShowS
</> FilePath
allYearsFileName

outputReportDir :: RuntimeOptions -> [TurtlePath] -> TurtlePath
outputReportDir :: RuntimeOptions -> [FilePath] -> FilePath
outputReportDir RuntimeOptions
opts [FilePath]
dirs = (FilePath -> ShowS) -> FilePath -> [FilePath] -> FilePath
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FilePath -> ShowS
(</>) (RuntimeOptions -> FilePath
forall o. HasBaseDir o => o -> FilePath
turtleBaseDir RuntimeOptions
opts) (FilePath
"reports" FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
dirs)

ownerParameters :: RuntimeOptions -> TChan FlowTypes.LogMessage -> [TurtlePath] -> IO [ReportParams]
ownerParameters :: RuntimeOptions
-> TChan LogMessage -> [FilePath] -> IO [ReportParams]
ownerParameters RuntimeOptions
opts TChan LogMessage
ch [FilePath]
owners = do
  let actions :: [IO ReportParams]
actions = (FilePath -> IO ReportParams) -> [FilePath] -> [IO ReportParams]
forall a b. (a -> b) -> [a] -> [b]
map (RuntimeOptions -> TChan LogMessage -> FilePath -> IO ReportParams
ownerParameters' RuntimeOptions
opts TChan LogMessage
ch) [FilePath]
owners
  RuntimeOptions -> [IO ReportParams] -> IO [ReportParams]
forall o a.
(HasSequential o, HasBatchSize o) =>
o -> [IO a] -> IO [a]
parAwareActions RuntimeOptions
opts [IO ReportParams]
actions

ownerParameters' :: RuntimeOptions -> TChan FlowTypes.LogMessage -> TurtlePath -> IO ReportParams
ownerParameters' :: RuntimeOptions -> TChan LogMessage -> FilePath -> IO ReportParams
ownerParameters' RuntimeOptions
opts TChan LogMessage
ch FilePath
owner = do
  let ownerJournal :: FilePath
ownerJournal = RuntimeOptions -> [FilePath] -> FilePath
journalFile RuntimeOptions
opts [FilePath
owner]
  [Integer]
years <- TChan LogMessage -> FilePath -> IO [Integer]
includeYears TChan LogMessage
ch FilePath
ownerJournal
  ReportParams -> IO ReportParams
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ReportParams -> IO ReportParams)
-> ReportParams -> IO ReportParams
forall a b. (a -> b) -> a -> b
$ FilePath -> [Integer] -> FilePath -> ReportParams
ReportParams FilePath
ownerJournal [Integer]
years (RuntimeOptions -> [FilePath] -> FilePath
outputReportDir RuntimeOptions
opts [FilePath
owner])