{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|

Utilities for top-level modules and ghci. See also Hledger.Read and
Hledger.Utils.

-}

module Hledger.Cli.Utils
    (
     unsupportedOutputFormatError,
     withJournalDo,
     writeOutput,
     writeOutputLazyText,
     journalTransform,
     journalReload,
     journalReloadIfChanged,
     journalFileIsNewer,
     openBrowserOn,
     writeFileWithBackup,
     writeFileWithBackupIfChanged,
     pivotByOpts,
     anonymiseByOpts,
     journalSimilarTransaction,
     postingsOrTransactionsReportAsText,
     tests_Cli_Utils,
    )
where

import Control.Monad.Except (ExceptT)
import Control.Monad.IO.Class (liftIO)
import Data.List
import qualified Data.List.NonEmpty as NE (toList)
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text.Lazy.IO as TL
import Data.Time (Day)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
import Lens.Micro ((^.))
import Safe (readMay, headMay)
import System.Console.CmdArgs
import System.Directory (getModificationTime, getDirectoryContents, copyFile, doesFileExist)
import System.Exit
import System.FilePath ((</>), splitFileName, takeDirectory)
import System.Info (os)
import System.Process (readProcessWithExitCode)
import Text.Printf
import Text.Regex.TDFA ((=~))

import Hledger.Cli.CliOptions
import Hledger.Cli.Anon
import Hledger.Data
import Hledger.Read
import Hledger.Reports
import Hledger.Utils
import Control.Monad (when)
import Data.Functor ((<&>))

