{-# 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,
     journalTransform,
     journalAddForecast,
     journalReload,
     journalReloadIfChanged,
     journalFileIsNewer,
     journalSpecifiedFileIsNewer,
     fileModificationTime,
     openBrowserOn,
     writeFileWithBackup,
     writeFileWithBackupIfChanged,
     readFileStrictly,
     pivotByOpts,
     anonymiseByOpts,
     tests_Cli_Utils,
    )
where
import Control.Exception as C
import Control.Monad

import Data.List
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time (Day, addDays)
import Safe (readMay)
import System.Console.CmdArgs
import System.Directory (getModificationTime, getDirectoryContents, copyFile)
import System.Exit
import System.FilePath ((</>), splitFileName, takeDirectory)
import System.Info (os)
import System.Process (readProcessWithExitCode)
import System.Time (ClockTime, getClockTime, 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

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

-- | 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 opts :: CliOpts
opts cmd :: 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
  InputOpts -> [String] -> IO (Either String Journal)
readJournalFiles (CliOpts -> InputOpts
inputopts_ CliOpts
opts) [String]
journalpaths
  IO (Either String Journal)
-> (Either String Journal -> IO (Either String Journal))
-> IO (Either String Journal)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Journal -> IO Journal)
-> Either String Journal -> IO (Either String Journal)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CliOpts -> Journal -> IO Journal
journalTransform CliOpts
opts)
  IO (Either String Journal)
-> (Either String Journal -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (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  -- 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 -> IO Journal
journalTransform :: CliOpts -> Journal -> IO Journal
journalTransform opts :: CliOpts
opts@CliOpts{reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts
_ropts} =
      CliOpts -> Journal -> IO Journal
journalAddForecast CliOpts
opts
-- - converting amounts to market value (--value)
  -- >=> journalApplyValue ropts
  (Journal -> IO Journal)
-> (Journal -> IO Journal) -> Journal -> IO Journal
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Journal -> IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return (Journal -> IO Journal)
-> (Journal -> Journal) -> Journal -> IO Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> Journal -> Journal
pivotByOpts CliOpts
opts
  (Journal -> IO Journal)
-> (Journal -> IO Journal) -> Journal -> IO Journal
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Journal -> IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return (Journal -> IO Journal)
-> (Journal -> Journal) -> Journal -> IO Journal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CliOpts -> Journal -> Journal
anonymiseByOpts CliOpts
opts

-- | Apply the pivot transformation on a journal, if option is present.
pivotByOpts :: CliOpts -> Journal -> Journal
pivotByOpts :: CliOpts -> Journal -> Journal
pivotByOpts opts :: CliOpts
opts =
  case String -> RawOpts -> Maybe String
maybestringopt "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 tag :: 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
    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 opts :: 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 -> IO Journal
journalAddForecast :: CliOpts -> Journal -> IO Journal
journalAddForecast CliOpts{inputopts_ :: CliOpts -> InputOpts
inputopts_=InputOpts
iopts, reportopts_ :: CliOpts -> ReportOpts
reportopts_=ReportOpts
ropts} j :: Journal
j = do
  Day
today <- IO Day
getCurrentDay

  -- "They can start no earlier than: the day following the latest normal transaction in the journal (or today if there are none)."
  let mjournalend :: Maybe Day
mjournalend   = String -> Maybe Day -> Maybe Day
forall a. Show a => String -> a -> a
dbg2 "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 "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."
  Maybe Day
mspecifiedend <-  (Maybe Day, Maybe Day) -> Maybe Day
forall a b. (a, b) -> b
snd ((Maybe Day, Maybe Day) -> Maybe Day)
-> ((Maybe Day, Maybe Day) -> (Maybe Day, Maybe Day))
-> (Maybe Day, Maybe Day)
-> Maybe Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> (Maybe Day, Maybe Day) -> (Maybe Day, Maybe Day)
forall a. Show a => String -> a -> a
dbg2 "specifieddates" ((Maybe Day, Maybe Day) -> Maybe Day)
-> IO (Maybe Day, Maybe Day) -> IO (Maybe Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReportOpts -> IO (Maybe Day, Maybe Day)
specifiedStartEndDates ReportOpts
ropts
  let forecastendDefault :: Day
forecastendDefault = String -> Day -> Day
forall a. Show a => String -> a -> a
dbg2 "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 180 Day
today) Maybe Day
mspecifiedend
      
  let forecastspan :: DateSpan
forecastspan = String -> DateSpan -> DateSpan
forall a. Show a => String -> a -> a
dbg2 "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 "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))
          
      forecasttxns :: [Transaction]
