{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
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)
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."
withJournalDo :: CliOpts -> (Journal -> IO a) -> IO a
withJournalDo :: CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts Journal -> IO a
cmd = do
[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
journalTransform :: CliOpts -> Journal -> Journal
journalTransform :: CliOpts -> Journal -> Journal
journalTransform CliOpts
opts =
CliOpts -> Journal -> Journal
anonymiseByOpts CliOpts
opts
(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
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
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
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
[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
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
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
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
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
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
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
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)
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
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
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
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"]
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
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
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
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
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" [
]