-- | Standard error message for a bad output format specified with -O/-o.
unsupportedOutputFormatError :: String -> String
unsupportedOutputFormatError :: [Char] -> [Char]
unsupportedOutputFormatError [Char]
fmt = [Char]
"Sorry, output format \""[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
fmt[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\" is unrecognised or not yet supported for this kind of report."

-- | Parse the user's specified journal file(s) as a Journal, maybe apply some
-- transformations according to options, and run a hledger command with it.
-- Or, throw an error.
withJournalDo :: CliOpts -> (Journal -> IO a) -> IO a
withJournalDo :: forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts Journal -> IO a
cmd = do
  -- We kludgily read the file before parsing to grab the full text, unless
  -- it's stdin, or it doesn't exist and we are adding. We read it strictly
  -- to let the add command work.
  NonEmpty [Char]
journalpaths <- CliOpts -> IO (NonEmpty [Char])
journalFilePathFromOpts CliOpts
opts
  Either [Char] Journal
j <- ExceptT [Char] IO Journal -> IO (Either [Char] Journal)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT [Char] IO Journal -> IO (Either [Char] Journal))
-> ExceptT [Char] IO Journal -> IO (Either [Char] Journal)
forall a b. (a -> b) -> a -> b
$ CliOpts -> Journal -> Journal
journalTransform CliOpts
opts (Journal -> Journal)
-> ExceptT [Char] IO Journal -> ExceptT [Char] IO Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputOpts -> [[Char]] -> ExceptT [Char] IO Journal
readJournalFiles (CliOpts -> InputOpts
inputopts_ CliOpts
opts) (NonEmpty [Char] -> [[Char]]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty [Char]
journalpaths)
  ([Char] -> IO a)
-> (Journal -> IO a) -> Either [Char] Journal -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> IO a
forall a. [Char] -> a
error' Journal -> IO a
cmd Either [Char] Journal
j  -- PARTIAL:

-- | Apply some extra post-parse transformations to the journal, if enabled by options.
-- These happen after parsing and finalising the journal, but before report calculation.
-- They are, in processing order:
--
-- - pivoting account names (--pivot)
--
-- - anonymising (--anonymise).
--
journalTransform :: CliOpts -> Journal -> Journal
journalTransform :: CliOpts -> Journal -> Journal
journalTransform CliOpts
opts =
      CliOpts -> Journal -> Journal
pivotByOpts CliOpts
opts
  (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CliOpts -> Journal -> Journal
anonymiseByOpts CliOpts
opts
  (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> CliOpts -> Journal -> Journal
maybeObfuscate CliOpts
opts

-- | Apply the pivot transformation on a journal (replacing account names by a different field's value), if option is present.
pivotByOpts :: CliOpts -> Journal -> Journal
pivotByOpts :: CliOpts -> Journal -> Journal
pivotByOpts CliOpts
opts =
  case [Char] -> RawOpts -> Maybe [Char]
maybestringopt [Char]
"pivot" (RawOpts -> Maybe [Char])
-> (CliOpts -> RawOpts) -> CliOpts -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> RawOpts
rawopts_ (CliOpts -> Maybe [Char]) -> CliOpts -> Maybe [Char]
forall a b. (a -> b) -> a -> b
$ CliOpts
opts of
    Just [Char]
tag -> Text -> Journal -> Journal
journalPivot (Text -> Journal -> Journal) -> Text -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$ [Char] -> Text
T.pack [Char]
tag
    Maybe [Char]
Nothing  -> Journal -> Journal
forall a. a -> a
id

-- #2133
-- | Raise an error, announcing the rename to --obfuscate and its limitations.
anonymiseByOpts :: CliOpts -> Journal -> Journal
anonymiseByOpts :: CliOpts -> Journal -> Journal
anonymiseByOpts CliOpts
opts =
  if [Char] -> RawOpts -> Bool
boolopt [Char]
"anon" (RawOpts -> Bool) -> RawOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts -> RawOpts
rawopts_ CliOpts
opts
    then [Char] -> Journal -> Journal
forall a. [Char] -> a
error' ([Char] -> Journal -> Journal) -> [Char] -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines [
       [Char]
"--anon does not give privacy, and perhaps should be avoided;"
      ,[Char]
"please see https://github.com/simonmichael/hledger/issues/2133 ."
      ,[Char]
"For now it has been renamed to --obfuscate (a hidden flag)."
      ]
    else Journal -> Journal
forall a. a -> a
id

-- | Apply light obfuscation to a journal, if --obfuscate is present (formerly --anon).
maybeObfuscate :: CliOpts -> Journal -> Journal
maybeObfuscate :: CliOpts -> Journal -> Journal
maybeObfuscate CliOpts
opts =
  if InputOpts -> Bool
anon_ (InputOpts -> Bool) -> (CliOpts -> InputOpts) -> CliOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> InputOpts
inputopts_ (CliOpts -> Bool) -> CliOpts -> Bool
forall a b. (a -> b) -> a -> b
$ CliOpts
opts
      then Journal -> Journal
forall a. Anon a => a -> a
anon
      else Journal -> Journal
forall a. a -> a
id

-- | Write some output to stdout or to a file selected by --output-file.
-- If the file exists it will be overwritten.
writeOutput :: CliOpts -> String -> IO ()
writeOutput :: CliOpts -> [Char] -> IO ()
writeOutput CliOpts
opts [Char]
s = do
  Maybe [Char]
f <- CliOpts -> IO (Maybe [Char])
outputFileFromOpts CliOpts
opts
  (([Char] -> IO ())
-> ([Char] -> [Char] -> IO ()) -> Maybe [Char] -> [Char] -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char] -> IO ()
putStr [Char] -> [Char] -> IO ()
writeFile Maybe [Char]
f) [Char]
s

-- | Write some output to stdout or to a file selected by --output-file.
-- If the file exists it will be overwritten. This function operates on Lazy
-- Text values.
writeOutputLazyText :: CliOpts -> TL.Text -> IO ()
writeOutputLazyText :: CliOpts -> Text -> IO ()
writeOutputLazyText CliOpts
opts Text
s = do
  Maybe [Char]
f <- CliOpts -> IO (Maybe [Char])
outputFileFromOpts CliOpts
opts
  ((Text -> IO ())
-> ([Char] -> Text -> IO ()) -> Maybe [Char] -> Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> IO ()
TL.putStr [Char] -> Text -> IO ()
TL.writeFile Maybe [Char]
f) Text
s

-- -- | Get a journal from the given string and options, or throw an error.
-- readJournal :: CliOpts -> String -> IO Journal
-- readJournal opts s = readJournal def Nothing s >>= either error' return

-- | Re-read the option-specified journal file(s), but only if any of
-- them has changed since last read. (If the file is standard input,
-- this will either do nothing or give an error, not tested yet).
-- Returns a journal or error message, and a flag indicating whether
-- it was re-read or not.  Like withJournalDo and journalReload, reads
-- the full journal, without filtering.
journalReloadIfChanged :: CliOpts -> Day -> Journal -> ExceptT String IO (Journal, Bool)
journalReloadIfChanged :: CliOpts -> Day -> Journal -> ExceptT [Char] IO (Journal, Bool)
journalReloadIfChanged CliOpts
opts Day
_d Journal
j = do
  let maybeChangedFilename :: [Char] -> IO (Maybe [Char])
maybeChangedFilename [Char]
f = do Bool
newer <- Journal -> [Char] -> IO Bool
journalFileIsNewer Journal
j [Char]
f
                                  Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [Char] -> IO (Maybe [Char]))
-> Maybe [Char] -> IO (Maybe [Char])
forall a b. (a -> b) -> a -> b
$ if Bool
newer then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
f else Maybe [Char]
forall a. Maybe a
Nothing
  [[Char]]
changedfiles <- IO [[Char]] -> ExceptT [Char] IO [[Char]]
forall a. IO a -> ExceptT [Char] IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Char]] -> ExceptT [Char] IO [[Char]])
-> IO [[Char]] -> ExceptT [Char] IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Maybe [Char]] -> [[Char]]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe [Char]] -> [[Char]]) -> IO [Maybe [Char]] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO (Maybe [Char])) -> [[Char]] -> IO [Maybe [Char]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM [Char] -> IO (Maybe [Char])
maybeChangedFilename (Journal -> [[Char]]
journalFilePaths Journal
j)
  case [[Char]]
changedfiles of
    []  -> (Journal, Bool) -> ExceptT [Char] IO (Journal, Bool)
forall a. a -> ExceptT [Char] IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Journal
j, Bool
False)
    [Char]