forecasttxns =
        [ 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)
                       ]
      -- With --auto enabled, transaction modifiers are also applied to forecast txns
      forecasttxns' :: [Transaction]
forecasttxns' =
        (if InputOpts -> Bool
auto_ InputOpts
iopts then (String -> [Transaction])
-> ([Transaction] -> [Transaction])
-> Either String [Transaction]
-> [Transaction]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> [Transaction]
forall a. String -> a
error' [Transaction] -> [Transaction]
forall a. a -> a
id (Either String [Transaction] -> [Transaction])
-> ([Transaction] -> Either String [Transaction])
-> [Transaction]
-> [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day
-> [TransactionModifier]
-> [Transaction]
-> Either String [Transaction]
modifyTransactions Day
today (Journal -> [TransactionModifier]
jtxnmodifiers Journal
j) else [Transaction] -> [Transaction]
forall a. a -> a
id)  -- PARTIAL:
        [Transaction]
forecasttxns

  Journal -> IO Journal
forall (m :: * -> *) a. Monad m => a -> m a
return (Journal -> IO Journal) -> Journal -> IO Journal
forall a b. (a -> b) -> a -> b
$
    case ReportOpts -> Maybe DateSpan
forecast_ ReportOpts
ropts of
      Just _  -> InputOpts -> Journal -> Journal
journalBalanceTransactions' 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'] }
      Nothing -> Journal
j
  where
    journalBalanceTransactions' :: InputOpts -> Journal -> Journal
journalBalanceTransactions' iopts :: InputOpts
iopts j :: Journal
j =
      let assrt :: Bool
assrt = Bool -> Bool
not (Bool -> Bool) -> (InputOpts -> Bool) -> InputOpts -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputOpts -> Bool
ignore_assertions_ (InputOpts -> Bool) -> InputOpts -> Bool
forall a b. (a -> b) -> a -> b
$ InputOpts
iopts
      in
       (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. 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
$ Bool -> Journal -> Either String Journal
journalBalanceTransactions Bool
assrt Journal
j  -- PARTIAL:

-- | 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 opts :: CliOpts
opts s :: String
s = do
  String
f <- CliOpts -> IO String
outputFileFromOpts CliOpts
opts
  (if String
f String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "-" then String -> IO ()
putStr else String -> String -> IO ()
writeFile String
f) String
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 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 opts :: CliOpts
opts = do
  [String]
journalpaths <- CliOpts -> IO [String]
journalFilePathFromOpts CliOpts
opts
  InputOpts -> [String] -> IO (Either String Journal)
readJournalFiles (CliOpts -> InputOpts
inputopts_ CliOpts
opts) [String]
journalpaths
  IO (Either String Journal)
-> (Either String Journal -> IO (Either String Journal))
-> IO (Either String Journal)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Journal -> IO Journal)
-> Either String Journal -> IO (Either String Journal)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (CliOpts -> Journal -> IO Journal
journalTransform CliOpts
opts)

-- | 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 opts :: CliOpts
opts _d :: Day
_d j :: Journal
j = do
  let maybeChangedFilename :: String -> IO (Maybe String)
maybeChangedFilename f :: String
f = do Bool
newer <- Journal -> String -> IO Bool
journalSpecifiedFileIsNewer 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
     IO () -> IO ()
