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