f:[[Char]]
_ -> do
      -- XXX not sure why we use cmdarg's verbosity here, but keep it for now
      Bool
verbose <- IO Bool -> ExceptT [Char] IO Bool
forall a. IO a -> ExceptT [Char] IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
isLoud
      Bool -> ExceptT [Char] IO () -> ExceptT [Char] IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
verbose Bool -> Bool -> Bool
|| Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
6) (ExceptT [Char] IO () -> ExceptT [Char] IO ())
-> (IO () -> ExceptT [Char] IO ()) -> IO () -> ExceptT [Char] IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> ExceptT [Char] IO ()
forall a. IO a -> ExceptT [Char] IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT [Char] IO ()) -> IO () -> ExceptT [Char] IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> IO ()
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s has changed, reloading\n" [Char]
f
      Journal
newj <- CliOpts -> ExceptT [Char] IO Journal
journalReload CliOpts
opts
      (Journal, Bool) -> ExceptT [Char] IO (Journal, Bool)
forall a. a -> ExceptT [Char] IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Journal
newj, Bool
True)

-- | Re-read the journal file(s) specified by options, applying any
-- transformations specified by options. Or return an error string.
-- Reads the full journal, without filtering.
journalReload :: CliOpts -> ExceptT String IO Journal
journalReload :: CliOpts -> ExceptT [Char] IO Journal
journalReload CliOpts
opts = do
  NonEmpty [Char]
journalpaths <- IO (NonEmpty [Char]) -> ExceptT [Char] IO (NonEmpty [Char])
forall a. IO a -> ExceptT [Char] IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (NonEmpty [Char]) -> ExceptT [Char] IO (NonEmpty [Char]))
-> IO (NonEmpty [Char]) -> ExceptT [Char] IO (NonEmpty [Char])
forall a b. (a -> b) -> a -> b
$ [Char] -> NonEmpty [Char] -> NonEmpty [Char]
forall a. Show a => [Char] -> a -> a
dbg6 [Char]
"reloading files" (NonEmpty [Char] -> NonEmpty [Char])
-> IO (NonEmpty [Char]) -> IO (NonEmpty [Char])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CliOpts -> IO (NonEmpty [Char])
journalFilePathFromOpts CliOpts
opts
  CliOpts -> Journal -> Journal
