{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# 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,
     journalAddForecast,
     journalReload,
     journalReloadIfChanged,
     journalFileIsNewer,
     openBrowserOn,
     writeFileWithBackup,
     writeFileWithBackupIfChanged,
     readFileStrictly,
     pivotByOpts,
     anonymiseByOpts,
     utcTimeToClockTime,
     journalSimilarTransaction,
     tests_Cli_Utils,
    )
where
import Control.Exception as C

import Data.List
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.IO as TL
import Data.Time (UTCTime, Day, addDays)
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 System.Time (diffClockTimes, TimeDiff(TimeDiff))
import Text.Printf
import Text.Regex.TDFA ((=~))

import System.Time (ClockTime(TOD))
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)

import Hledger.Cli.CliOptions
import Hledger.Cli.Anon
import Hledger.Data
import Hledger.Read
import Hledger.Reports
import Hledger.Utils
import Control.Monad (when)

-- | Standard error message for a bad output format specified with -O/-o.
unsupportedOutputFormatError :: String -> String
unsupportedOutputFormatError :: String -> String
unsupportedOutputFormatError String
fmt = String
"Sorry, output format \""String -> String -> String
forall a. [a] -> [a] -> [a]
++String
fmtString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\" 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 :: 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.
  [String]
journalpaths <- CliOpts -> IO [String]
journalFilePathFromOpts CliOpts
opts
  Either String Journal
files <- InputOpts -> [String] -> IO (Either String Journal)
readJournalFiles (CliOpts -> InputOpts
inputopts_ CliOpts
opts) [String]
journalpaths
  let transformed :: Either String Journal
transformed = CliOpts -> Journal -> Journal
journalTransform CliOpts
opts (Journal -> Journal)
-> Either String Journal -> Either String Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String Journal
files
  (String -> IO a)
-> (Journal -> IO a) -> Either String Journal -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO a
forall a. String -> a
error' Journal -> IO a
cmd Either String Journal
transformed  -- PARTIAL:

-- | Apply some extra post-parse transformations to the journal, if
-- specified by options. These happen after journal validation, but
-- before report calculation. They include:
--
-- - adding forecast transactions (--forecast)
-- - pivoting account names (--pivot)
-- - anonymising (--anonymise).
--
journalTransform :: CliOpts -> Journal -> Journal
journalTransform :: CliOpts -> Journal -> Journal
journalTransform CliOpts
opts =
    CliOpts -> Journal -> Journal
