1 {-|
    2 
    3 Utilities for top-level modules and ghci. See also Hledger.Read and
    4 Hledger.Utils.
    5 
    6 -}
    7 
    8 module Hledger.Cli.Utils
    9     (
   10      withJournalDo,
   11      readJournal',
   12      journalReload,
   13      journalReloadIfChanged,
   14      journalFileIsNewer,
   15      journalSpecifiedFileIsNewer,
   16      fileModificationTime,
   17      openBrowserOn,
   18      writeFileWithBackup,
   19      writeFileWithBackupIfChanged,
   20      readFileStrictly,
   21      Test(TestList),
   22     )
   23 where
   24 import Control.Exception
   25 import Data.List
   26 import Data.Maybe
   27 import Safe (readMay)
   28 import System.Console.CmdArgs
   29 import System.Directory (getModificationTime, getDirectoryContents, copyFile)
   30 import System.Exit
   31 import System.FilePath ((</>), splitFileName, takeDirectory)
   32 import System.Info (os)
   33 import System.Process (readProcessWithExitCode)
   34 import System.Time (ClockTime, getClockTime, diffClockTimes, TimeDiff(TimeDiff))
   35 import Test.HUnit
   36 import Text.Printf
   37 
   38 import Hledger.Cli.Options
   39 import Hledger.Data
   40 import Hledger.Read
   41 import Hledger.Utils
   42 
   43 
   44 -- | Parse the user's specified journal file and run a hledger command on
   45 -- it, or throw an error.
   46 withJournalDo :: CliOpts -> (CliOpts -> Journal -> IO ()) -> IO ()
   47 withJournalDo opts cmd = do
   48   -- We kludgily read the file before parsing to grab the full text, unless
   49   -- it's stdin, or it doesn't exist and we are adding. We read it strictly
   50   -- to let the add command work.
   51   journalFilePathFromOpts opts >>= readJournalFile Nothing >>=
   52     either error' (cmd opts . journalApplyAliases (aliasesFromOpts opts))
   53 
   54 -- -- | Get a journal from the given string and options, or throw an error.
   55 -- readJournalWithOpts :: CliOpts -> String -> IO Journal
   56 -- readJournalWithOpts opts s = readJournal Nothing s >>= either error' return
   57 
   58 -- | Get a journal from the given string, or throw an error.
   59 readJournal' :: String -> IO Journal
   60 readJournal' s = readJournal Nothing s >>= either error' return
   61 
   62 -- | Re-read a journal from its data file, or return an error string.
   63 journalReload :: Journal -> IO (Either String Journal)
   64 journalReload j = readJournalFile Nothing $ journalFilePath j
   65 
   66 -- | Re-read a journal from its data file mostly, only if the file has
   67 -- changed since last read (or if there is no file, ie data read from
   68 -- stdin). The provided options are mostly ignored. Return a journal or
   69 -- the error message while reading it, and a flag indicating whether it
   70 -- was re-read or not.
   71 journalReloadIfChanged :: CliOpts -> Journal -> IO (Either String Journal, Bool)
   72 journalReloadIfChanged _ j = do
   73   let maybeChangedFilename f = do newer <- journalSpecifiedFileIsNewer j f
   74                                   return $ if newer then Just f else Nothing
   75   changedfiles <- catMaybes `fmap` mapM maybeChangedFilename (journalFilePaths j)
   76   if not $ null changedfiles
   77    then do
   78      whenLoud $ printf "%s has changed, reloading\n" (head changedfiles)
   79      jE <- journalReload j
   80      return (jE, True)
   81    else
   82      return (Right j, False)
   83 
   84 -- | Has the journal's main data file changed since the journal was last
   85 -- read ?
   86 journalFileIsNewer :: Journal -> IO Bool
   87 journalFileIsNewer j@Journal{filereadtime=tread} = do
   88   tmod <- fileModificationTime $ journalFilePath j
   89   return $ diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
   90 
   91 -- | Has the specified file (presumably one of journal's data files)
   92 -- changed since journal was last read ?
   93 journalSpecifiedFileIsNewer :: Journal -> FilePath -> IO Bool
   94 journalSpecifiedFileIsNewer Journal{filereadtime=tread} f = do
   95   tmod <- fileModificationTime f
   96   return $ diffClockTimes tmod tread > (TimeDiff 0 0 0 0 0 0 0)
   97 
   98 -- | Get the last modified time of the specified file, or if it does not
   99 -- exist or there is some other error, the current time.
  100 fileModificationTime :: FilePath -> IO ClockTime
  101 fileModificationTime f
  102     | null f = getClockTime
  103     | otherwise = getModificationTime f `Prelude.catch` \_ -> getClockTime
  104 
  105 -- | Attempt to open a web browser on the given url, all platforms.
  106 openBrowserOn :: String -> IO ExitCode
  107 openBrowserOn u = trybrowsers browsers u
  108     where
  109       trybrowsers (b:bs) u = do
  110         (e,_,_) <- readProcessWithExitCode b [u] ""
  111         case e of
  112           ExitSuccess -> return ExitSuccess
  113           ExitFailure _ -> trybrowsers bs u
  114       trybrowsers [] u = do
  115         putStrLn $ printf "Could not start a web browser (tried: %s)" $ intercalate ", " browsers
  116         putStrLn $ printf "Please open your browser and visit %s" u
  117         return $ ExitFailure 127
  118       browsers | os=="darwin"  = ["open"]
  119                | os=="mingw32" = ["c:/Program Files/Mozilla Firefox/firefox.exe"]
  120                | otherwise     = ["sensible-browser","gnome-www-browser","firefox"]
  121     -- jeffz: write a ffi binding for it using the Win32 package as a basis
  122     -- start by adding System/Win32/Shell.hsc and follow the style of any
  123     -- other module in that directory for types, headers, error handling and
  124     -- what not.
  125     -- ::ShellExecute(NULL, "open", "www.somepage.com", NULL, NULL, SW_SHOWNORMAL);
  126 
  127 -- | Back up this file with a (incrementing) numbered suffix then
  128 -- overwrite it with this new text, or give an error, but only if the text
  129 -- is different from the current file contents, and return a flag
  130 -- indicating whether we did anything.
  131 writeFileWithBackupIfChanged :: FilePath -> String -> IO Bool
  132 writeFileWithBackupIfChanged f t = do
  133   s <- readFile f
  134   if t == s then return False
  135             else backUpFile f >> writeFile f t >> return True
  136 
  137 -- | Back up this file with a (incrementing) numbered suffix, then
  138 -- overwrite it with this new text, or give an error.
  139 writeFileWithBackup :: FilePath -> String -> IO ()
  140 writeFileWithBackup f t = backUpFile f >> writeFile f t
  141 
  142 readFileStrictly :: FilePath -> IO String
  143 readFileStrictly f = readFile f >>= \s -> Control.Exception.evaluate (length s) >> return s
  144 
  145 -- | Back up this file with a (incrementing) numbered suffix, or give an error.
  146 backUpFile :: FilePath -> IO ()
  147 backUpFile fp = do
  148   fs <- safeGetDirectoryContents $ takeDirectory $ fp
  149   let (d,f) = splitFileName fp
  150       versions = catMaybes $ map (f `backupNumber`) fs
  151       next = maximum (0:versions) + 1
  152       f' = printf "%s.%d" f next
  153   copyFile fp (d </> f')
  154 
  155 safeGetDirectoryContents :: FilePath -> IO [FilePath]
  156 safeGetDirectoryContents "" = getDirectoryContents "."
  157 safeGetDirectoryContents fp = getDirectoryContents fp
  158 
  159 -- | Does the second file represent a backup of the first, and if so which version is it ?
  160 backupNumber :: FilePath -> FilePath -> Maybe Int
  161 backupNumber f g = case regexMatch ("^" ++ f ++ "\\.([0-9]+)$") g of
  162                         Just (_, ((_,suffix):_)) -> readMay suffix
  163                         _ -> Nothing