whenLoud (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
forall r. PrintfType r => String -> r
printf "%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)

-- | Has the journal's main data file changed since the journal was last
-- read ?
journalFileIsNewer :: Journal -> IO Bool
journalFileIsNewer :: Journal -> IO Bool
journalFileIsNewer j :: Journal
j@Journal{jlastreadtime :: Journal -> ClockTime
jlastreadtime=ClockTime
tread} = do
  ClockTime
tmod <- String -> IO ClockTime
fileModificationTime (String -> IO ClockTime) -> String -> IO ClockTime
forall a b. (a -> b) -> a -> b
$ Journal -> String
journalFilePath Journal
j
  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
$ 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 0 0 0 0 0 0 0)

-- | Has the specified file (presumably one of journal's data files)
-- changed since journal was last read ?
journalSpecifiedFileIsNewer :: Journal -> FilePath -> IO Bool
journalSpecifiedFileIsNewer :: Journal -> String -> IO Bool
journalSpecifiedFileIsNewer Journal{jlastreadtime :: Journal -> ClockTime
jlastreadtime=ClockTime
tread} f :: String
f = do
  ClockTime
tmod <- String -> IO ClockTime
fileModificationTime 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
$ 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 0 0 0 0 0 0 0)

-- | Get the last modified time of the specified file, or if it does not
-- exist or there is some other error, the current time.
fileModificationTime :: FilePath -> IO ClockTime
fileModificationTime :: String -> IO ClockTime
fileModificationTime f :: String
f
    | String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
f = IO ClockTime
getClockTime
    | Bool
otherwise = (do
        UTCTime
utc <- String -> IO UTCTime
getModificationTime String
f
        let nom :: POSIXTime
nom = UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utc
        let clo :: ClockTime
clo = Integer -> Integer -> ClockTime
TOD (String -> Integer
forall a. Read a => String -> a
read (String -> Integer) -> String -> Integer
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ("0123456789"::String)) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ POSIXTime -> String
forall a. Show a => a -> String
show POSIXTime
nom) 0 -- XXX read
        ClockTime -> IO ClockTime
forall (m :: * -> *) a. Monad m => a -> m a
return ClockTime
clo
        )
        IO ClockTime -> (IOException -> IO ClockTime) -> IO ClockTime
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`C.catch` \(IOException
_::C.IOException) -> IO ClockTime
getClockTime
-- | Attempt to open a web browser on the given url, all platforms.
openBrowserOn :: String -> IO ExitCode
openBrowserOn :: String -> IO ExitCode
openBrowserOn u :: String
u = [String] -> String -> IO ExitCode
trybrowsers [String]
browsers String
u
    where
      trybrowsers :: [String] -> String -> IO ExitCode
trybrowsers (b :: String
b:bs :: [String]
bs) u :: String
u = do
        (e :: ExitCode
e,_,_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
b [String
u] ""
        case ExitCode
e of
          ExitSuccess -> ExitCode -> IO ExitCode
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
          ExitFailure _ -> [String] -> String -> IO ExitCode
trybrowsers [String]
bs String
u
      trybrowsers [] u :: 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 "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]
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 "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 127
      browsers :: [String]
browsers | String
osString -> String -> Bool
forall a. Eq a => a -> a -> Bool
=="darwin"  = ["open"]
               | String
osString -> String -> Bool
forall a. Eq a => a -> a -> Bool
=="mingw32" = ["c:/Program Files/Mozilla Firefox/firefox.exe"]
               | Bool
otherwise     = ["sensible-browser","gnome-www-browser","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 f :: String
f t :: 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 f :: String
f t :: 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 f :: 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
>>= \s :: 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 fp :: 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 (d :: String
d,f :: 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 (0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
versions) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1
      f' :: String
f' = String -> String -> Int -> String
forall r. PrintfType r => String -> r
printf "%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 -> IO [String]
getDirectoryContents "."
safeGetDirectoryContents fp :: 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 f :: String
f g :: 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
forall a. [a] -> [a] -> [a]
++ String
f String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\\.([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
                        _ -> Maybe Int
forall a. Maybe a
Nothing

tests_Cli_Utils :: TestTree
tests_Cli_Utils = String -> [TestTree] -> TestTree
tests "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
  -- ]

 ]