anonymiseByOpts CliOpts
opts
  -- - converting amounts to market value (--value)
  -- . journalApplyValue ropts
  (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> Journal -> Journal
pivotByOpts CliOpts
opts
  (Journal -> Journal) -> (Journal -> Journal) -> Journal -> Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> Journal -> Journal
journalAddForecast CliOpts
opts

-- | Apply the pivot transformation on a journal, if option is present.
pivotByOpts :: CliOpts -> Journal -> Journal
pivotByOpts :: CliOpts -> Journal -> Journal
pivotByOpts CliOpts
opts =
  case String -> RawOpts -> Maybe String
maybestringopt String
"pivot" (RawOpts -> Maybe String)
-> (CliOpts -> RawOpts) -> CliOpts -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> RawOpts
rawopts_ (CliOpts -> Maybe String) -> CliOpts -> Maybe String
forall a b. (a -> b) -> a -> b
$ CliOpts
opts of
    Just String
tag -> Text -> Journal -> Journal
journalPivot (Text -> Journal -> Journal) -> Text -> Journal -> Journal
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
tag
    Maybe String
Nothing  -> Journal -> Journal
forall a. a -> a
id

-- | Apply the anonymisation transformation on a journal, if option is present
anonymiseByOpts :: CliOpts -> Journal -> Journal
anonymiseByOpts :: CliOpts -> Journal -> Journal
anonymiseByOpts 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

-- | Generate periodic transactions from all periodic transaction rules in the journal.
-- These transactions are added to the in-memory Journal (but not the on-disk file).
--
-- When --auto is active, auto posting rules will be applied to the
-- generated transactions. If the query in any auto posting rule fails
-- to parse, this function will raise an error.
--
-- The start & end date for generated periodic transactions are determined in
-- a somewhat complicated way; see the hledger manual -> Periodic transactions.
--
journalAddForecast :: CliOpts -> Journal -> Journal
journalAddForecast :: CliOpts -> Journal -> Journal
journalAddForecast CliOpts{inputopts_ :: CliOpts -> InputOpts
inputopts_=InputOpts
iopts, reportspec_ :: CliOpts -> ReportSpec
reportspec_=ReportSpec
rspec} Journal
j =
    case ReportOpts -> Maybe DateSpan
forecast_ ReportOpts
ropts of
        Maybe DateSpan
Nothing -> Journal
j
        Just DateSpan
_  -> (String -> Journal)
-> (Journal -> Journal) -> Either String Journal -> Journal
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Journal
forall a. HasCallStack => String -> a
error Journal -> Journal
forall a. a -> a
id (Either String Journal -> Journal)
-> Either String Journal -> Journal
forall a b. (a -> b) -> a -> b
$ do  -- PARTIAL:
            [Transaction]
forecasttxns <- [Transaction] -> Either String [Transaction]
addAutoTxns ([Transaction] -> Either String [Transaction])
-> Either String [Transaction] -> Either String [Transaction]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Transaction -> Either String Transaction)
-> [Transaction] -> Either String [Transaction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (BalancingOpts -> Transaction -> Either String Transaction
balanceTransaction (InputOpts -> BalancingOpts
balancingopts_ InputOpts
iopts))
                [ Transaction -> Transaction
txnTieKnot Transaction
t | PeriodicTransaction
pt <- Journal -> [PeriodicTransaction]
jperiodictxns Journal
j
                               , Transaction
t <- PeriodicTransaction -> DateSpan -> [Transaction]
runPeriodicTransaction PeriodicTransaction
pt DateSpan
forecastspan
                               , DateSpan -> Day -> Bool
spanContainsDate DateSpan
forecastspan (Transaction -> Day
tdate Transaction
t)
                               ]
            BalancingOpts -> Journal -> Either String Journal
journalBalanceTransactions (InputOpts -> BalancingOpts
balancingopts_ InputOpts
iopts) Journal
j{ jtxns :: [Transaction]
jtxns = [[Transaction]] -> [Transaction]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [Journal -> [Transaction]
jtxns Journal
j, [Transaction]
forecasttxns] }
              Either String Journal
-> (Journal -> Either String Journal) -> Either String Journal
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Journal -> Either String Journal
journalApplyCommodityStyles
  where
    today :: Day
today = ReportSpec -> Day
rsToday ReportSpec
rspec
    ropts :: ReportOpts
ropts = ReportSpec -> ReportOpts
rsOpts ReportSpec
rspec

    -- "They can start no earlier than: the day following the latest normal transaction in the journal (or today if there are none)."
    mjournalend :: Maybe Day
mjournalend   = String -> Maybe Day -> Maybe Day
forall a. Show a => String -> a -> a
dbg2 String
"journalEndDate" (Maybe Day -> Maybe Day) -> Maybe Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Bool -> Journal -> Maybe Day
journalEndDate Bool
False Journal
j  -- ignore secondary dates
    forecastbeginDefault :: Day
forecastbeginDefault = String -> Day -> Day
forall a. Show a => String -> a -> a
dbg2 String
"forecastbeginDefault" (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
today Maybe Day
mjournalend

    -- "They end on or before the specified report end date, or 180 days from today if unspecified."
    mspecifiedend :: Maybe Day
mspecifiedend = String -> Maybe Day -> Maybe Day
forall a. Show a => String -> a -> a
dbg2 String
"specifieddates" (Maybe Day -> Maybe Day) -> Maybe Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ ReportSpec -> Maybe Day
reportPeriodLastDay ReportSpec
rspec
    forecastendDefault :: Day
forecastendDefault = String -> Day -> Day
forall a. Show a => String -> a -> a
dbg2 String
"forecastendDefault" (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe (Integer -> Day -> Day
addDays Integer
180 Day
today) Maybe Day
mspecifiedend

    forecastspan :: DateSpan
forecastspan = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg2 String
"forecastspan" (DateSpan -> DateSpan) -> DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$
      DateSpan -> DateSpan -> DateSpan
spanDefaultsFrom
        (DateSpan -> Maybe DateSpan -> DateSpan
forall a. a -> Maybe a -> a
fromMaybe DateSpan
nulldatespan (Maybe DateSpan -> DateSpan) -> Maybe DateSpan -> DateSpan
forall a b. (a -> b) -> a -> b
$ String -> Maybe DateSpan -> Maybe DateSpan
forall a. Show a => String -> a -> a
dbg2 String
"forecastspan flag" (Maybe DateSpan -> Maybe DateSpan)
-> Maybe DateSpan -> Maybe DateSpan
forall a b. (a -> b) -> a -> b
$ ReportOpts -> Maybe DateSpan
forecast_ ReportOpts
ropts)
        (Maybe Day -> Maybe Day -> DateSpan
DateSpan (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
forecastbeginDefault) (Day -> Maybe Day
forall a. a -> Maybe a
Just Day
forecastendDefault))

    addAutoTxns :: [Transaction] -> Either String [Transaction]
addAutoTxns = if InputOpts -> Bool
auto_ InputOpts
iopts then Day
-> [TransactionModifier]
-> [Transaction]
-> Either String [Transaction]
modifyTransactions Day
today (Journal -> [TransactionModifier]
jtxnmodifiers Journal
j) else [Transaction] -> Either String [Transaction]
forall (m :: * -> *) a. Monad m => a -> m a
return

-- | 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 -> String -> IO ()
writeOutput CliOpts
opts String
s = do
  Maybe String
f <- CliOpts -> IO (Maybe String)
outputFileFromOpts CliOpts
opts
  ((String -> IO ())
-> (String -> String -> IO ()) -> Maybe String -> String -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String -> IO ()
putStr String -> String -> IO ()
writeFile Maybe String
f) String
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 String
f <- CliOpts -> IO (Maybe String)
outputFileFromOpts CliOpts
opts
  ((Text -> IO ())
-> (String -> Text -> IO ()) -> Maybe String -> Text -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text -> IO ()
TL.putStr String -> Text -> IO ()
TL.writeFile Maybe String
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 -> IO (Either String Journal, Bool)
journalReloadIfChanged :: CliOpts -> Day -> Journal -> IO (Either String Journal, Bool)
journalReloadIfChanged CliOpts
opts Day
_d Journal
j = do
  let maybeChangedFilename :: String -> IO (Maybe String)
maybeChangedFilename String
f = do Bool
newer <- Journal -> String -> IO Bool
journalFileIsNewer Journal
j String
f
                                  Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ if Bool
newer then String -> Maybe String
forall a. a -> Maybe a
Just String
f else Maybe String
forall a. Maybe a
Nothing
  [String]
changedfiles <- [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> [String]) -> IO [Maybe String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (String -> IO (Maybe String)) -> [String] -> IO [Maybe String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Maybe String)
maybeChangedFilename (Journal -> [String]
journalFilePaths Journal
j)
  if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
changedfiles
   then do
     -- XXX not sure why we use cmdarg's verbosity here, but keep it for now
     Bool
verbose <- IO Bool
isLoud
     Bool -> IO () -> 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) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
forall r. PrintfType r => String -> r
printf String
"%s has changed, reloading\n" ([String] -> String
forall a. [a] -> a
head [String]
changedfiles)
     Either String Journal
ej <- CliOpts -> IO (Either String Journal)
journalReload CliOpts
opts
     (Either String Journal, Bool) -> IO (Either String Journal, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Journal
ej, Bool
True)
   else
     (Either String Journal, Bool) -> IO (Either String Journal, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Journal -> Either String Journal
forall a b. b -> Either a b
Right Journal
j, Bool
False)

-- | 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 -> IO (Either String Journal)
journalReload :: CliOpts -> IO (Either String Journal)
journalReload CliOpts
opts = do
  [String]
journalpaths <- String -> [String] -> [String]
forall a. Show a => String -> a -> a
dbg6 String
"reloading files" ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CliOpts -> IO [String]
journalFilePathFromOpts CliOpts
opts
  Either String Journal
files <- InputOpts -> [String] -> IO (Either String Journal)
readJournalFiles (CliOpts -> InputOpts
inputopts_ CliOpts
opts) [String]
journalpaths
  Either String Journal -> IO (Either String Journal)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Journal -> IO (Either String Journal))
-> Either String Journal -> IO (Either String Journal)
forall a b. (a -> b) -> a -> b
$ CliOpts -> Journal -> Journal
journalTransform CliOpts
opts (Journal -> Journal)
-> Either String Journal -> Either String Journal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either String Journal
files

-- | 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 -> String -> IO Bool
journalFileIsNewer Journal{jlastreadtime :: Journal -> ClockTime
jlastreadtime=ClockTime
tread} String
f = do
  Maybe ClockTime
mtmod <- String -> IO (Maybe ClockTime)
maybeFileModificationTime String
f
  Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$
    case Maybe ClockTime
mtmod of
      Just ClockTime
tmod -> ClockTime -> ClockTime -> TimeDiff
diffClockTimes ClockTime
tmod ClockTime
tread TimeDiff -> TimeDiff -> Bool
forall a. Ord a => a -> a -> Bool
> (Int -> Int -> Int -> Int -> Int -> Int -> Integer -> TimeDiff
TimeDiff Int
0 Int
0 Int
0 Int
0 Int
0 Int
0 Integer
0)
      Maybe ClockTime
Nothing   -> Bool
False

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

utcTimeToClockTime :: UTCTime -> ClockTime
utcTimeToClockTime :: UTCTime -> ClockTime
utcTimeToClockTime UTCTime
utc = Integer -> Integer -> ClockTime
TOD Integer
posixsecs Integer
picosecs
  where
    (Integer
posixsecs, POSIXTime
frac) = POSIXTime -> (Integer, POSIXTime)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (POSIXTime -> (Integer, POSIXTime))
-> POSIXTime -> (Integer, POSIXTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utc
    picosecs :: Integer
picosecs = POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Integer) -> POSIXTime -> Integer
forall a b. (a -> b) -> a -> b
$ POSIXTime
frac POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
* POSIXTime
1e12

-- | Attempt to open a web browser on the given url, all platforms.
openBrowserOn :: String -> IO ExitCode
openBrowserOn :: String -> IO ExitCode
openBrowserOn String
u = [String] -> String -> IO ExitCode
trybrowsers [String]
browsers String
u
    where
      trybrowsers :: [String] -> String -> IO ExitCode
trybrowsers (String
b:[String]
bs) String
u = do
        (ExitCode
e,String
_,String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
b [String
u] String
""
        case ExitCode
e of
          ExitCode
ExitSuccess -> ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
          ExitFailure Int
_ -> [String] -> String -> IO ExitCode
trybrowsers [String]
bs String
u
      trybrowsers [] String
u = do
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Could not start a web browser (tried: %s)" (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
browsers
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> String
forall r. PrintfType r => String -> r
printf String
"Please open your browser and visit %s" String
u
        ExitCode -> IO ExitCode
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 :: [String]
browsers | String
osString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"darwin"  = [String
"open"]
               | String
osString -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"mingw32" = [String
"c:/Program Files/Mozilla Firefox/firefox.exe"]
               | Bool
otherwise     = [String
"sensible-browser",String
"gnome-www-browser",String
"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 :: String -> Text -> IO Bool
writeFileWithBackupIfChanged String
f Text
t = do
  Text
s <- String -> IO Text
readFilePortably String
f
  if Text
t Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
s then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else String -> IO ()
backUpFile String
f IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Text -> IO ()
T.writeFile String
f Text
t IO () -> IO Bool -> IO Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> IO Bool
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 :: String -> String -> IO ()
writeFileWithBackup String
f String
t = String -> IO ()
backUpFile String
f IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> String -> IO ()
writeFile String
f String
t

readFileStrictly :: FilePath -> IO T.Text
readFileStrictly :: String -> IO Text
readFileStrictly String
f = String -> IO Text
readFilePortably String
f IO Text -> (Text -> IO Text) -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Text
s -> Int -> IO Int
forall a. a -> IO a
C.evaluate (Text -> Int
T.length Text
s) IO Int -> IO Text -> IO Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s

-- | Back up this file with a (incrementing) numbered suffix, or give an error.
backUpFile :: FilePath -> IO ()
backUpFile :: String -> IO ()
backUpFile String
fp = do
  [String]
fs <- String -> IO [String]
safeGetDirectoryContents (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String -> String
takeDirectory (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
fp
  let (String
d,String
f) = String -> (String, String)
splitFileName String
fp
      versions :: [Int]
versions = [Maybe Int] -> [Int]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Int] -> [Int]) -> [Maybe Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (String -> Maybe Int) -> [String] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map (String
f String -> String -> Maybe Int
`backupNumber`) [String]
fs
      next :: Int
next = [Int] -> Int
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' :: String
f' = String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"%s.%d" String
f Int
next
  String -> String -> IO ()
copyFile String
fp (String
d String -> String -> String
</> String
f')

safeGetDirectoryContents :: FilePath -> IO [FilePath]
safeGetDirectoryContents :: String -> IO [String]
safeGetDirectoryContents String
"" = String -> IO [String]
getDirectoryContents String
"."
safeGetDirectoryContents String
fp = String -> IO [String]
getDirectoryContents String
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 :: String -> String -> Maybe Int
backupNumber String
f String
g = case String
g String -> String -> (String, String, String, [String])
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (String
"^" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\\.([0-9]+)$") of
                        (String
_::FilePath, String
_::FilePath, String
_::FilePath, [String
ext::FilePath]) -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMay String
ext
                        (String, String, String, [String])
_ -> 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 = Maybe Transaction
mbestmatch
  where
    mbestmatch :: Maybe Transaction
mbestmatch = (Double, Transaction) -> Transaction
forall a b. (a, b) -> b
snd ((Double, Transaction) -> Transaction)
-> Maybe (Double, Transaction) -> Maybe Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Double, Transaction)] -> Maybe (Double, Transaction)
forall a. [a] -> Maybe a
headMay [(Double, Transaction)]
bestmatches
    bestmatches :: [(Double, Transaction)]
bestmatches =
      ([(Double, Transaction)] -> String)
-> [(Double, Transaction)] -> [(Double, Transaction)]
forall a. Show a => (a -> String) -> a -> a
dbg1With ([String] -> String
unlines ([String] -> String)
-> ([(Double, Transaction)] -> [String])
-> [(Double, Transaction)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"similar transactions:"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) ([String] -> [String])
-> ([(Double, Transaction)] -> [String])
-> [(Double, Transaction)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Double, Transaction) -> String)
-> [(Double, Transaction)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Double
score,Transaction{Integer
[Tag]
[Posting]
Maybe Day
Text
Status
GenericSourcePos
Day
tindex :: Transaction -> Integer
tprecedingcomment :: Transaction -> Text
tsourcepos :: Transaction -> GenericSourcePos
tdate2 :: Transaction -> Maybe Day
tstatus :: Transaction -> Status
tcode :: Transaction -> Text
tdescription :: Transaction -> Text
tcomment :: Transaction -> Text
ttags :: Transaction -> [Tag]
tpostings :: Transaction -> [Posting]
tpostings :: [Posting]
ttags :: [Tag]
tcomment :: Text
tdescription :: Text
tcode :: Text
tstatus :: Status
tdate2 :: Maybe Day
tdate :: Day
tsourcepos :: GenericSourcePos
tprecedingcomment :: Text
tindex :: Integer
tdate :: Transaction -> Day
..}) -> String -> Double -> String -> Text -> String
forall r. PrintfType r => String -> r
printf String
"%0.3f %s %s" Double
score (Day -> String
forall a. Show a => a -> String
show Day
tdate) Text
tdescription)) ([(Double, Transaction)] -> [(Double, Transaction)])
-> [(Double, Transaction)] -> [(Double, Transaction)]
forall a b. (a -> b) -> a -> b
$
      Journal -> Query -> Text -> Int -> [(Double, Transaction)]
journalTransactionsSimilarTo Journal
j Query
q Text
desc Int
10
    q :: Query
q = ReportOpts -> Query
queryFromFlags (ReportOpts -> Query) -> ReportOpts -> Query
forall a b. (a -> b) -> a -> b
$ ReportSpec -> ReportOpts
rsOpts (ReportSpec -> ReportOpts) -> ReportSpec -> ReportOpts
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
cliopts

tests_Cli_Utils :: TestTree
tests_Cli_Utils = String -> [TestTree] -> TestTree
tests String
"Utils" [

  --  tests "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.
  --    test "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
  -- ]

 ]