a2b8faa4d6
We now do data filtering/massage as late as possible, not just once at startup. This should work better for multiple commands, as with web or ui. The basic benchmark seems at least as good as before thanks to laziness.
88 lines
3.6 KiB
Haskell
88 lines
3.6 KiB
Haskell
{-|
|
|
|
|
Utilities for top-level modules and ghci. See also "Ledger.IO" and
|
|
"Ledger.Utils".
|
|
|
|
-}
|
|
|
|
module Utils
|
|
where
|
|
import Control.Monad.Error
|
|
import Ledger
|
|
import Options (Opt(..),ledgerFilePathFromOpts) -- ,optsToFilterSpec)
|
|
import System.Directory (doesFileExist)
|
|
import System.IO (stderr)
|
|
import System.IO.UTF8 (hPutStrLn)
|
|
import System.Exit
|
|
import System.Cmd (system)
|
|
import System.Info (os)
|
|
import System.Time (ClockTime,getClockTime)
|
|
|
|
|
|
-- | Parse the user's specified ledger file and run a hledger command on
|
|
-- it, or report a parse error. This function makes the whole thing go.
|
|
withLedgerDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO ()
|
|
withLedgerDo opts args cmdname cmd = do
|
|
-- We kludgily read the file before parsing to grab the full text, unless
|
|
-- it's stdin, or it doesn't exist and we are adding. We read it strictly
|
|
-- to let the add command work.
|
|
f <- ledgerFilePathFromOpts opts
|
|
let f' = if f == "-" then "/dev/null" else f
|
|
fileexists <- doesFileExist f
|
|
let creating = not fileexists && cmdname == "add"
|
|
t <- getCurrentLocalTime
|
|
tc <- getClockTime
|
|
txt <- if creating then return "" else strictReadFile f'
|
|
let runcmd = cmd opts args . mkLedger opts f tc txt
|
|
if creating
|
|
then runcmd nulljournal
|
|
else (runErrorT . parseLedgerFile t) f >>= either parseerror runcmd
|
|
where parseerror e = hPutStrLn stderr e >> exitWith (ExitFailure 1)
|
|
|
|
mkLedger :: [Opt] -> FilePath -> ClockTime -> String -> Journal -> Ledger
|
|
mkLedger opts f tc txt j = nullledger{journaltext=txt,journal=j'}
|
|
where j' = (canonicaliseAmounts costbasis j){filepath=f,filereadtime=tc}
|
|
costbasis=CostBasis `elem` opts
|
|
|
|
-- | Get a Ledger from the given string and options, or raise an error.
|
|
ledgerFromStringWithOpts :: [Opt] -> String -> IO Ledger
|
|
ledgerFromStringWithOpts opts s = do
|
|
tc <- getClockTime
|
|
j <- journalFromString s
|
|
return $ mkLedger opts "" tc s j
|
|
|
|
-- -- | Read a Ledger from the given file, or give an error.
|
|
-- readLedgerWithOpts :: [Opt] -> [String] -> FilePath -> IO Ledger
|
|
-- readLedgerWithOpts opts args f = do
|
|
-- t <- getCurrentLocalTime
|
|
-- readLedger f
|
|
|
|
-- -- | Convert a Journal to a canonicalised, cached and filtered Ledger
|
|
-- -- based on the command-line options/arguments and a reference time.
|
|
-- filterAndCacheLedgerWithOpts :: [Opt] -> [String] -> LocalTime -> String -> Journal -> Ledger
|
|
-- filterAndCacheLedgerWithOpts opts args = filterAndCacheLedger . optsToFilterSpec opts args
|
|
|
|
-- | Attempt to open a web browser on the given url, all platforms.
|
|
openBrowserOn :: String -> IO ExitCode
|
|
openBrowserOn u = trybrowsers browsers u
|
|
where
|
|
trybrowsers (b:bs) u = do
|
|
e <- system $ printf "%s %s" b u
|
|
case e of
|
|
ExitSuccess -> return ExitSuccess
|
|
ExitFailure _ -> trybrowsers bs u
|
|
trybrowsers [] u = do
|
|
putStrLn $ printf "Sorry, I could not start a browser (tried: %s)" $ intercalate ", " browsers
|
|
putStrLn $ printf "Please open your browser and visit %s" u
|
|
return $ ExitFailure 127
|
|
browsers | os=="darwin" = ["open"]
|
|
| os=="mingw32" = ["start","firefox","safari","opera","iexplore"]
|
|
| otherwise = ["sensible-browser","firefox"]
|
|
-- jeffz: write a ffi binding for it using the Win32 package as a basis
|
|
-- start by adding System/Win32/Shell.hsc and follow the style of any
|
|
-- other module in that directory for types, headers, error handling and
|
|
-- what not.
|
|
-- ::ShellExecute(NULL, "open", "www.somepage.com", NULL, NULL, SW_SHOWNORMAL);
|
|
-- ::ShellExecute(NULL, "open", "firefox.exe", "www.somepage.com" NULL, SW_SHOWNORMAL);
|
|
|