another parse test helper, use the IO variant always, port more tests

hledger-lib/Hledger/Read/JournalReader.hs

@@ -541,7 +541,7 @@ transactionp = do
   return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings ""
 
 -- old HUnit tests
-test_transactionp = TestCase $ do
+test_transactionp = 
   let s `gives` t = do
                       let p = runIdentity $ parseWithState mempty transactionp s
                       assertBool "Parse success" (isRight p)
@@ -556,6 +556,7 @@ test_transactionp = TestCase $ do
                       assertEqual "Equal tags" (ttags t) (ttags t2)
                       assertEqual "Equal preceding comments" (tpreceding_comment_lines t) (tpreceding_comment_lines t2)
                       assertEqual "Equal postings" (tpostings t) (tpostings t2)
+  in TestCase $ do
 
     T.unlines ["2015/1/1"] `gives` nulltransaction{ tdate=parsedate "2015/01/01" }
 
@@ -622,7 +623,7 @@ test_transactionp = TestCase $ do
     assertBool "transactionp parses parses comments anywhere" (isRight p)
     assertEqual "Has 2 postings" 2 (let Right t = p in length $ tpostings t)
 
--- new easytest tests, for comparison
+-- the above as easytests, just for comparison
 transactionp_tests = tests "transactionp" [
 
    test "just-a-date" $ expectParseEq transactionp "2015/1/1\n" nulltransaction{tdate=parsedate "2015/01/01"}
@@ -661,7 +662,7 @@ transactionp_tests = tests "transactionp" [
         ]
     }
 
-    ,it "parses a well-formed transaction" $
+  ,test "parses a well-formed transaction" $
     expect $ isRight $ rjp transactionp $ T.unlines
       ["2007/01/28 coopportunity"
       ,"    expenses:food:groceries                   $47.18"
@@ -669,27 +670,28 @@ transactionp_tests = tests "transactionp" [
       ,""
       ]
 
---    ,it "does not parse a following comment as part of the description"
+  ,test "does not parse a following comment as part of the description" $
---      let p = runIdentity $ parseWithState mempty transactionp "2009/1/1 a ;comment\n b 1\n"
+    expectParseEqOn transactionp "2009/1/1 a ;comment\n b 1\n" tdescription "a"
---      (Right "a") (tdescription <$> p)
 
---    assertBool "transactionp parses a following whitespace line" $
+  ,test "transactionp parses a following whitespace line" $
---      isRight . runIdentity . parseWithState mempty transactionp $ T.unlines
+    expect $ isRight $ rjp transactionp $ T.unlines
---        ["2012/1/1"
+      ["2012/1/1"
---        ,"  a  1"
+      ,"  a  1"
---        ,"  b"
+      ,"  b"
---        ," "
+      ," "
---        ]
+      ]
---
+
---    let p = runIdentity . parseWithState mempty transactionp $ T.unlines
+  ,test "comments everywhere, two postings parsed" $
---             ["2009/1/1 x  ; transaction comment"
+    expectParseEqOn transactionp 
---             ," a  1  ; posting 1 comment"
+      (T.unlines
---             ," ; posting 1 comment 2"
+        ["2009/1/1 x  ; transaction comment"
---             ," b"
+        ," a  1  ; posting 1 comment"
---             ," ; posting 2 comment"
+        ," ; posting 1 comment 2"
---             ]
+        ," b"
---    assertBool "transactionp parses parses comments anywhere" (isRight p)
+        ," ; posting 2 comment"
---    assertEqual "Has 2 postings" 2 (let Right t = p in length $ tpostings t)
+        ])
+      (length . tpostings)
+      2
 
   ]
 