journalTransform CliOpts
opts (Journal -> Journal)
-> ExceptT [Char] IO Journal -> ExceptT [Char] IO Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> InputOpts -> [[Char]] -> ExceptT [Char] IO Journal
readJournalFiles (CliOpts -> InputOpts
inputopts_ CliOpts
opts) (NonEmpty [Char] -> [[Char]]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty [Char]
journalpaths)

-- | Has the specified file changed since the journal was last read ?
-- Typically this is one of the journal's journalFilePaths. These are
-- not always real files, so the file's existence is tested first;
-- for non-files the answer is always no.
journalFileIsNewer :: Journal -> FilePath -> IO Bool
journalFileIsNewer :: Journal -> [Char] -> IO Bool
journalFileIsNewer Journal{jlastreadtime :: Journal -> POSIXTime
jlastreadtime=POSIXTime
tread} [Char]
f = do
  Maybe POSIXTime
mtmod <- [Char] -> IO (Maybe POSIXTime)
maybeFileModificationTime [Char]
f
  Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
    case Maybe POSIXTime
mtmod of
      Just POSIXTime
tmod -> POSIXTime
tmod POSIXTime -> POSIXTime -> Bool
forall a. Ord a => a -> a -> Bool
> POSIXTime
tread
      Maybe POSIXTime
Nothing   -> Bool
False

-- | Get the last modified time of the specified file, if it exists.
maybeFileModificationTime :: FilePath -> IO (Maybe POSIXTime)
maybeFileModificationTime :: [Char] -> IO (Maybe POSIXTime)
maybeFileModificationTime [Char]
f = do
  Bool
exists <- [Char] -> IO Bool
doesFileExist [Char]
f
  if Bool
exists
  then do
    UTCTime
utc <- [Char] -> IO UTCTime
getModificationTime [Char]
f
    Maybe POSIXTime -> IO (Maybe POSIXTime)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe POSIXTime -> IO (Maybe POSIXTime))
-> (POSIXTime -> Maybe POSIXTime)
-> POSIXTime
-> IO (Maybe POSIXTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Maybe POSIXTime
forall a. a -> Maybe a
Just (POSIXTime -> IO (Maybe POSIXTime))
-> POSIXTime -> IO (Maybe POSIXTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utc
  else
    Maybe POSIXTime -> IO (Maybe POSIXTime)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe POSIXTime
forall a. Maybe a
Nothing

-- | Attempt to open a web browser on the given url, all platforms.
openBrowserOn :: String -> IO ExitCode
openBrowserOn :: [Char] -> IO ExitCode
openBrowserOn = [[Char]] -> [Char] -> IO ExitCode
trybrowsers [[Char]]
browsers
    where
      trybrowsers :: [[Char]] -> [Char] -> IO ExitCode
trybrowsers ([Char]
b:[[Char]]
bs) [Char]
u1 = do
        (ExitCode
e,[Char]
_,[Char]
_) <- [Char] -> [[Char]] -> [Char] -> IO (ExitCode, [Char], [Char])
readProcessWithExitCode [Char]
b [[Char]
u1] [Char]
""
        case ExitCode
e of
          ExitCode
ExitSuccess -> ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
          ExitFailure Int
_ -> [[Char]] -> [Char] -> IO ExitCode
trybrowsers [[Char]]
bs [Char]
u1
      trybrowsers [] [Char]
u1 = do
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"Could not start a web browser (tried: %s)" ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
", " [[Char]]
browsers
        [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"Please open your browser and visit %s" [Char]
u1
        ExitCode -> IO ExitCode
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure Int
127
      browsers :: [[Char]]
browsers | [Char]
os[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
"darwin"  = [[Char]
"open"]
               | [Char]
os[Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
==[Char]
"mingw32" = [[Char]
"c:/Program Files/Mozilla Firefox/firefox.exe"]
               | Bool
otherwise     = [[Char]
"sensible-browser",[Char]
"gnome-www-browser",[Char]
"firefox"]
    -- jeffz: write a ffi binding for it using the Win32 package as a basis
    -- start by adding System/Win32/Shell.hsc and follow the style of any
    -- other module in that directory for types, headers, error handling and
    -- what not.
    -- ::ShellExecute(NULL, "open", "www.somepage.com", NULL, NULL, SW_SHOWNORMAL);

-- | Back up this file with a (incrementing) numbered suffix then
-- overwrite it with this new text, or give an error, but only if the text
-- is different from the current file contents, and return a flag
-- indicating whether we did anything.
--
-- The given text should have unix line endings (\n); the existing
-- file content will be normalised to unix line endings before
-- comparing the two. If the file is overwritten, the new file will
-- have the current system's native line endings (\n on unix, \r\n on
-- windows). This could be different from the file's previous line
-- endings, if working with a DOS file on unix or vice-versa.
--
writeFileWithBackupIfChanged :: FilePath -> T.Text -> IO Bool
writeFileWithBackupIfChanged :: [Char] -> Text -> IO Bool
writeFileWithBackupIfChanged [Char]
f Text
t = do
  Text
s <- [Char] -> IO Text
readFilePortably [Char]
f
  if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else [Char] -> IO ()
backUpFile [Char]
f IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> Text -> IO ()
T.writeFile [Char]
f Text
t IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Back up this file with a (incrementing) numbered suffix, then
-- overwrite it with this new text, or give an error.
writeFileWithBackup :: FilePath -> String -> IO ()
writeFileWithBackup :: [Char] -> [Char] -> IO ()
writeFileWithBackup [Char]
f [Char]
t = [Char] -> IO ()
backUpFile [Char]
f IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Char] -> [Char] -> IO ()
writeFile [Char]
f [Char]
t

-- | Back up this file with a (incrementing) numbered suffix, or give an error.
backUpFile :: FilePath -> IO ()
backUpFile :: [Char] -> IO ()
backUpFile [Char]
fp = do
  [[Char]]
fs <- [Char] -> IO [[Char]]
safeGetDirectoryContents ([Char] -> IO [[Char]]) -> [Char] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
takeDirectory ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
fp
  let ([Char]
d,[Char]
f) = [Char] -> ([Char], [Char])
splitFileName [Char]
fp
      versions :: [Int]
versions = ([Char] -> Maybe Int) -> [[Char]] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Char]
f [Char] -> [Char] -> Maybe Int
`backupNumber`) [[Char]]
fs
      next :: Int
next = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
versions) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
      f' :: [Char]
