{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Hledger.Cli.Utils
(
unsupportedOutputFormatError,
withJournalDo,
writeOutput,
writeOutputLazyText,
journalTransform,
journalReload,
journalReloadIfChanged,
journalFileIsNewer,
openBrowserOn,
writeFileWithBackup,
writeFileWithBackupIfChanged,
readFileStrictly,
pivotByOpts,
anonymiseByOpts,
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 (Day)
import Data.Time.Clock.POSIX (POSIXTime, utcTimeToPOSIXSeconds)
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)
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
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
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 -> POSIXTime
jlastreadtime=POSIXTime
tread} String
f = do
Maybe POSIXTime
mtmod <- String -> IO (Maybe POSIXTime)
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 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
maybeFileModificationTime :: FilePath -> IO (Maybe POSIXTime)
maybeFileModificationTime :: String -> IO (Maybe POSIXTime)
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 POSIXTime -> IO (Maybe POSIXTime)
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 (m :: * -> *) a. Monad m => a -> m a
return Maybe POSIXTime
forall a. Maybe a
Nothing
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 = (String -> Maybe Int) -> [String] -> [Int]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (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
(SourcePos, SourcePos)
Text
Status
Day
tindex :: Transaction -> Integer
tprecedingcomment :: Transaction -> Text
tsourcepos :: Transaction -> (SourcePos, SourcePos)
tdate :: Transaction -> Day
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 :: (SourcePos, SourcePos)
tprecedingcomment :: Text
tindex :: Integer
..}) -> 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
_rsReportOpts (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
testGroup String
"Utils" [
]