@@ -870,18 +872,21 @@ tests_Hledger_Read_JournalReader = TestList [
   ]
 
 easytests = tests "JournalReader" [
+
    tests "transactionmodifierp" [
-    test "transactionmodifierp" $ expectParseEqIO transactionmodifierp 
+
+    test "basic" $ expectParseEq transactionmodifierp 
       "= (some value expr)\n some:postings  1.\n"
       nulltransactionmodifier {
         tmquerytxt = "(some value expr)"
        ,tmpostings = [nullposting{paccount="some:postings", pamount=Mixed[num 1]}]
       }
     ]
+
   ,tests "periodictransactionp" [
 
     -- tests from #807
-    test "more-period-text-in-comment-after-one-space" $ expectParseEqIO periodictransactionp
+    test "more-period-text-in-comment-after-one-space" $ expectParseEq periodictransactionp
       "~ monthly from 2018/6 ;In 2019 we will change this\n" 
       nullperiodictransaction {
          ptperiodexpr  = "monthly from 2018/6"
@@ -895,7 +900,7 @@ easytests = tests "JournalReader" [
         ,ptpostings    = []
         }
 
-    ,_test "more-period-text-in-description-after-two-spaces" $ expectParseEqIO periodictransactionp -- TODO 
+    ,_test "more-period-text-in-description-after-two-spaces" $ expectParseEq periodictransactionp -- TODO 
       "~ monthly from 2018/6   In 2019 we will change this\n" 
       nullperiodictransaction {
          ptperiodexpr  = "monthly from 2018/6"
@@ -904,7 +909,7 @@ easytests = tests "JournalReader" [
         ,ptdescription = "In 2019 we will change this\n"
         }
 
-    ,_test "more-period-text-in-description-after-one-space" $ expectParseEqIO periodictransactionp -- TODO
+    ,_test "more-period-text-in-description-after-one-space" $ expectParseEq periodictransactionp -- TODO
       "~ monthly from 2018/6 In 2019 we will change this\n" 
       nullperiodictransaction {
          ptperiodexpr  = "monthly from 2018/6"
@@ -913,7 +918,7 @@ easytests = tests "JournalReader" [
         ,ptdescription = "In 2019 we will change this\n"
         }
 
-    ,_test "Next-year-in-description" $ expectParseEqIO periodictransactionp -- TODO read error
+    ,_test "Next-year-in-description" $ expectParseEq periodictransactionp -- TODO read error
       "~ monthly  Next year blah blah\n"
       nullperiodictransaction {
          ptperiodexpr  = "monthly"
@@ -923,5 +928,6 @@ easytests = tests "JournalReader" [
         }
 
     ,transactionp_tests
+
     ]
   ]

hledger-lib/Hledger/Utils/Test.hs

@@ -13,7 +13,9 @@ module Hledger.Utils.Test (
   ,it
   ,_it
   ,expectParseEq
-  ,expectParseEqIO
+  ,expectParseEqOn
+--  ,expectParseEq
+--  ,expectParseEqOnIO
   -- * HUnit
   ,module Test.HUnit
   ,runHunitTests
@@ -47,7 +49,6 @@ import Test.HUnit hiding (Test, test)        -- reexported
 import qualified Test.HUnit as U             -- used here
 
 import Hledger.Utils.Debug (pshow)
-import Hledger.Utils.Parse (parseWithState)
 import Hledger.Utils.UTF8IOCompat (error')
 
 -- * easytest helpers
@@ -94,27 +95,47 @@ runEasyTests args easytests = (do
   )
   `catch` (\(_::ExitCode) -> return True)
 
--- | Given a stateful, runnable-in-Identity-monad parser, input text, and expected parse result,
+-- | Like easytest's expectEq, but pretty-prints the values in the failure output. 
--- make an easytest Test that parses the text and compares the result,
--- showing a nice failure message if either step fails.
-expectParseEq :: (Monoid st, Eq a, Show a) => StateT st (ParsecT CustomErr T.Text Identity) a -> T.Text -> a -> E.Test ()
-expectParseEq parser input expected = do
-  let ep = runIdentity $ parseWithState mempty parser input
-  either (fail.("parse error at "++).parseErrorPretty) (expectEq' expected) ep
-
--- | Given a stateful, runnable-in-IO-monad parser, input text, and expected parse result,
--- make an easytest Test that parses the text and compares the result,
--- showing a nice failure message if either step fails.
-expectParseEqIO :: (Monoid st, Eq a, Show a) => StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> E.Test ()
-expectParseEqIO parser input expected = do
-  ep <- E.io $ runParserT (evalStateT parser mempty) "" input
-  either (fail.("parse error at "++).parseErrorPretty) (expectEq' expected) ep
-
--- | Like easytest's expectEq, but pretty-prints the values in failure output. 
 expectEq' :: (Eq a, Show a, HasCallStack) => a -> a -> E.Test ()
 expectEq' x y = if x == y then E.ok else E.crash $
   "expected:\n" <> T.pack (pshow x) <> "\nbut got:\n" <> T.pack (pshow y) <> "\n"
 
+-- XXX unnecessary ?
+-- | Given a stateful, runnable-in-Identity-monad parser, input text, and 
+-- expected parse result, make a Test that parses the text and compares 
+-- the result, showing a nice failure message if either step fails.
+--expectParseEq :: (Monoid st, Eq a, Show a, HasCallStack) => 
+--  StateT st (ParsecT CustomErr T.Text Identity) a -> T.Text -> a -> E.Test ()
+--expectParseEq parser input expected = expectParseEqOn parser input id expected
+--
+-- | Like expectParseEq, but also takes a transform function 
+-- to call on the parse result before comparing it.
+--expectParseEqOn :: (Monoid st, Eq b, Show b, HasCallStack) => 
+--  StateT st (ParsecT CustomErr T.Text Identity) a -> T.Text -> (a -> b) -> b -> E.Test ()
+--expectParseEqOn parser input f expected = do
+--  let ep = runIdentity $ parseWithState mempty parser input
+--  either (fail.("parse error at "++).parseErrorPretty) (expectEq' expected . f) ep
+--
+expectParseEq :: (Monoid st, Eq a, Show a, HasCallStack) => 
+  StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> E.Test ()
+expectParseEq = expectParseEqIO
+
+expectParseEqOn :: (Monoid st, Eq b, Show b, HasCallStack) => 
+  StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> E.Test ()
+expectParseEqOn = expectParseEqOnIO
+
+-- | Like expectParseEq, but takes a parser runnable in the IO monad.
+expectParseEqIO :: (Monoid st, Eq a, Show a, HasCallStack) => 
+  StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> E.Test ()
+expectParseEqIO parser input expected = expectParseEqOnIO parser input id expected
+
+-- | Like expectParseEqOn, but takes a parser runnable in the IO monad.
+expectParseEqOnIO :: (Monoid st, Eq b, Show b, HasCallStack) => 
+  StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> E.Test ()
+expectParseEqOnIO parser input f expected = do
+  ep <- E.io $ runParserT (evalStateT parser mempty) "" input
+  either (fail.("parse error at "++).parseErrorPretty) (expectEq' expected . f) ep
+
 -- * HUnit helpers
 
 -- | Get a Test's label, or the empty string.