f' = [Char] -> [Char] -> Int -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"%s.%d" [Char]
f Int
next
  [Char] -> [Char] -> IO ()
copyFile [Char]
fp ([Char]
d [Char] -> [Char] -> [Char]
</> [Char]
f')

safeGetDirectoryContents :: FilePath -> IO [FilePath]
safeGetDirectoryContents :: [Char] -> IO [[Char]]
safeGetDirectoryContents [Char]
"" = [Char] -> IO [[Char]]
getDirectoryContents [Char]
"."
safeGetDirectoryContents [Char]
fp = [Char] -> IO [[Char]]
getDirectoryContents [Char]
fp

-- | Does the second file represent a backup of the first, and if so which version is it ?
-- XXX nasty regex types intruding, add a simpler api to Hledger.Utils.Regex
backupNumber :: FilePath -> FilePath -> Maybe Int
backupNumber :: [Char] -> [Char] -> Maybe Int
backupNumber [Char]
f [Char]
g = case [Char]
g [Char] -> [Char] -> ([Char], [Char], [Char], [[Char]])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ ([Char]
"^" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
f [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\\.([0-9]+)$") of
                        ([Char]
_::FilePath, [Char]
_::FilePath, [Char]
_::FilePath, [[Char]
ext::FilePath]) -> [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMay [Char]
ext
                        ([Char], [Char], [Char], [[Char]])
_ -> Maybe Int
forall a. Maybe a
Nothing

-- Identify the closest recent match for this description in past transactions.
-- If the options specify a query, only matched transactions are considered.
journalSimilarTransaction :: CliOpts -> Journal -> T.Text -> Maybe Transaction
journalSimilarTransaction :: CliOpts -> Journal -> Text -> Maybe Transaction
journalSimilarTransaction CliOpts
cliopts Journal
j Text
desc =
  ((DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
  Transaction)
 -> Transaction)
-> Maybe
     (DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
      Transaction)
-> Maybe Transaction
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
 Transaction)
-> Transaction
forall {a} {b} {c} {d}. (a, b, c, d) -> d
fourth4 (Maybe
   (DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
    Transaction)
 -> Maybe Transaction)
-> Maybe
     (DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
      Transaction)
-> Maybe Transaction
forall a b. (a -> b) -> a -> b
$ [(DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
  Transaction)]
-> Maybe
     (DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
      Transaction)
forall a. [a] -> Maybe a
headMay ([(DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
   Transaction)]
 -> Maybe
      (DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
       Transaction))
-> [(DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
     Transaction)]
-> Maybe
     (DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
      Transaction)
forall a b. (a -> b) -> a -> b
$ Journal
-> Text
-> Query
-> DateWeightedSimilarityScore
-> Int
-> [(DateWeightedSimilarityScore, Age, DateWeightedSimilarityScore,
     Transaction)]
journalTransactionsSimilarTo Journal
j Text
desc Query
q DateWeightedSimilarityScore
0 Int
1
  where
    q :: Query
q = ReportOpts -> Query
queryFromFlags (ReportOpts -> Query) -> ReportOpts -> Query
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> ReportOpts) -> ReportSpec -> ReportOpts
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
cliopts

-- | Render a 'PostingsReport' or 'AccountTransactionsReport' as Text,
-- determining the appropriate starting widths and increasing as necessary.
postingsOrTransactionsReportAsText
    :: Bool -> CliOpts -> (Int -> Int -> (a, [WideBuilder], [WideBuilder]) -> TB.Builder)
    -> (a -> MixedAmount) -> (a -> MixedAmount) -> [a] -> TB.Builder
postingsOrTransactionsReportAsText :: forall a.
Bool
-> CliOpts
-> (Int -> Int -> (a, [WideBuilder], [WideBuilder]) -> Builder)
-> (a -> MixedAmount)
-> (a -> MixedAmount)
-> [a]
-> Builder
postingsOrTransactionsReportAsText Bool
alignAll CliOpts
opts Int -> Int -> (a, [WideBuilder], [WideBuilder]) -> Builder
itemAsText a -> MixedAmount
itemamt a -> MixedAmount
itembal [a]
report =
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (((Int, Int), [Builder]) -> [Builder])
-> ((Int, Int), [Builder])
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Int), [Builder]) -> [Builder]
forall a b. (a, b) -> b
snd (((Int, Int), [Builder]) -> Builder)
-> ((Int, Int), [Builder]) -> Builder
forall a b. (a -> b) -> a -> b
$ ((Int, Int)
 -> (a, [WideBuilder], [WideBuilder]) -> ((Int, Int), Builder))
