Add: --no-new-accounts: don't allow to create new accounts
This commit is contained in:
		
							parent
							
								
									8310eaa6ff
								
							
						
					
					
						commit
						b2e89a8c13
					
				| @ -15,19 +15,19 @@ import System.IO (stderr, hFlush) | |||||||
| import System.IO.Error | import System.IO.Error | ||||||
| import Text.ParserCombinators.Parsec | import Text.ParserCombinators.Parsec | ||||||
| import Utils (ledgerFromStringWithOpts) | import Utils (ledgerFromStringWithOpts) | ||||||
| 
 | import qualified Data.Foldable as Foldable (find) | ||||||
| 
 | 
 | ||||||
| -- | Read ledger transactions from the terminal, prompting for each field, | -- | Read ledger transactions from the terminal, prompting for each field, | ||||||
| -- and append them to the ledger file. If the ledger came from stdin, this | -- and append them to the ledger file. If the ledger came from stdin, this | ||||||
| -- command has no effect. | -- command has no effect. | ||||||
| add :: [Opt] -> [String] -> Ledger -> IO () | add :: [Opt] -> [String] -> Ledger -> IO () | ||||||
| add _ args l | add opts args l | ||||||
|     | filepath (journal l) == "-" = return () |     | filepath (journal l) == "-" = return () | ||||||
|     | otherwise = do |     | otherwise = do | ||||||
|   hPutStrLn stderr |   hPutStrLn stderr | ||||||
|     "Enter one or more transactions, which will be added to your ledger file.\n\ |     "Enter one or more transactions, which will be added to your ledger file.\n\ | ||||||
|     \To complete a transaction, enter . as account name. To quit, enter control-d." |     \To complete a transaction, enter . as account name. To quit, enter control-d." | ||||||
|   getAndAddTransactions l args `catch` (\e -> unless (isEOFError e) $ ioError e) |   getAndAddTransactions l opts args `catch` (\e -> unless (isEOFError e) $ ioError e) | ||||||
| 
 | 
 | ||||||
| -- | Read a number of ledger transactions from the command line, | -- | Read a number of ledger transactions from the command line, | ||||||
| -- prompting, validating, displaying and appending them to the ledger | -- prompting, validating, displaying and appending them to the ledger | ||||||
| @ -35,11 +35,11 @@ add _ args l | |||||||
| -- command-line arguments are used as the first transaction's description. | -- command-line arguments are used as the first transaction's description. | ||||||
| getAndAddTransactions :: Ledger -> [String] -> IO () | getAndAddTransactions :: Ledger -> [String] -> IO () | ||||||
| getAndAddTransactions l args = do | getAndAddTransactions l args = do | ||||||
|   l <- getTransaction l args >>= ledgerAddTransaction l |   l <- getTransaction l args >>= addTransaction l | ||||||
|   getAndAddTransactions l [] |   getAndAddTransactions l [] | ||||||
| 
 | 
 | ||||||
