module Hledger.Cli.Utils
(
withJournalDo,
readJournalWithOpts,
journalReload,
journalReloadIfChanged,
journalFileIsNewer,
journalSpecifiedFileIsNewer,
fileModificationTime,
openBrowserOn,
writeFileWithBackup,
writeFileWithBackupIfChanged,
readFileStrictly,
Test(TestList),
)
where
import Hledger.Data
import Hledger.Read
import Hledger.Cli.Options (Opt(..),journalFilePathFromOpts)
import Control.Exception
import Safe (readMay)
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))
withJournalDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Journal -> IO ()) -> IO ()
withJournalDo opts args _ cmd = do
journalFilePathFromOpts opts >>= readJournalFile Nothing >>= either error' runcmd
where
costify = (if CostBasis `elem` opts then journalConvertAmountsToCost else id)
runcmd = cmd opts args . costify
readJournalWithOpts :: [Opt] -> String -> IO Journal
readJournalWithOpts opts s = do
j <- readJournal Nothing s >>= either error' return
return $ (if cost then journalConvertAmountsToCost else id) j
where cost = CostBasis `elem` opts
journalReload :: Journal -> IO (Either String Journal)
journalReload j = readJournalFile Nothing $ journalFilePath j
journalReloadIfChanged :: [Opt] -> Journal -> IO (Either String Journal, Bool)
journalReloadIfChanged opts j = do
let maybeChangedFilename f = do newer <- journalSpecifiedFileIsNewer j f
return $ if newer then Just f else Nothing
changedfiles <- catMaybes `fmap` mapM maybeChangedFilename (journalFilePaths j)
if not $ null changedfiles
then do
when (Verbose `elem` opts) $ printf "%s has changed, reloading\n" (head changedfiles)
jE <- journalReload j
return (jE, True)
else
return (Right j, False)
journalFileIsNewer :: Journal -> IO Bool
journalFileIsNewer j@Journal{filereadtime=tread} = do
tmod <- fileModificationTime $ journalFilePath j
return $ diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
journalSpecifiedFileIsNewer :: Journal -> FilePath -> IO Bool
journalSpecifiedFileIsNewer Journal{filereadtime=tread} f = do
tmod <- fileModificationTime f
return $ diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
fileModificationTime :: FilePath -> IO ClockTime
fileModificationTime f
| null f = getClockTime
| otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime
openBrowserOn :: String -> IO ExitCode
openBrowserOn u = trybrowsers browsers u
where
trybrowsers (b:bs) u = do
(e,_,_) <- readProcessWithExitCode b [u] ""
case e of
ExitSuccess -> return ExitSuccess
ExitFailure _ -> trybrowsers bs u
trybrowsers [] u = do
putStrLn $ printf "Could not start a web browser (tried: %s)" $ intercalate ", " browsers
putStrLn $ printf "Please open your browser and visit %s" u
return $ ExitFailure 127
browsers | os=="darwin" = ["open"]
| os=="mingw32" = ["c:/Program Files/Mozilla Firefox/firefox.exe"]
| otherwise = ["sensible-browser","gnome-www-browser","firefox"]
writeFileWithBackupIfChanged :: FilePath -> String -> IO Bool
writeFileWithBackupIfChanged f t = do
s <- readFile f
if t == s then return False
else backUpFile f >> writeFile f t >> return True
writeFileWithBackup :: FilePath -> String -> IO ()
writeFileWithBackup f t = backUpFile f >> writeFile f t
readFileStrictly :: FilePath -> IO String
readFileStrictly f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s
backUpFile :: FilePath -> IO ()
backUpFile fp = do
fs <- safeGetDirectoryContents $ takeDirectory $ fp
let (d,f) = splitFileName fp
versions = catMaybes $ map (f `backupNumber`) fs
next = maximum (0:versions) + 1
f' = printf "%s.%d" f next
copyFile fp (d </> f')
safeGetDirectoryContents :: FilePath -> IO [FilePath]
safeGetDirectoryContents "" = getDirectoryContents "."
safeGetDirectoryContents fp = getDirectoryContents fp
backupNumber :: FilePath -> FilePath -> Maybe Int
backupNumber f g = case matchRegexPR ("^" ++ f ++ "\\.([0-9]+)$") g of
Just (_, ((_,suffix):_)) -> readMay suffix
_ -> Nothing