module Hledger.Cli.Utils
(
withJournalDo,
writeOutput,
journalReload,
journalReloadIfChanged,
journalFileIsNewer,
journalSpecifiedFileIsNewer,
fileModificationTime,
openBrowserOn,
writeFileWithBackup,
writeFileWithBackupIfChanged,
readFileStrictly,
Test(TestList),
)
where
import Control.Exception as C
import Data.Hashable (hash)
import Data.List
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Time (Day)
import Data.Word
import Numeric
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 Test.HUnit
import Text.Printf
import Text.Regex.TDFA ((=~))
#ifdef MIN_VERSION_directory
#if MIN_VERSION_directory(1,2,0)
#define directory_1_2
#endif
#else
#define directory_1_2
#endif
#ifdef directory_1_2
import System.Time (ClockTime(TOD))
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
#endif
import Hledger.Cli.CliOptions
import Hledger.Data
import Hledger.Read
import Hledger.Utils
withJournalDo :: CliOpts -> (CliOpts -> Journal -> IO ()) -> IO ()
withJournalDo opts cmd = do
rulespath <- rulesFilePathFromOpts opts
journalpaths <- journalFilePathFromOpts opts
ej <- readJournalFiles Nothing rulespath (not $ ignore_assertions_ opts) journalpaths
either error' (cmd opts . pivotByOpts opts . anonymiseByOpts opts . journalApplyAliases (aliasesFromOpts opts)) ej
pivotByOpts :: CliOpts -> Journal -> Journal
pivotByOpts opts =
case maybestringopt "pivot" . rawopts_ $ opts of
Just tag -> pivot $ T.pack tag
Nothing -> id
pivot :: Text -> Journal -> Journal
pivot tag j = j{jtxns = map pivotTrans . jtxns $ j}
where
pivotTrans t = t{tpostings = map pivotPosting . tpostings $ t}
pivotPosting p
| Just (_ , value) <- tagTuple = p{paccount = joinAccountNames tag value}
| _ <- tagTuple = p
where tagTuple = find ((tag ==) . fst) . ptags $ p
anonymiseByOpts :: CliOpts -> Journal -> Journal
anonymiseByOpts opts =
case maybestringopt "anon" . rawopts_ $ opts of
Just _ -> anonymise
Nothing -> id
anonymise :: Journal -> Journal
anonymise j
= let
pAnons p = p { paccount = T.intercalate (T.pack ":") . map anon . T.splitOn (T.pack ":") . paccount $ p
, pcomment = T.empty
, ptransaction = fmap tAnons . ptransaction $ p
}
tAnons txn = txn { tpostings = map pAnons . tpostings $ txn
, tdescription = anon . tdescription $ txn
, tcomment = T.empty
}
in
j { jtxns = map tAnons . jtxns $ j }
where
anon = T.pack . flip showHex "" . (fromIntegral :: Int -> Word32) . hash
writeOutput :: CliOpts -> String -> IO ()
writeOutput opts s = do
f <- outputFileFromOpts opts
(if f == "-" then putStr else writeFile f) s
journalReload :: CliOpts -> IO (Either String Journal)
journalReload opts = do
rulespath <- rulesFilePathFromOpts opts
journalpaths <- journalFilePathFromOpts opts
((pivotByOpts opts . journalApplyAliases (aliasesFromOpts opts)) <$>) <$>
readJournalFiles Nothing rulespath (not $ ignore_assertions_ opts) journalpaths
journalReloadIfChanged :: CliOpts -> Day -> Journal -> IO (Either String Journal, Bool)
journalReloadIfChanged opts _d 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
whenLoud $ printf "%s has changed, reloading\n" (head changedfiles)
ej <- journalReload opts
return (ej, True)
else
return (Right j, False)
journalFileIsNewer :: Journal -> IO Bool
journalFileIsNewer j@Journal{jlastreadtime=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{jlastreadtime=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 = (do
#ifdef directory_1_2
utc <- getModificationTime f
let nom = utcTimeToPOSIXSeconds utc
let clo = TOD (read $ takeWhile (`elem` "0123456789") $ show nom) 0
#else
clo <- getModificationTime f
#endif
return clo
)
`C.catch` \(_::C.IOException) -> 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 -> T.Text -> IO Bool
writeFileWithBackupIfChanged f t = do
s <- readFile' f
if t == s then return False
else backUpFile f >> T.writeFile f t >> return True
writeFileWithBackup :: FilePath -> String -> IO ()
writeFileWithBackup f t = backUpFile f >> writeFile f t
readFileStrictly :: FilePath -> IO T.Text
readFileStrictly f = readFile' f >>= \s -> C.evaluate (T.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 g =~ ("^" ++ f ++ "\\.([0-9]+)$") of
(_::FilePath, _::FilePath, _::FilePath, [ext::FilePath]) -> readMay ext
_ -> Nothing