-> (Int, Int)
-> [(a, [WideBuilder], [WideBuilder])]
-> ((Int, Int), [Builder])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
mapAccumL (Int, Int)
-> (a, [WideBuilder], [WideBuilder]) -> ((Int, Int), Builder)
renderItem (((a, [WideBuilder], [WideBuilder]) -> [WideBuilder]) -> Int
startWidth (a, [WideBuilder], [WideBuilder]) -> [WideBuilder]
forall {a} {b} {c}. (a, b, c) -> b
amt, ((a, [WideBuilder], [WideBuilder]) -> [WideBuilder]) -> Int
startWidth (a, [WideBuilder], [WideBuilder]) -> [WideBuilder]
forall {a} {b} {c}. (a, b, c) -> c
bal) [(a, [WideBuilder], [WideBuilder])]
itemsWithAmounts
  where
    minWidth :: Int
minWidth  = Int
12
    chunkSize :: Int
chunkSize = Int
1000

    renderItem :: (Int, Int)
-> (a, [WideBuilder], [WideBuilder]) -> ((Int, Int), Builder)
renderItem (Int
amtWidth, Int
balWidth) item :: (a, [WideBuilder], [WideBuilder])
item@(a
_, [WideBuilder]
amt1, [WideBuilder]
bal1) = ((Int
amtWidth', Int
balWidth'), Builder
itemBuilder)
      where
        itemBuilder :: Builder
itemBuilder = Int -> Int -> (a, [WideBuilder], [WideBuilder]) -> Builder
itemAsText Int
amtWidth' Int
balWidth' (a, [WideBuilder], [WideBuilder])
item
        amtWidth' :: Int
amtWidth' = if Bool
alignAll then Int
amtWidth else [Int] -> Int
forall a. Ord a => [a] -> a
maximumStrict ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
amtWidth Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (WideBuilder -> Int) -> [WideBuilder] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map WideBuilder -> Int
wbWidth [WideBuilder]
amt1
        balWidth' :: Int
balWidth' = if Bool
alignAll then Int
balWidth else [Int] -> Int
forall a. Ord a => [a] -> a
maximumStrict ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
balWidth Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (WideBuilder -> Int) -> [WideBuilder] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map WideBuilder -> Int
wbWidth [WideBuilder]
bal1

    startWidth :: ((a, [WideBuilder], [WideBuilder]) -> [WideBuilder]) -> Int
startWidth (a, [WideBuilder], [WideBuilder]) -> [WideBuilder]
f = [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ Int
minWidth Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: (WideBuilder -> Int) -> [WideBuilder] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map WideBuilder -> Int
wbWidth (((a, [WideBuilder], [WideBuilder]) -> [WideBuilder])
-> [(a, [WideBuilder], [WideBuilder])] -> [WideBuilder]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (a, [WideBuilder], [WideBuilder]) -> [WideBuilder]
f [(a, [WideBuilder], [WideBuilder])]
startAlign)
      where
        startAlign :: [(a, [WideBuilder], [WideBuilder])]
startAlign = (if Bool
alignAll then [(a, [WideBuilder], [WideBuilder])]
-> [(a, [WideBuilder], [WideBuilder])]
forall a. a -> a
id else Int
-> [(a, [WideBuilder], [WideBuilder])]
-> [(a, [WideBuilder], [WideBuilder])]
forall a. Int -> [a] -> [a]
take Int
chunkSize) [(a, [WideBuilder], [WideBuilder])]
itemsWithAmounts

    itemsWithAmounts :: [(a, [WideBuilder], [WideBuilder])]
itemsWithAmounts = (a -> (a, [WideBuilder], [WideBuilder]))
-> [a] -> [(a, [WideBuilder], [WideBuilder])]
forall a b. (a -> b) -> [a] -> [b]
map (\a
x -> (a
x, MixedAmount -> [WideBuilder]
showAmt (MixedAmount -> [WideBuilder]) -> MixedAmount -> [WideBuilder]
forall a b. (a -> b) -> a -> b
$ a -> MixedAmount
itemamt a
x, MixedAmount -> [WideBuilder]
showAmt (MixedAmount -> [WideBuilder]) -> MixedAmount -> [WideBuilder]
forall a b. (a -> b) -> a -> b
$ a -> MixedAmount
itembal a
x)) [a]
report
    showAmt :: MixedAmount -> [WideBuilder]
showAmt = AmountFormat -> MixedAmount -> [WideBuilder]
showMixedAmountLinesB AmountFormat
oneLineNoCostFmt{displayColour=opts^.color__}
    amt :: (a, b, c) -> b
amt = (a, b, c) -> b
forall {a} {b} {c}. (a, b, c) -> b
second3
    bal :: (a, b, c) -> c
bal = (a, b, c) -> c
forall {a} {b} {c}. (a, b, c) -> c
third3

tests_Cli_Utils :: TestTree
tests_Cli_Utils = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Utils" [

  --  testGroup "journalApplyValue" [
  --    -- Print the time required to convert one of the sample journals' amounts to value.
  --    -- Pretty clunky, but working.
  --    -- XXX sample.journal has no price records, but is always present.
  --    -- Change to eg examples/5000x1000x10.journal to make this useful.
  --    testCase "time" $ do
  --      ej <- io $ readJournalFile definputopts "examples/3000x1000x10.journal"
  --      case ej of
  --        Left e  -> crash $ T.pack e
  --        Right j -> do
  --          (t,_) <- io $ timeItT $ do
  --            -- Enable -V, and ensure the valuation date is later than
  --            -- all prices for consistent timing.
  --            let ropts = defreportopts{
  --              value_=True,
  --              period_=PeriodTo $ fromGregorian 3000 01 01
  --              }
  --            j' <- journalApplyValue ropts j
  --            sum (journalAmounts j') `seq` return ()
  --          io $ printf "[%.3fs] " t
  --          ok
  -- ]

 ]