refactor: move parse tests
This commit is contained in:
		
							parent
							
								
									903bf23afd
								
							
						
					
					
						commit
						f92270dfa8
					
				
							
								
								
									
										58
									
								
								Tests.hs
									
									
									
									
									
								
							
							
						
						
									
										58
									
								
								Tests.hs
									
									
									
									
									
								
							| @ -55,8 +55,8 @@ runtests opts args = do | ||||
|       -- ts = tfilter matchname $ TestList tests -- show hierarchical test names | ||||
|       matchname = matchpats args . tname | ||||
| 
 | ||||
| -- | hledger's unit tests, defined here and also (new) in the respective modules. | ||||
| -- The latter is probably the way forward. | ||||
| -- | unit tests, augmenting the ones defined in each module. Where that is | ||||
| -- inconvenient due to import cycles or whatever, we define them here. | ||||
| tests :: Test | ||||
| tests = TestList [ | ||||
|    tests_Ledger, | ||||
| @ -413,28 +413,6 @@ tests = TestList [ | ||||
|     r <- journalFromString "" -- don't know how to get it from ledgerFile | ||||
|     assertBool "ledgerFile parsing an empty file should give an empty ledger" $ null $ jtxns r | ||||
| 
 | ||||
|   ,"ledgerHistoricalPrice" ~: | ||||
|     assertParseEqual (parseWithCtx emptyCtx ledgerHistoricalPrice price1_str) price1 | ||||
| 
 | ||||
|   ,"ledgerTransaction" ~: do | ||||
|     assertParseEqual (parseWithCtx emptyCtx ledgerTransaction entry1_str) entry1 | ||||
|     assertBool "ledgerTransaction should not parse just a date" | ||||
|                    $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1\n" | ||||
|     assertBool "ledgerTransaction should require some postings" | ||||
|                    $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a\n" | ||||
|     let t = parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a ;comment\n b 1\n" | ||||
|     assertBool "ledgerTransaction should not include a comment in the description" | ||||
|                    $ either (const False) ((== "a") . tdescription) t | ||||
| 
 | ||||
|   ,"ledgeraccountname" ~: do | ||||
|     assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c") | ||||
|     assertBool "ledgeraccountname rejects an empty inner component" (isLeft $ parsewith ledgeraccountname "a::c") | ||||
|     assertBool "ledgeraccountname rejects an empty leading component" (isLeft $ parsewith ledgeraccountname ":b:c") | ||||
|     assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:") | ||||
| 
 | ||||
|   ,"ledgerposting" ~: | ||||
|     assertParseEqual (parseWithCtx emptyCtx ledgerposting rawposting1_str) rawposting1 | ||||
| 
 | ||||
|   ,"normaliseMixedAmount" ~: do | ||||
|      normaliseMixedAmount (Mixed []) ~?= Mixed [nullamt] | ||||
| 
 | ||||
| @ -630,13 +608,6 @@ tests = TestList [ | ||||
| 
 | ||||
|   ,"show hours" ~: show (hours 1) ~?= "1.0h" | ||||
| 
 | ||||
|   ,"someamount" ~: do | ||||
|      let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity | ||||
|          assertMixedAmountParse parseresult mixedamount = | ||||
|              (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount) | ||||
|      assertMixedAmountParse (parsewith someamount "1 @ $2") | ||||
|                             (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])]) | ||||
| 
 | ||||
|   ,"unicode in balance layout" ~: do | ||||
|     l <- ledgerFromStringWithOpts [] | ||||
|       "2009/01/01 * медвежья шкура\n  расходы:покупки  100\n  актив:наличные\n" | ||||
| @ -726,11 +697,6 @@ tests = TestList [ | ||||
|   --     nullposting{lpdate=parsedate "2008/01/01",lpdescription="- 2008/12/31",lpaccount="",lpamount=Mixed [dollars 15]} | ||||
|   --    ] | ||||
| 
 | ||||
|   ,"postingamount" ~: do | ||||
|     assertParseEqual (parseWithCtx emptyCtx postingamount " $47.18") (Mixed [dollars 47.18]) | ||||
|     assertParseEqual (parseWithCtx emptyCtx postingamount " $1.") | ||||
|                 (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing]) | ||||
| 
 | ||||
|   ] | ||||
| 
 | ||||
|    | ||||
| @ -795,23 +761,6 @@ defaultyear_ledger_str = unlines | ||||
| 
 | ||||
| write_sample_ledger = writeFile "sample.ledger" sample_ledger_str | ||||
| 
 | ||||
| rawposting1_str  = "  expenses:food:dining  $10.00\n" | ||||
| 
 | ||||
| rawposting1 = Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting Nothing | ||||
| 
 | ||||
| entry1_str = unlines | ||||
|  ["2007/01/28 coopportunity" | ||||
|  ,"    expenses:food:groceries                   $47.18" | ||||
|  ,"    assets:checking                          $-47.18" | ||||
|  ,"" | ||||
|  ] | ||||
| 
 | ||||
| entry1 = | ||||
|     txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" | ||||
|      [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing,  | ||||
|       Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting Nothing] "" | ||||
| 
 | ||||
| 
 | ||||
| entry2_str = unlines | ||||
|  ["2007/01/27 * joes diner" | ||||
|  ,"    expenses:food:dining                      $10.00" | ||||
| @ -1145,9 +1094,6 @@ timelogentry1 = TimeLogEntry In (parsedatetime "2007/03/11 16:19:00") "hledger" | ||||
| timelogentry2_str  = "o 2007/03/11 16:30:00\n" | ||||
| timelogentry2 = TimeLogEntry Out (parsedatetime "2007/03/11 16:30:00") "" | ||||
| 
 | ||||
| price1_str = "P 2004/05/01 XYZ $55.00\n" | ||||
| price1 = HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55] | ||||
| 
 | ||||
