cleanup
This commit is contained in:
		
							parent
							
								
									5ef4d437e9
								
							
						
					
					
						commit
						0a3cc44a0f
					
				
							
								
								
									
										42
									
								
								hledger.hs
									
									
									
									
									
								
							
							
						
						
									
										42
									
								
								hledger.hs
									
									
									
									
									
								
							| @ -218,7 +218,7 @@ data Ledger = Ledger { | |||||||
|                       periodic_entries :: [PeriodicEntry], |                       periodic_entries :: [PeriodicEntry], | ||||||
|                       entries :: [Entry] |                       entries :: [Entry] | ||||||
|                      } deriving (Show, Eq) |                      } deriving (Show, Eq) | ||||||
| data ModifierEntry = ModifierEntry { | data ModifierEntry = ModifierEntry { -- aka automated entry | ||||||
|                     valueexpr :: String, |                     valueexpr :: String, | ||||||
|                     m_transactions :: [Transaction] |                     m_transactions :: [Transaction] | ||||||
|                    } deriving (Eq) |                    } deriving (Eq) | ||||||
| @ -295,7 +295,6 @@ ledgerdirective = char '!' >> restofline <?> "directive" | |||||||
| ledgertransactions = (ledgertransaction <?> "transaction") `manyTill` (newline <?> "blank line") | ledgertransactions = (ledgertransaction <?> "transaction") `manyTill` (newline <?> "blank line") | ||||||
|                      -- => unlike ledger, we need to end the file with a blank line |                      -- => unlike ledger, we need to end the file with a blank line | ||||||
| 
 | 
 | ||||||
| -- "automated entry" |  | ||||||
| ledgermodifierentry = do | ledgermodifierentry = do | ||||||
|   char '=' <?> "entry" |   char '=' <?> "entry" | ||||||
|   many spacenonewline |   many spacenonewline | ||||||
| @ -351,8 +350,8 @@ ledgereol = ledgercomment <|> do {newline; return []} | |||||||
| 
 | 
 | ||||||
| spacenonewline = satisfy (\c -> c `elem` " \v\f\t") | spacenonewline = satisfy (\c -> c `elem` " \v\f\t") | ||||||
| 
 | 
 | ||||||
| -- run tests | -- utils | ||||||
| 
 |        | ||||||
| test = do | test = do | ||||||
|   parseTest ledgertransaction sample_transaction |   parseTest ledgertransaction sample_transaction | ||||||
|   parseTest ledgertransaction sample_transaction2 |   parseTest ledgertransaction sample_transaction2 | ||||||
| @ -376,27 +375,23 @@ test = do | |||||||
| --   putStrLn "ok" | --   putStrLn "ok" | ||||||
| --     where assert_ e = assert e return ()              | --     where assert_ e = assert e return ()              | ||||||
| 
 | 
 | ||||||
| -- utils |  | ||||||
|        |  | ||||||
| printParseResult r = | printParseResult r = | ||||||
|     case r of |     case r of | ||||||
|       Left err -> do putStr "ledger parse error at "; print err |       Left err -> do putStr "ledger parse error at "; print err | ||||||
|       Right x  -> do print x |       Right x  -> do print x | ||||||
| 
 | 
 | ||||||
| parseMyLedgerFile = do |  | ||||||
|   fname <- ledgerFilePath |  | ||||||
|   parsed <- parseFromFile ledger fname |  | ||||||
|   return parsed |  | ||||||
|     where |  | ||||||
|       ledgerFilePath = do |  | ||||||
|                       filepath <- getEnv "LEDGER" `catch` \_ -> return "ledger.dat" |  | ||||||
|                       -- don't know how to accomplish this great feat |  | ||||||
|                       --ledger_file <- tildeExpand filepath |  | ||||||
|                       let ledger_file = filepath |  | ||||||
|                       return ledger_file |  | ||||||
| 
 |  | ||||||
| -- ok, what can we do with it ? | -- ok, what can we do with it ? | ||||||
| 
 | 
 | ||||||
|  | parseMyLedgerFile = do | ||||||
|  |   ledgerFile >>= parseFromFile ledger >>= return | ||||||
|  |     where  | ||||||
|  |       ledgerFile = do | ||||||
|  |         filepath <- getEnv "LEDGER" `catch` \_ -> return "ledger.dat" | ||||||
|  |         -- don't know how to accomplish this great feat | ||||||
|  |         --ledger_file <- tildeExpand filepath | ||||||
|  |         let ledger_file = filepath | ||||||
|  |         return ledger_file | ||||||
|  | 
 | ||||||
| showLedger l = "Ledger has\n" | showLedger l = "Ledger has\n" | ||||||
|                ++ (showModifierEntries $ modifier_entries l) |                ++ (showModifierEntries $ modifier_entries l) | ||||||
|                ++ (showPeriodicEntries $ periodic_entries l) |                ++ (showPeriodicEntries $ periodic_entries l) | ||||||
| @ -428,18 +423,17 @@ instance Show PeriodicEntry where | |||||||
| 
 | 
 | ||||||
| instance Show Entry where  | instance Show Entry where  | ||||||
|     show e = date e ++ " " ++ s ++ c ++ d ++ "\n" ++ unlines (map show (transactions e)) |     show e = date e ++ " " ++ s ++ c ++ d ++ "\n" ++ unlines (map show (transactions e)) | ||||||
|                     where  |         where  | ||||||
|                       d = description e |           d = description e | ||||||
|                       s = case (status e) of {True -> "* "; False -> ""} |           s = case (status e) of {True -> "* "; False -> ""} | ||||||
|                       c = case (length(code e) > 0) of {True -> (code e ++ " "); False -> ""} |           c = case (length(code e) > 0) of {True -> (code e ++ " "); False -> ""} | ||||||
| 
 | 
 | ||||||
| instance Show Transaction where  | instance Show Transaction where  | ||||||
|     show t = printf "    %-40s  %20.2s" (take 40 $ account t) (show $ amount t) |     show t = printf "    %-40s  %20.2s" (take 40 $ account t) (show $ amount t) | ||||||
| 
 | 
 | ||||||
| instance Show Amount where show a = (currency a) ++ (show $ quantity a) | instance Show Amount where show a = (currency a) ++ (show $ quantity a) | ||||||
| 
 | 
 | ||||||
| r = reg | r = register | ||||||
| reg = register |  | ||||||
| register = do  | register = do  | ||||||
|   p <- parseMyLedgerFile |   p <- parseMyLedgerFile | ||||||
|   case p of |   case p of | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user