| -- | Read a transaction from the command line, with history-aware prompting. | -- | Read a transaction from the command line, with history-aware prompting. | ||||||
| getTransaction :: Ledger -> [String] -> IO Transaction | getTransaction :: Ledger -> [String] -> IO LedgerTransaction | ||||||
| getTransaction l args = do | getTransaction l args = do | ||||||
|   today <- getCurrentDay |   today <- getCurrentDay | ||||||
|   datestr <- askFor "date"  |   datestr <- askFor "date"  | ||||||
| @ -52,8 +52,13 @@ getTransaction l args = do | |||||||
|                 | otherwise = Just $ snd $ head historymatches |                 | otherwise = Just $ snd $ head historymatches | ||||||
|       bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch |       bestmatchpostings = maybe Nothing (Just . tpostings) bestmatch | ||||||
|       date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr |       date = fixSmartDate today $ fromparse $ (parse smartdate "" . lowercase) datestr | ||||||
|  |       accept x = x == "." || (not . null) x && | ||||||
|  |         if NoNewAccts `elem` opts | ||||||
|  |             then isJust $ Foldable.find (== x) ant | ||||||
|  |             else True | ||||||
|  |         where (ant,_,_,_) = groupTransactions . rawLedgerTransactions . rawledger $ l | ||||||
|       getpostingsandvalidate = do |       getpostingsandvalidate = do | ||||||
|         ps <- getPostings bestmatchpostings [] |         ps <- getPostings accept bestmatchpostings [] | ||||||
|         let t = nulltransaction{tdate=date |         let t = nulltransaction{tdate=date | ||||||
|                                ,tstatus=False |                                ,tstatus=False | ||||||
|                                ,tdescription=description |                                ,tdescription=description | ||||||
| @ -71,9 +76,9 @@ getTransaction l args = do | |||||||
| 
 | 
 | ||||||
| -- | Read postings from the command line until . is entered, using the | -- | Read postings from the command line until . is entered, using the | ||||||
| -- provided historical postings, if any, to guess defaults. | -- provided historical postings, if any, to guess defaults. | ||||||
| getPostings :: Maybe [Posting] -> [Posting] -> IO [Posting] | getPostings :: (AccountName -> Bool) -> Maybe [Posting] -> [Posting] -> IO [Posting] | ||||||
| getPostings historicalps enteredps = do | getPostings accept historicalps enteredps = do | ||||||
|   account <- askFor (printf "account %d" n) defaultaccount (Just $ not . null) |   account <- askFor (printf "account %d" n) defaultaccount (Just accept) | ||||||
|   if account=="." |   if account=="." | ||||||
|     then return enteredps |     then return enteredps | ||||||
|     else do |     else do | ||||||
| @ -82,7 +87,7 @@ getPostings historicalps enteredps = do | |||||||
|       let p = nullposting{paccount=stripbrackets account, |       let p = nullposting{paccount=stripbrackets account, | ||||||
|                           pamount=amount, |                           pamount=amount, | ||||||
|                           ptype=postingtype account} |                           ptype=postingtype account} | ||||||
|       getPostings historicalps $ enteredps ++ [p] |       getPostings accept historicalps $ enteredps ++ [p] | ||||||
|     where |     where | ||||||
|       n = length enteredps + 1 |       n = length enteredps + 1 | ||||||
|       enteredrealps = filter isReal enteredps |       enteredrealps = filter isReal enteredps | ||||||
|  | |||||||
| @ -64,6 +64,7 @@ usage = usageInfo usagehdr options ++ usageftr | |||||||
| options :: [OptDescr Opt] | options :: [OptDescr Opt] | ||||||
| options = [ | options = [ | ||||||
|   Option "f" ["file"]         (ReqArg File "FILE")   "use a different ledger/timelog file; - means stdin" |   Option "f" ["file"]         (ReqArg File "FILE")   "use a different ledger/timelog file; - means stdin" | ||||||
|  |  ,Option ""  ["no-new-accounts"] (NoArg NoNewAccts)   "don't allow to create new accounts" | ||||||
|  ,Option "b" ["begin"]        (ReqArg Begin "DATE")  "report on transactions on or after this date" |  ,Option "b" ["begin"]        (ReqArg Begin "DATE")  "report on transactions on or after this date" | ||||||
|  ,Option "e" ["end"]          (ReqArg End "DATE")    "report on transactions before this date" |  ,Option "e" ["end"]          (ReqArg End "DATE")    "report on transactions before this date" | ||||||
|  ,Option "p" ["period"]       (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++ |  ,Option "p" ["period"]       (ReqArg Period "EXPR") ("report on transactions during the specified period\n" ++ | ||||||
| @ -99,6 +100,7 @@ options = [ | |||||||
| -- | An option value from a command-line flag. | -- | An option value from a command-line flag. | ||||||
| data Opt =  | data Opt =  | ||||||
|     File    {value::String} |  |     File    {value::String} |  | ||||||
|  |     NoNewAccts | | ||||||
|     Begin   {value::String} |  |     Begin   {value::String} |  | ||||||
|     End     {value::String} |  |     End     {value::String} |  | ||||||
|     Period  {value::String} |  |     Period  {value::String} |  | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user