| a1 = Mixed [(hours 1){price=Just $ Mixed [Amount (comm "$") 10 Nothing]}] | ||||
| a2 = Mixed [(hours 2){price=Just $ Mixed [Amount (comm "EUR") 10 Nothing]}] | ||||
| a3 = Mixed $ amounts a1 ++ amounts a2 | ||||
|  | ||||
| @ -49,7 +49,7 @@ tests_Ledger = TestList | ||||
|     -- ,Ledger.IO.tests_IO | ||||
|     ,Ledger.Transaction.tests_Transaction | ||||
|     -- ,Ledger.Ledger.tests_Ledger | ||||
|     -- ,Ledger.Parse.tests_Parse | ||||
|     ,Ledger.Parse.tests_Parse | ||||
|     -- ,Ledger.Journal.tests_Journal | ||||
|     -- ,Ledger.Posting.tests_Posting | ||||
|     -- ,Ledger.TimeLog.tests_TimeLog | ||||
|  | ||||
| @ -24,6 +24,7 @@ import Ledger.Amount | ||||
| import Ledger.Transaction | ||||
| import Ledger.Posting | ||||
| import Ledger.Journal | ||||
| import Ledger.Commodity (dollars,dollar,unknown) | ||||
| import System.FilePath(takeDirectory,combine) | ||||
| 
 | ||||
| 
 | ||||
| @ -585,3 +586,59 @@ datedisplayexpr = do | ||||
| 
 | ||||
| compareop = choice $ map (try . string) ["<=",">=","==","<","=",">"] | ||||
| 
 | ||||
| 
 | ||||
| tests_Parse = TestList [ | ||||
| 
 | ||||
|    "ledgerHistoricalPrice" ~: | ||||
|     assertParseEqual (parseWithCtx emptyCtx ledgerHistoricalPrice price1_str) price1 | ||||
| 
 | ||||
|   ,"ledgerTransaction" ~: do | ||||
|     assertParseEqual (parseWithCtx emptyCtx ledgerTransaction entry1_str) entry1 | ||||
|     assertBool "ledgerTransaction should not parse just a date" | ||||
|                    $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1\n" | ||||
|     assertBool "ledgerTransaction should require some postings" | ||||
|                    $ isLeft $ parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a\n" | ||||
|     let t = parseWithCtx emptyCtx ledgerTransaction "2009/1/1 a ;comment\n b 1\n" | ||||
|     assertBool "ledgerTransaction should not include a comment in the description" | ||||
|                    $ either (const False) ((== "a") . tdescription) t | ||||
| 
 | ||||
|   ,"ledgeraccountname" ~: do | ||||
|     assertBool "ledgeraccountname parses a normal accountname" (isRight $ parsewith ledgeraccountname "a:b:c") | ||||
|     assertBool "ledgeraccountname rejects an empty inner component" (isLeft $ parsewith ledgeraccountname "a::c") | ||||
|     assertBool "ledgeraccountname rejects an empty leading component" (isLeft $ parsewith ledgeraccountname ":b:c") | ||||
|     assertBool "ledgeraccountname rejects an empty trailing component" (isLeft $ parsewith ledgeraccountname "a:b:") | ||||
| 
 | ||||
|  ,"ledgerposting" ~: | ||||
|     assertParseEqual (parseWithCtx emptyCtx ledgerposting "  expenses:food:dining  $10.00\n")  | ||||
|                      (Posting False "expenses:food:dining" (Mixed [dollars 10]) "" RegularPosting Nothing) | ||||
| 
 | ||||
|   ,"someamount" ~: do | ||||
|      let -- | compare a parse result with a MixedAmount, showing the debug representation for clarity | ||||
|          assertMixedAmountParse parseresult mixedamount = | ||||
|              (either (const "parse error") showMixedAmountDebug parseresult) ~?= (showMixedAmountDebug mixedamount) | ||||
|      assertMixedAmountParse (parsewith someamount "1 @ $2") | ||||
|                             (Mixed [Amount unknown 1 (Just $ Mixed [Amount dollar{precision=0} 2 Nothing])]) | ||||
| 
 | ||||
|   ,"postingamount" ~: do | ||||
|     assertParseEqual (parseWithCtx emptyCtx postingamount " $47.18") (Mixed [dollars 47.18]) | ||||
|     assertParseEqual (parseWithCtx emptyCtx postingamount " $1.") | ||||
|                 (Mixed [Amount Commodity {symbol="$",side=L,spaced=False,comma=False,precision=0} 1 Nothing]) | ||||
| 
 | ||||
|  ] | ||||
| 
 | ||||
| price1_str = "P 2004/05/01 XYZ $55.00\n" | ||||
| price1 = HistoricalPrice (parsedate "2004/05/01") "XYZ" $ Mixed [dollars 55] | ||||
| 
 | ||||
| entry1_str = unlines | ||||
|  ["2007/01/28 coopportunity" | ||||
|  ,"    expenses:food:groceries                   $47.18" | ||||
|  ,"    assets:checking                          $-47.18" | ||||
|  ,"" | ||||
|  ] | ||||
| 
 | ||||
| entry1 = | ||||
|     txnTieKnot $ Transaction (parsedate "2007/01/28") Nothing False "" "coopportunity" "" | ||||
|      [Posting False "expenses:food:groceries" (Mixed [dollars 47.18]) "" RegularPosting Nothing,  | ||||
|       Posting False "assets:checking" (Mixed [dollars (-47.18)]) "" RegularPosting Nothing] "" | ||||
| 
 | ||||
| 
 | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user