{-# LANGUAGE OverloadedStrings #-}

module Hledger.Flow.Reports
    ( generateReports
    ) where

import qualified Turtle as Turtle hiding (stdout, stderr, proc)
import Turtle ((%), (</>), (<.>))
import Prelude hiding (putStrLn, writeFile)

import Hledger.Flow.RuntimeOptions
import Hledger.Flow.Common
import Hledger.Flow.BaseDir (turtleBaseDir, relativeToBase)

import Control.Concurrent.STM
import Data.Either
import Data.Maybe

import qualified Data.Text as T
import qualified Hledger.Flow.Types as FlowTypes
import Hledger.Flow.PathHelpers (TurtlePath, pathToTurtle)
import Hledger.Flow.Logging
import qualified Data.List as List

data ReportParams = ReportParams { ReportParams -> TurtlePath
ledgerFile :: TurtlePath
                                 , ReportParams -> [Integer]
reportYears :: [Integer]
                                 , ReportParams -> TurtlePath
outputDir :: TurtlePath
                                 }
                  deriving (Int -> ReportParams -> ShowS
[ReportParams] -> ShowS
ReportParams -> String
(Int -> ReportParams -> ShowS)
-> (ReportParams -> String)
-> ([ReportParams] -> ShowS)
-> Show ReportParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportParams] -> ShowS
$cshowList :: [ReportParams] -> ShowS
show :: ReportParams -> String
$cshow :: ReportParams -> String
showsPrec :: Int -> ReportParams -> ShowS
$cshowsPrec :: Int -> 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 (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
$ 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 (m :: * -> *) a. Monad m => a -> m a
return ()
    ([Either TurtlePath TurtlePath]
reports, NominalDiffTime
diff) <- Shell [Either TurtlePath TurtlePath]
-> Shell ([Either TurtlePath TurtlePath], NominalDiffTime)
forall (io :: * -> *) a.
MonadIO io =>
io a -> io (a, NominalDiffTime)
Turtle.time (Shell [Either TurtlePath TurtlePath]
 -> Shell ([Either TurtlePath TurtlePath], NominalDiffTime))
-> Shell [Either TurtlePath TurtlePath]
-> Shell ([Either TurtlePath TurtlePath], NominalDiffTime)
forall a b. (a -> b) -> a -> b
$ IO [Either TurtlePath TurtlePath]
-> Shell [Either TurtlePath TurtlePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
Turtle.liftIO (IO [Either TurtlePath TurtlePath]
 -> Shell [Either TurtlePath TurtlePath])
-> IO [Either TurtlePath TurtlePath]
-> Shell [Either TurtlePath TurtlePath]
forall a b. (a -> b) -> a -> b
$ RuntimeOptions
-> TChan LogMessage -> IO [Either TurtlePath TurtlePath]
generateReports' RuntimeOptions
opts TChan LogMessage
ch
    let failedAttempts :: [TurtlePath]
failedAttempts = [Either TurtlePath TurtlePath] -> [TurtlePath]
forall a b. [Either a b] -> [a]
lefts [Either TurtlePath TurtlePath]
reports
    let failedText :: Text
failedText = if [TurtlePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null [TurtlePath]
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.dFormat 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
$ [TurtlePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TurtlePath]
failedAttempts
    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 -> 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.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)
" 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.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.s) ([TurtlePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Either TurtlePath TurtlePath] -> [TurtlePath]
forall a b. [Either a b] -> [b]
rights [Either TurtlePath TurtlePath]
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 (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 TurtlePath TurtlePath]
generateReports' RuntimeOptions
opts TChan LogMessage
ch = do
  let wipMsg :: Text
wipMsg = Text
"Report generation is still a work-in-progress - please let me know how this can be more useful.\n\n"
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Keep an eye out for report-related pull requests and issues, and feel free to submit some of your own:\n"
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"https://github.com/apauley/hledger-flow/pulls\n"
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"https://github.com/apauley/hledger-flow/issues\n"
  TChan LogMessage -> Text -> IO ()
channelOutLn TChan LogMessage
ch Text
wipMsg
  [TurtlePath]
owners <- Shell [TurtlePath] -> IO [TurtlePath]
forall (io :: * -> *) a. MonadIO io => Shell a -> io a
Turtle.single (Shell [TurtlePath] -> IO [TurtlePath])
-> Shell [TurtlePath] -> IO [TurtlePath]
forall a b. (a -> b) -> a -> b
$ Shell TurtlePath -> Shell [TurtlePath]
forall a. Shell a -> Shell [a]
shellToList (Shell TurtlePath -> Shell [TurtlePath])
-> Shell TurtlePath -> Shell [TurtlePath]
forall a b. (a -> b) -> a -> b
$ RuntimeOptions -> Shell TurtlePath
forall o. HasBaseDir o => o -> Shell TurtlePath
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 :: TurtlePath
hledgerJournal = TurtlePath -> Maybe TurtlePath -> TurtlePath
forall a. a -> Maybe a -> a
fromMaybe (RuntimeOptions -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath
turtleBaseDir RuntimeOptions
opts TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
allYearsFileName) (Maybe TurtlePath -> TurtlePath) -> Maybe TurtlePath -> TurtlePath
forall a b. (a -> b) -> a -> b
$ (Text -> TurtlePath) -> Maybe Text -> Maybe TurtlePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> TurtlePath
Turtle.fromText Maybe Text
ledgerEnvValue
  Bool
hledgerJournalExists <- TurtlePath -> IO Bool
forall (io :: * -> *). MonadIO io => TurtlePath -> io Bool
Turtle.testfile TurtlePath
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 (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (TurtlePath -> Text) (TurtlePath -> Text)
"Unable to find journal file: "Format (TurtlePath -> Text) (TurtlePath -> Text)
-> Format Text (TurtlePath -> Text)
-> Format 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.fpFormat Text (TurtlePath -> Text)
-> Format Text Text -> Format Text (TurtlePath -> 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?") TurtlePath
hledgerJournal else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  let journalWithYears :: TurtlePath
journalWithYears = RuntimeOptions -> [TurtlePath] -> TurtlePath
journalFile RuntimeOptions
opts []
  let aggregateReportDir :: TurtlePath
aggregateReportDir = RuntimeOptions -> [TurtlePath] -> TurtlePath
outputReportDir RuntimeOptions
opts [TurtlePath
"all"]
  [Integer]
aggregateYears <- TChan LogMessage -> TurtlePath -> IO [Integer]
includeYears TChan LogMessage
ch TurtlePath
journalWithYears
  let aggregateParams :: ReportParams
aggregateParams = ReportParams :: TurtlePath -> [Integer] -> TurtlePath -> ReportParams
ReportParams { ledgerFile :: TurtlePath
ledgerFile = TurtlePath
hledgerJournal
                                     , reportYears :: [Integer]
reportYears = [Integer]
aggregateYears
                                     , outputDir :: TurtlePath
outputDir = TurtlePath
aggregateReportDir}
  let aggregateOnlyReports :: [IO (Either TurtlePath TurtlePath)]
aggregateOnlyReports = RuntimeOptions
-> TChan LogMessage
-> [ReportGenerator]
-> ReportParams
-> [IO (Either TurtlePath TurtlePath)]
reportActions RuntimeOptions
opts TChan LogMessage
ch [ReportGenerator
transferBalance] ReportParams
aggregateParams
  [ReportParams]
ownerParams <- RuntimeOptions
-> TChan LogMessage -> [TurtlePath] -> IO [ReportParams]
ownerParameters RuntimeOptions
opts TChan LogMessage
ch [TurtlePath]
owners
  let ownerWithAggregateParams :: [ReportParams]
ownerWithAggregateParams = (if [TurtlePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TurtlePath]
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 = [Text
"--pretty-tables", Text
"--depth", Text
"2"]
  let ownerWithAggregateReports :: [IO (Either TurtlePath TurtlePath)]
ownerWithAggregateReports = [[IO (Either TurtlePath TurtlePath)]]
-> [IO (Either TurtlePath TurtlePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat ([[IO (Either TurtlePath TurtlePath)]]
 -> [IO (Either TurtlePath TurtlePath)])
-> [[IO (Either TurtlePath TurtlePath)]]
-> [IO (Either TurtlePath TurtlePath)]
forall a b. (a -> b) -> a -> b
$ (ReportParams -> [IO (Either TurtlePath TurtlePath)])
-> [ReportParams] -> [[IO (Either TurtlePath TurtlePath)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RuntimeOptions
-> TChan LogMessage
-> [ReportGenerator]
-> ReportParams
-> [IO (Either TurtlePath TurtlePath)]
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 TurtlePath TurtlePath)]
ownerOnlyReports = [[IO (Either TurtlePath TurtlePath)]]
-> [IO (Either TurtlePath TurtlePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
List.concat ([[IO (Either TurtlePath TurtlePath)]]
 -> [IO (Either TurtlePath TurtlePath)])
-> [[IO (Either TurtlePath TurtlePath)]]
-> [IO (Either TurtlePath TurtlePath)]
forall a b. (a -> b) -> a -> b
$ (ReportParams -> [IO (Either TurtlePath TurtlePath)])
-> [ReportParams] -> [[IO (Either TurtlePath TurtlePath)]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (RuntimeOptions
-> TChan LogMessage
-> [ReportGenerator]
-> ReportParams
-> [IO (Either TurtlePath TurtlePath)]
reportActions RuntimeOptions
opts TChan LogMessage
ch [ReportGenerator
accountList, ReportGenerator
unknownTransactions]) [ReportParams]
ownerParams
  RuntimeOptions
-> [IO (Either TurtlePath TurtlePath)]
-> IO [Either TurtlePath TurtlePath]
forall o a.
(HasSequential o, HasBatchSize o) =>
o -> [IO a] -> IO [a]
parAwareActions RuntimeOptions
opts ([IO (Either TurtlePath TurtlePath)]
aggregateOnlyReports [IO (Either TurtlePath TurtlePath)]
-> [IO (Either TurtlePath TurtlePath)]
-> [IO (Either TurtlePath TurtlePath)]
forall a. [a] -> [a] -> [a]
++ [IO (Either TurtlePath TurtlePath)]
ownerWithAggregateReports [IO (Either TurtlePath TurtlePath)]
-> [IO (Either TurtlePath TurtlePath)]
-> [IO (Either TurtlePath TurtlePath)]
forall a. [a] -> [a] -> [a]
++ [IO (Either TurtlePath TurtlePath)]
ownerOnlyReports)

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

accountList :: ReportGenerator
accountList :: ReportGenerator
accountList RuntimeOptions
opts TChan LogMessage
ch TurtlePath
journal TurtlePath
baseOutDir Integer
year = do
  let reportArgs :: [Text]
reportArgs = [Text
"accounts"]
  RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Integer
-> TurtlePath
-> TurtlePath
-> [Text]
-> (Text -> Bool)
-> IO (Either TurtlePath TurtlePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch TurtlePath
journal Integer
year (TurtlePath
baseOutDir TurtlePath -> TurtlePath -> TurtlePath
</> Integer -> TurtlePath
intPath Integer
year) (TurtlePath
"accounts" TurtlePath -> Text -> TurtlePath
<.> Text
"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 TurtlePath
journal TurtlePath
baseOutDir Integer
year = do
  let reportArgs :: [Text]
reportArgs = [Text
"print", Text
"unknown"]
  RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Integer
-> TurtlePath
-> TurtlePath
-> [Text]
-> (Text -> Bool)
-> IO (Either TurtlePath TurtlePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch TurtlePath
journal Integer
year (TurtlePath
baseOutDir TurtlePath -> TurtlePath -> TurtlePath
</> Integer -> TurtlePath
intPath Integer
year) (TurtlePath
"unknown-transactions" TurtlePath -> Text -> TurtlePath
<.> Text
"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 TurtlePath
journal TurtlePath
baseOutDir Integer
year = do
  let reportArgs :: [Text]
reportArgs = [Text
"incomestatement"] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
sharedOptions
  RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Integer
-> TurtlePath
-> TurtlePath
-> [Text]
-> (Text -> Bool)
-> IO (Either TurtlePath TurtlePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch TurtlePath
journal Integer
year (TurtlePath
baseOutDir TurtlePath -> TurtlePath -> TurtlePath
</> Integer -> TurtlePath
intPath Integer
year) (TurtlePath
"income-expenses" TurtlePath -> Text -> TurtlePath
<.> Text
"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 TurtlePath
journal TurtlePath
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
-> TurtlePath
-> Integer
-> TurtlePath
-> TurtlePath
-> [Text]
-> (Text -> Bool)
-> IO (Either TurtlePath TurtlePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch TurtlePath
journal Integer
year (TurtlePath
baseOutDir TurtlePath -> TurtlePath -> TurtlePath
</> Integer -> TurtlePath
intPath Integer
year TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
"monthly") (TurtlePath
"income-expenses" TurtlePath -> Text -> TurtlePath
<.> Text
"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 TurtlePath
journal TurtlePath
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
-> TurtlePath
-> Integer
-> TurtlePath
-> TurtlePath
-> [Text]
-> (Text -> Bool)
-> IO (Either TurtlePath TurtlePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch TurtlePath
journal Integer
year (TurtlePath
baseOutDir TurtlePath -> TurtlePath -> TurtlePath
</> Integer -> TurtlePath
intPath Integer
year) (TurtlePath
"balance-sheet" TurtlePath -> Text -> TurtlePath
<.> Text
"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 TurtlePath
journal TurtlePath
baseOutDir Integer
year = do
  let reportArgs :: [Text]
reportArgs = [Text
"balance", Text
"--pretty-tables", Text
"--quarterly", Text
"--flat", Text
"--no-total", Text
"transfer"]
  RuntimeOptions
-> TChan LogMessage
-> TurtlePath
-> Integer
-> TurtlePath
-> TurtlePath
-> [Text]
-> (Text -> Bool)
-> IO (Either TurtlePath TurtlePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch TurtlePath
journal Integer
year (TurtlePath
baseOutDir TurtlePath -> TurtlePath -> TurtlePath
</> Integer -> TurtlePath
intPath Integer
year) (TurtlePath
"transfer-balance" TurtlePath -> Text -> TurtlePath
<.> Text
"txt") [Text]
reportArgs (\Text
txt -> ([Text] -> 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
-> TurtlePath
-> Integer
-> TurtlePath
-> TurtlePath
-> [Text]
-> (Text -> Bool)
-> IO (Either TurtlePath TurtlePath)
generateReport RuntimeOptions
opts TChan LogMessage
ch TurtlePath
journal Integer
year TurtlePath
reportsDir TurtlePath
fileName [Text]
args Text -> Bool
successCheck = do
  TurtlePath -> IO ()
forall (io :: * -> *). MonadIO io => TurtlePath -> io ()
Turtle.mktree TurtlePath
reportsDir
  let outputFile :: TurtlePath
outputFile = TurtlePath
reportsDir TurtlePath -> TurtlePath -> TurtlePath
</> TurtlePath
fileName
  let relativeJournal :: TurtlePath
relativeJournal = RuntimeOptions -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase RuntimeOptions
opts TurtlePath
journal
  let relativeOutputFile :: TurtlePath
relativeOutputFile = RuntimeOptions -> TurtlePath -> TurtlePath
forall o. HasBaseDir o => o -> TurtlePath -> TurtlePath
relativeToBase RuntimeOptions
opts TurtlePath
outputFile
  let reportArgs :: [Text]
reportArgs = [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
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 (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
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 (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
$ Path Abs File -> TurtlePath
forall b t. Path b t -> TurtlePath
pathToTurtle (Path Abs File -> TurtlePath)
-> (RuntimeOptions -> Path Abs File)
-> RuntimeOptions
-> TurtlePath
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 -> TurtlePath) -> RuntimeOptions -> TurtlePath
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
      TurtlePath -> Text -> IO ()
Turtle.writeTextFile TurtlePath
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 (TurtlePath -> Text) -> TurtlePath -> Text
forall r. Format Text r -> r
Turtle.format (Format (TurtlePath -> Text) (TurtlePath -> Text)
"Wrote "Format (TurtlePath -> Text) (TurtlePath -> Text)
-> Format Text (TurtlePath -> Text)
-> Format 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) (TurtlePath -> Text) -> TurtlePath -> Text
forall a b. (a -> b) -> a -> b
$ TurtlePath
relativeOutputFile
      Either TurtlePath TurtlePath -> IO (Either TurtlePath TurtlePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TurtlePath TurtlePath -> IO (Either TurtlePath TurtlePath))
-> Either TurtlePath TurtlePath
-> IO (Either TurtlePath TurtlePath)
forall a b. (a -> b) -> a -> b
$ TurtlePath -> Either TurtlePath TurtlePath
forall a b. b -> Either a b
Right TurtlePath
outputFile
    else
    do
      TChan LogMessage -> Text -> IO ()
channelErrLn TChan LogMessage
ch (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ Format Text (TurtlePath -> Text -> Text -> Text)
-> TurtlePath -> Text -> Text -> Text
forall r. Format Text r -> r
Turtle.format (Format
  (TurtlePath -> Text -> Text -> Text)
  (TurtlePath -> Text -> Text -> Text)
"Did not write '"Format
  (TurtlePath -> Text -> Text -> Text)
  (TurtlePath -> Text -> Text -> Text)
-> Format
     (Text -> Text -> Text) (TurtlePath -> Text -> Text -> Text)
-> Format
     (Text -> Text -> Text) (TurtlePath -> Text -> Text -> Text)
forall b c a. Format b c -> Format a b -> Format a c
%Format (Text -> Text -> Text) (TurtlePath -> Text -> Text -> Text)
forall r. Format r (TurtlePath -> r)
Turtle.fpFormat (Text -> Text -> Text) (TurtlePath -> Text -> Text -> Text)
-> Format (Text -> Text -> Text) (Text -> Text -> Text)
-> Format
     (Text -> Text -> Text) (TurtlePath -> 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) (TurtlePath -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text -> Text)
-> Format (Text -> Text) (TurtlePath -> 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) (TurtlePath -> Text -> Text -> Text)
-> Format (Text -> Text) (Text -> Text)
-> Format (Text -> Text) (TurtlePath -> Text -> 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 -> Text)
-> Format Text (Text -> Text)
-> Format Text (TurtlePath -> 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
relativeOutputFile Text
cmdLabel (ExitCode -> Text
forall a text. (Show a, IsString text) => a -> text
Turtle.repr ExitCode
exitCode)
      Bool
exists <- TurtlePath -> IO Bool
forall (io :: * -> *). MonadIO io => TurtlePath -> io Bool
Turtle.testfile TurtlePath
outputFile
      if Bool
exists then TurtlePath -> IO ()
forall (io :: * -> *). MonadIO io => TurtlePath -> io ()
Turtle.rm TurtlePath
outputFile else () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Either TurtlePath TurtlePath -> IO (Either TurtlePath TurtlePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either TurtlePath TurtlePath -> IO (Either TurtlePath TurtlePath))
-> Either TurtlePath TurtlePath
-> IO (Either TurtlePath TurtlePath)
forall a b. (a -> b) -> a -> b
$ TurtlePath -> Either TurtlePath TurtlePath
forall a b. a -> Either a b
Left TurtlePath
outputFile

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

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

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