add command now creates the ledger file if missing
This commit is contained in:
parent
6ad88274a5
commit
d645e9f90b
26
Utils.hs
26
Utils.hs
@ -11,23 +11,29 @@ import Control.Monad.Error
|
|||||||
import Data.Time.Clock
|
import Data.Time.Clock
|
||||||
import Ledger
|
import Ledger
|
||||||
import Options (Opt,ledgerFilePathFromOpts,optsToIOArgs)
|
import Options (Opt,ledgerFilePathFromOpts,optsToIOArgs)
|
||||||
|
import System.Directory (doesFileExist)
|
||||||
import System.IO
|
import System.IO
|
||||||
import Text.ParserCombinators.Parsec
|
import Text.ParserCombinators.Parsec
|
||||||
import qualified Data.Map as Map (lookup)
|
import qualified Data.Map as Map (lookup)
|
||||||
|
|
||||||
|
|
||||||
-- | parse the user's specified ledger file and run a hledger command on it,
|
-- | Parse the user's specified ledger file and run a hledger command on
|
||||||
-- or report a parse error. This function makes the whole thing go.
|
-- it, or report a parse error. This function makes the whole thing go.
|
||||||
withLedgerDo :: [Opt] -> [String] -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO ()
|
withLedgerDo :: [Opt] -> [String] -> String -> ([Opt] -> [String] -> Ledger -> IO ()) -> IO ()
|
||||||
withLedgerDo opts args cmd = do
|
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
|
f <- ledgerFilePathFromOpts opts
|
||||||
-- kludgily read the file a second time to get the full text. Only the ui command needs it.
|
let f' = if f == "-" then "/dev/null" else f
|
||||||
-- kludgily try not to fail if it's stdin.
|
fileexists <- doesFileExist f
|
||||||
-- read it strictly to let the add command work
|
let creating = not fileexists && cmdname == "add"
|
||||||
rawtext <- strictReadFile $ if f == "-" then "/dev/null" else f
|
rawtext <- if creating then return "" else strictReadFile f'
|
||||||
t <- getCurrentLocalTime
|
t <- getCurrentLocalTime
|
||||||
let runcmd = cmd opts args . filterAndCacheLedgerWithOpts opts args t rawtext . (\rl -> rl{filepath=f})
|
let go = cmd opts args . filterAndCacheLedgerWithOpts opts args t rawtext . (\rl -> rl{filepath=f})
|
||||||
return f >>= runErrorT . parseLedgerFile t >>= either (hPutStrLn stderr) runcmd
|
case creating of
|
||||||
|
True -> return rawLedgerEmpty >>= go
|
||||||
|
False -> return f >>= runErrorT . parseLedgerFile t >>= either (hPutStrLn stderr) go
|
||||||
|
|
||||||
-- | Get a Ledger from the given string and options, or raise an error.
|
-- | Get a Ledger from the given string and options, or raise an error.
|
||||||
ledgerFromStringWithOpts :: [Opt] -> [String] -> LocalTime -> String -> IO Ledger
|
ledgerFromStringWithOpts :: [Opt] -> [String] -> LocalTime -> String -> IO Ledger
|
||||||
|
|||||||
16
hledger.hs
16
hledger.hs
@ -84,17 +84,17 @@ main = do
|
|||||||
run cmd opts args
|
run cmd opts args
|
||||||
| Help `elem` opts = putStr $ usage
|
| Help `elem` opts = putStr $ usage
|
||||||
| Version `elem` opts = putStr versionmsg
|
| Version `elem` opts = putStr versionmsg
|
||||||
| cmd `isPrefixOf` "balance" = withLedgerDo opts args balance
|
| cmd `isPrefixOf` "balance" = withLedgerDo opts args cmd balance
|
||||||
| cmd `isPrefixOf` "convert" = withLedgerDo opts args convert
|
| cmd `isPrefixOf` "convert" = withLedgerDo opts args cmd convert
|
||||||
| cmd `isPrefixOf` "print" = withLedgerDo opts args print'
|
| cmd `isPrefixOf` "print" = withLedgerDo opts args cmd print'
|
||||||
| cmd `isPrefixOf` "register" = withLedgerDo opts args register
|
| cmd `isPrefixOf` "register" = withLedgerDo opts args cmd register
|
||||||
| cmd `isPrefixOf` "histogram" = withLedgerDo opts args histogram
|
| cmd `isPrefixOf` "histogram" = withLedgerDo opts args cmd histogram
|
||||||
| cmd `isPrefixOf` "add" = withLedgerDo opts args add
|
| cmd `isPrefixOf` "add" = withLedgerDo opts args cmd add
|
||||||
#ifdef VTY
|
#ifdef VTY
|
||||||
| cmd `isPrefixOf` "ui" = withLedgerDo opts args ui
|
| cmd `isPrefixOf` "ui" = withLedgerDo opts args cmd ui
|
||||||
#endif
|
#endif
|
||||||
#ifdef HAPPS
|
#ifdef HAPPS
|
||||||
| cmd `isPrefixOf` "web" = withLedgerDo opts args web
|
| cmd `isPrefixOf` "web" = withLedgerDo opts args cmd web
|
||||||
#endif
|
#endif
|
||||||
| cmd `isPrefixOf` "test" = runtests opts args >> return ()
|
| cmd `isPrefixOf` "test" = runtests opts args >> return ()
|
||||||
| otherwise = putStr $ usage
|
| otherwise = putStr $ usage
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user