refactor: move parse tests

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.
+-- | unit tests, augmenting the ones defined in each module. Where that is
--- The latter is probably the way forward.
+-- 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

hledger-lib/Ledger.hs

@@ -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

hledger-lib/Ledger/Parse.hs

@@ -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] ""
+
+