add command now creates the ledger file if missing

This commit is contained in:
Simon Michael 2009-05-16 20:45:05 +00:00
parent 6ad88274a5
commit d645e9f90b
2 changed files with 24 additions and 18 deletions

View File

@ -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

View File

@ -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