cleanup
This commit is contained in:
		
							parent
							
								
									e5cf68bf0f
								
							
						
					
					
						commit
						30fe7ac225
					
				| @ -1,4 +1,6 @@ | |||||||
| module Options where | 
 | ||||||
|  | module Options | ||||||
|  | where | ||||||
|      |      | ||||||
| import System.Console.GetOpt | import System.Console.GetOpt | ||||||
| import Data.Maybe ( fromMaybe ) | import Data.Maybe ( fromMaybe ) | ||||||
|  | |||||||
							
								
								
									
										20
									
								
								Parse.hs
									
									
									
									
									
								
							
							
						
						
									
										20
									
								
								Parse.hs
									
									
									
									
									
								
							| @ -1,3 +1,13 @@ | |||||||
|  | 
 | ||||||
|  | module Parse | ||||||
|  | where | ||||||
|  | 
 | ||||||
|  | import Text.ParserCombinators.Parsec | ||||||
|  | import Text.ParserCombinators.Parsec.Language | ||||||
|  | import qualified Text.ParserCombinators.Parsec.Token as P | ||||||
|  | 
 | ||||||
|  | import Types | ||||||
|  | 
 | ||||||
| {- | {- | ||||||
| Here's the ledger 2.5 grammar: | Here's the ledger 2.5 grammar: | ||||||
| "The ledger file format is quite simple, but also very flexible. It supports | "The ledger file format is quite simple, but also very flexible. It supports | ||||||
| @ -98,14 +108,6 @@ i, o, b, h | |||||||
| -- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs | -- parsec example: http://pandoc.googlecode.com/svn/trunk/src/Text/Pandoc/Readers/RST.hs | ||||||
| -- sample data in Tests.hs  | -- sample data in Tests.hs  | ||||||
| 
 | 
 | ||||||
| module Parse where |  | ||||||
| 
 |  | ||||||
| import Text.ParserCombinators.Parsec |  | ||||||
| import Text.ParserCombinators.Parsec.Language |  | ||||||
| import qualified Text.ParserCombinators.Parsec.Token as P |  | ||||||
| 
 |  | ||||||
| import Types |  | ||||||
| 
 |  | ||||||
| -- set up token parsing, though we're not yet using these much | -- set up token parsing, though we're not yet using these much | ||||||
| ledgerLanguageDef = LanguageDef { | ledgerLanguageDef = LanguageDef { | ||||||
|    commentStart   = "" |    commentStart   = "" | ||||||
| @ -241,5 +243,3 @@ printParseResult r = case r of | |||||||
| 
 | 
 | ||||||
| parseError e = do putStr "ledger parse error at "; print e | parseError e = do putStr "ledger parse error at "; print e | ||||||
| 
 | 
 | ||||||
| parseLedgerFile :: IO String -> IO (Either ParseError Ledger) |  | ||||||
| parseLedgerFile f = f >>= parseFromFile ledger |  | ||||||
|  | |||||||
							
								
								
									
										12
									
								
								TODO
									
									
									
									
									
								
							
							
						
						
									
										12
									
								
								TODO
									
									
									
									
									
								
							| @ -1,11 +1,6 @@ | |||||||
| testing |  | ||||||
|  get quickcheck working |  | ||||||
|  consider hunit dsl |  | ||||||
|  ledger regression/compatibility tests |  | ||||||
| 
 |  | ||||||
| features | features | ||||||
|  balance |  balance | ||||||
|   show final balance |   show top-level acct balance | ||||||
|   show per-account balances |   show per-account balances | ||||||
|  print |  print | ||||||
|  matching by account/description regexp |  matching by account/description regexp | ||||||
| @ -18,6 +13,11 @@ features | |||||||
|  auto entry generation |  auto entry generation | ||||||
|  read gnucash files |  read gnucash files | ||||||
| 
 | 
 | ||||||
|  | testing | ||||||
|  |  get quickcheck working | ||||||
|  |  consider hunit dsl | ||||||
|  |  ledger regression/compatibility tests | ||||||
|  | 
 | ||||||
| environment | environment | ||||||
|  cleaner option processing |  cleaner option processing | ||||||
|  smart ledger file finding |  smart ledger file finding | ||||||
|  | |||||||
							
								
								
									
										16
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										16
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -1,8 +1,10 @@ | |||||||
| module Tests where |  | ||||||
| 
 | 
 | ||||||
| import Text.ParserCombinators.Parsec | module Tests | ||||||
| import Test.QuickCheck | where | ||||||
|  | 
 | ||||||
| import Test.HUnit | import Test.HUnit | ||||||
|  | import Test.QuickCheck | ||||||
|  | import Text.ParserCombinators.Parsec | ||||||
| 
 | 
 | ||||||
| import Options | import Options | ||||||
| import Types | import Types | ||||||
| @ -262,11 +264,3 @@ prop1 = 1 == 1 | |||||||
| --     (parse' ledgertransaction sample_transaction)) | --     (parse' ledgertransaction sample_transaction)) | ||||||
| -- how ? | -- how ? | ||||||
| 
 | 
 | ||||||
| -- commands |  | ||||||
| 
 |  | ||||||
| test :: IO ()       |  | ||||||
| test = do |  | ||||||
|   runTestTT hunittests |  | ||||||
| --  runTestTT hunittests2 |  | ||||||
| --  quickCheck prop1 |  | ||||||
|   return () |  | ||||||
|  | |||||||
							
								
								
									
										14
									
								
								Types.hs
									
									
									
									
									
								
							
							
						
						
									
										14
									
								
								Types.hs
									
									
									
									
									
								
							| @ -1,5 +1,6 @@ | |||||||
| -- a data model | 
 | ||||||
| module Types where | module Types  -- data model & methods | ||||||
|  | where | ||||||
| 
 | 
 | ||||||
| import Text.Printf | import Text.Printf | ||||||
| import List | import List | ||||||
| @ -130,9 +131,6 @@ showRegisterEntries (e:es) b = | |||||||
|     showEntryWithBalances e b ++ (showRegisterEntries es b') |     showEntryWithBalances e b ++ (showRegisterEntries es b') | ||||||
|         where b' = b + (sumTransactions (transactions e)) |         where b' = b + (sumTransactions (transactions e)) | ||||||
| 
 | 
 | ||||||
| printRegister :: Ledger -> IO () |  | ||||||
| printRegister l = putStr $ showRegisterEntries (entries l) 0 |  | ||||||
| 
 |  | ||||||
| -- misc | -- misc | ||||||
| 
 | 
 | ||||||
| -- fill in missing amounts etc., as far as possible | -- fill in missing amounts etc., as far as possible | ||||||
| @ -156,12 +154,12 @@ normalAndAutoTransactions ts = | |||||||
| sumTransactions :: [Transaction] -> Amount | sumTransactions :: [Transaction] -> Amount | ||||||
| sumTransactions ts = sum [amount t | t <- ts] | sumTransactions ts = sum [amount t | t <- ts] | ||||||
| 
 | 
 | ||||||
| 
 |  | ||||||
| transactionsFrom :: [Entry] -> [Transaction] | transactionsFrom :: [Entry] -> [Transaction] | ||||||
| transactionsFrom es = concat $ map transactions es | transactionsFrom es = concat $ map transactions es | ||||||
| 
 | 
 | ||||||
| accountsFrom :: [Transaction] -> [Account] | accountsFrom :: [Transaction] -> [Account] | ||||||
| accountsFrom ts = nub $ map account ts | accountsFrom ts = nub $ map account ts | ||||||
| 
 | 
 | ||||||
| accountList :: Ledger -> [Account] | accountsUsed :: Ledger -> [Account] | ||||||
| accountList l = accountsFrom $ transactionsFrom $ entries l | accountsUsed l = accountsFrom $ transactionsFrom $ entries l | ||||||
|  | 
 | ||||||
|  | |||||||
							
								
								
									
										33
									
								
								hledger.hs
									
									
									
									
									
								
							
							
						
						
									
										33
									
								
								hledger.hs
									
									
									
									
									
								
							| @ -1,10 +1,14 @@ | |||||||
| #!/usr/bin/runhaskell | #!/usr/bin/runhaskell | ||||||
| -- hledger - ledger-compatible money management utilities (& haskell workout) | -- hledger - ledger-compatible money management utilities (& haskell study) | ||||||
| -- GPLv3, (c) Simon Michael & contributors,  | -- GPLv3, (c) Simon Michael & contributors,  | ||||||
| -- John Wiegley's ledger is at http://newartisans.com/ledger.html . | -- John Wiegley's ledger is at http://newartisans.com/ledger.html . | ||||||
| 
 | 
 | ||||||
|  | module Main where | ||||||
|  | 
 | ||||||
| import System (getArgs) | import System (getArgs) | ||||||
| import Data.List (isPrefixOf) | import Data.List (isPrefixOf) | ||||||
|  | import Test.HUnit (runTestTT) | ||||||
|  | import Text.ParserCombinators.Parsec (parseFromFile, ParseError) | ||||||
| 
 | 
 | ||||||
| import Options | import Options | ||||||
| import Types | import Types | ||||||
| @ -25,17 +29,32 @@ main = do | |||||||
| 
 | 
 | ||||||
| -- commands | -- commands | ||||||
| 
 | 
 | ||||||
|  | test :: IO ()       | ||||||
|  | test = do | ||||||
|  |   runTestTT hunittests | ||||||
|  | --  quickCheck prop1 | ||||||
|  |   return () | ||||||
|  | 
 | ||||||
| register :: [String] -> IO () | register :: [String] -> IO () | ||||||
| register args = do  | register args = do  | ||||||
|   p <- parseLedgerFile ledgerFilePath |   p <- parseLedgerFile ledgerFilePath | ||||||
|   case p of |   case p of Left e -> parseError e | ||||||
|     Left e -> do putStr "ledger parse error at "; print e |             Right l -> printRegister l | ||||||
|     Right l  -> printRegister l |  | ||||||
| 
 | 
 | ||||||
| balance :: [String] -> IO () | balance :: [String] -> IO () | ||||||
| balance args = do  | balance args = do  | ||||||
|   p <- parseLedgerFile ledgerFilePath |   p <- parseLedgerFile ledgerFilePath | ||||||
|   case p of |   case p of Left e -> parseError e | ||||||
|     Left e -> do putStr "ledger parse error at "; print e |             Right l -> printBalances l | ||||||
|     Right l  -> printRegister l | 
 | ||||||
|  | -- utils | ||||||
|  | 
 | ||||||
|  | parseLedgerFile :: IO String -> IO (Either ParseError Ledger) | ||||||
|  | parseLedgerFile f = f >>= parseFromFile ledger | ||||||
|  | 
 | ||||||
|  | printRegister :: Ledger -> IO () | ||||||
|  | printRegister l = putStr $ showRegisterEntries (entries l) 0 | ||||||
|  | 
 | ||||||
|  | printBalances :: Ledger -> IO () | ||||||
|  | printBalances l = putStr $ showRegisterEntries (entries l) 0 | ||||||
| 
 | 
 | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user