lib: Fix compile errors in tests

hledger-lib/Hledger/Data/Journal.hs

@@ -881,7 +881,6 @@ journalDateSpan secondary j
       pdates   = concatMap (catMaybes . map (if secondary then (Just . postingDate2) else pdate) . tpostings) ts
       ts       = jtxns j
 
--- #ifdef TESTS
 test_journalDateSpan = do
  "journalDateSpan" ~: do
   assertEqual "" (DateSpan (Just $ fromGregorian 2014 1 10) (Just $ fromGregorian 2014 10 11))
@@ -894,7 +893,6 @@ test_journalDateSpan = do
                                             ,tpostings = [posting{pdate2=Just (parsedate "2014/10/10")}]
                                             }
                             ]}
--- #endif
 
 -- | Apply the pivot transformation to all postings in a journal,
 -- replacing their account name by their value for the given field or tag.

hledger-lib/Hledger/Read.hs

@@ -346,6 +346,7 @@ samplejournal = readJournal' $ T.unlines
 tests_Hledger_Read = TestList $
   tests_readJournal'
   ++ [
+   tests_Hledger_Read_Common,
    JournalReader.tests_Hledger_Read_JournalReader,
 --    LedgerReader.tests_Hledger_Read_LedgerReader,
    TimeclockReader.tests_Hledger_Read_TimeclockReader,

hledger-lib/Hledger/Read/Common.hs

@@ -89,7 +89,10 @@ module Hledger.Read.Common (
 
   -- ** misc
   singlespacedtextp,
-  singlespacep
+  singlespacep,
+
+  -- * tests
+  tests_Hledger_Read_Common
 )
 where
 --- * imports
@@ -114,6 +117,7 @@ import qualified Data.Text as T
 import Data.Time.Calendar
 import Data.Time.LocalTime
 import System.Time (getClockTime)
+import Test.HUnit
 import Text.Megaparsec
 import Text.Megaparsec.Char
 import Text.Megaparsec.Char.Lexer (decimal)
@@ -496,19 +500,21 @@ spaceandamountormissingp =
     lift $ skipSome spacenonewline
     Mixed . (:[]) <$> amountp
 
-#ifdef TESTS
+assertParseEqual' ::
-assertParseEqual' :: (Show a, Eq a) => (Either ParseError a) -> a -> Assertion
+     (Show a, Eq a)
-assertParseEqual' parse expected = either (assertFailure.show) (`is'` expected) parse
+  => Identity (Either (ParseError Char CustomErr) a)
+  -> a
+  -> Assertion
+assertParseEqual' parse expected = either (assertFailure.show) (`is'` expected) (runIdentity parse)
 
 is' :: (Eq a, Show a) => a -> a -> Assertion
-a `is'` e = assertEqual e a
+a `is'` e = assertEqual "values are equal" e a
 
-test_spaceandamountormissingp = do
+test_spaceandamountormissingp = TestCase $ do
     assertParseEqual' (parseWithState mempty spaceandamountormissingp " $47.18") (Mixed [usd 47.18])
     assertParseEqual' (parseWithState mempty spaceandamountormissingp "$47.18") missingmixedamt
     assertParseEqual' (parseWithState mempty spaceandamountormissingp " ") missingmixedamt
     assertParseEqual' (parseWithState mempty spaceandamountormissingp "") missingmixedamt
-#endif
 
 -- | Parse a single-commodity amount, with optional symbol on the left or
 -- right, optional unit or total price, and optional (ignored)
@@ -594,8 +600,7 @@ amountwithoutpricep = do
           Right res -> pure res
 
 
-#ifdef TESTS
+test_amountp = TestCase $ do
-test_amountp = do
     assertParseEqual' (parseWithState mempty amountp "$47.18") (usd 47.18)
     assertParseEqual' (parseWithState mempty amountp "$1.") (usd 1 `withPrecision` 0)
   -- ,"amount with unit price" ~: do
@@ -606,7 +611,6 @@ test_amountp = do
     assertParseEqual'
      (parseWithState mempty amountp "$10 @@ €5")
      (usd 10 `withPrecision` 0 @@ (eur 5 `withPrecision` 0))
-#endif
 
 -- | Parse an amount from a string, or get an error.
 amountp' :: String -> Amount
@@ -1256,3 +1260,5 @@ match' :: TextParser m a -> TextParser m (Text, a)
 match' p = do
   (!txt, p) <- match p
   pure (txt, p)
+
+tests_Hledger_Read_Common = TestList [test_spaceandamountormissingp, test_amountp]

hledger-lib/Hledger/Read/JournalReader.hs

@@ -76,6 +76,7 @@ import Control.Monad
 import Control.Monad.Except (ExceptT(..))
 import Control.Monad.State.Strict
 import Data.Bifunctor (first)
+import Data.Functor.Identity (Identity(..))
 import qualified Data.Map.Strict as M
 import Data.Text (Text)
 import Data.String
@@ -85,10 +86,6 @@ import Data.Time.Calendar
 import Data.Time.LocalTime
 import Safe
 import Test.HUnit
-#ifdef TESTS
-import Test.Framework
-import Text.Megaparsec.Error
-#endif
 import Text.Megaparsec hiding (parse)
 import Text.Megaparsec.Char
 import Text.Megaparsec.Custom
@@ -545,24 +542,23 @@ transactionp = do
   let sourcepos = journalSourcePos startpos endpos
   return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings ""
 
-#ifdef TESTS
+test_transactionp = TestCase $ do
-test_transactionp = do
     let s `gives` t = do
-                        let p = parseWithState mempty transactionp s
+                        let p = runIdentity $ parseWithState mempty transactionp s
-                        assertBool $ isRight p
+                        assertBool "Parse success" (isRight p)
                         let Right t2 = p
                             -- same f = assertEqual (f t) (f t2)
-                        assertEqual (tdate t) (tdate t2)
+                        assertEqual "Equal date" (tdate t) (tdate t2)
-                        assertEqual (tdate2 t) (tdate2 t2)
+                        assertEqual "Equal date2" (tdate2 t) (tdate2 t2)
-                        assertEqual (tstatus t) (tstatus t2)
+                        assertEqual "Equal status" (tstatus t) (tstatus t2)
-                        assertEqual (tcode t) (tcode t2)
+                        assertEqual "Equal code" (tcode t) (tcode t2)
-                        assertEqual (tdescription t) (tdescription t2)
+                        assertEqual "Equal description" (tdescription t) (tdescription t2)
-                        assertEqual (tcomment t) (tcomment t2)
+                        assertEqual "Equal comment" (tcomment t) (tcomment t2)
-                        assertEqual (ttags t) (ttags t2)
+                        assertEqual "Equal tags" (ttags t) (ttags t2)
-                        assertEqual (tpreceding_comment_lines t) (tpreceding_comment_lines t2)
+                        assertEqual "Equal preceding comments" (tpreceding_comment_lines t) (tpreceding_comment_lines t2)
-                        assertEqual (show $ tpostings t) (show $ tpostings t2)
+                        assertEqual "Equal postings" (show $ tpostings t) (show $ tpostings t2)
     -- "0000/01/01\n\n" `gives` nulltransaction
-    unlines [
+    T.unlines [
       "2012/05/14=2012/05/15 (code) desc  ; tcomment1",
       "    ; tcomment2",
       "    ; ttag1: val1",
@@ -593,50 +589,45 @@ test_transactionp = do
         ],
       tpreceding_comment_lines=""
       }
-    unlines [
+    T.unlines ["2015/1/1"]
-      "2015/1/1",
-      ]
      `gives`
-     nulltransaction{
+     nulltransaction{ tdate=parsedate "2015/01/01" }
-      tdate=parsedate "2015/01/01",
-      }
 
-    assertRight $ parseWithState mempty transactionp $ unlines
+    assertBool "transactionp parses a well-formed transactionParse OK" $
+      isRight . runIdentity . parseWithState mempty transactionp $ T.unlines
       ["2007/01/28 coopportunity"
       ,"    expenses:food:groceries                   $47.18"
       ,"    assets:checking                          $-47.18"
       ,""
       ]
 
-    -- transactionp should not parse just a date
+    assertBool "transactionp should not parse just a date" $
-    assertLeft $ parseWithState mempty transactionp "2009/1/1\n"
+      isLeft . runIdentity $ parseWithState mempty transactionp "2009/1/1\n"
 
-    -- transactionp should not parse just a date and description
+    assertBool "transactionp should not parse just a date and description" $
-    assertLeft $ parseWithState mempty transactionp "2009/1/1 a\n"
+      isLeft . runIdentity $ parseWithState mempty transactionp "2009/1/1 a\n"
 
-    -- transactionp should 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"
-    let p = parseWithState mempty transactionp "2009/1/1 a ;comment\n b 1\n"
+    assertEqual "transactionp should not parse a following comment as part of the description"
-    assertRight p
+      (Right "a") (tdescription <$> p)
-    assertEqual "a" (let Right p' = p in tdescription p')
 
-    -- parse transaction with following whitespace line
+    assertBool "transactionp parses a following whitespace line" $
-    assertRight $ parseWithState mempty transactionp $ unlines
+      isRight . runIdentity . parseWithState mempty transactionp $ T.unlines
         ["2012/1/1"
         ,"  a  1"
         ,"  b"
         ," "
         ]
 
-    let p = parseWithState mempty transactionp $ unlines
+    let p = runIdentity . parseWithState mempty transactionp $ T.unlines
              ["2009/1/1 x  ; transaction comment"
              ," a  1  ; posting 1 comment"
              ," ; posting 1 comment 2"
              ," b"
              ," ; posting 2 comment"
              ]
-    assertRight p
+    assertBool "transactionp parses parses comments anywhere" (isRight p)
-    assertEqual 2 (let Right t = p in length $ tpostings t)
+    assertEqual "Has 2 postings" 2 (let Right t = p in length $ tpostings t)
-#endif
 
 --- ** postings
 
@@ -680,14 +671,12 @@ postingp mTransactionYear = do
    , pbalanceassertion=massertion
    }
 
-#ifdef TESTS
+test_postingp = TestCase $ do
-test_postingp = do
     let s `gives` ep = do
-                         let parse = parseWithState mempty (postingp Nothing) s
+                         let parse = runIdentity $ parseWithState mempty (postingp Nothing) s
-                         assertBool -- "postingp parser"
+                         assertBool "Example is parsed well" $ isRight parse
-                           $ isRight parse
                          let Right ap = parse
-                             same f = assertEqual (f ep) (f ap)
+                             same f = assertEqual "Posting is parsed well" (f ep) (f ap)
                          same pdate
                          same pstatus
                          same paccount
@@ -714,30 +703,28 @@ test_postingp = do
                         ,ptags=[("a","a"), ("date","2012/11/28"), ("date2","2012/11/29"), ("b","b")]
                         ,pdate=parsedateM "2012/11/28"}
 
-    assertBool -- "postingp parses a quoted commodity with numbers"
+    assertBool "postingp parses a quoted commodity with numbers"
-      (isRight $ parseWithState mempty (postingp Nothing) "  a  1 \"DE123\"\n")
+      (isRight . runIdentity $ parseWithState mempty (postingp Nothing) "  a  1 \"DE123\"\n")
 
-  -- ,"postingp parses balance assertions and fixed lot prices" ~: do
+    assertBool "postingp parses balance assertions and fixed lot prices"
-    assertBool (isRight $ parseWithState mempty (postingp Nothing) "  a  1 \"DE123\" =$1 { =2.2 EUR} \n")
+      (isRight . runIdentity $ parseWithState mempty (postingp Nothing) "  a  1 \"DE123\" =$1 { =2.2 EUR} \n")
 
     -- let parse = parseWithState mempty postingp " a\n ;next-line comment\n"
     -- assertRight parse
     -- let Right p = parse
     -- assertEqual "next-line comment\n" (pcomment p)
     -- assertEqual (Just nullmixedamt) (pbalanceassertion p)
-#endif
 
 --- * more tests
 
-tests_Hledger_Read_JournalReader = TestList $ concat [
+tests_Hledger_Read_JournalReader = TestList [
-    -- test_numberp
+    test_transactionp,
-    [
+    test_postingp,
     "showParsedMarketPrice" ~: do
       let mp = parseWithState mempty marketpricedirectivep "P 2017/01/30 BTC $922.83\n"
           mpString = (fmap . fmap) showMarketPrice mp
       mpString `is` (Just (Right "P 2017/01/30 BTC $922.83"))
     ]
- ]
 
 {- old hunit tests
 

hledger-lib/Hledger/Read/LedgerReader.hs.disabled

@@ -21,10 +21,6 @@ import Data.Text (Text, pack)
 import Data.Text.Encoding (encodeUtf8)
 -- import Safe
 import Test.HUnit
--- #ifdef TESTS
--- import Test.Framework
--- import Text.Megaparsec.Error
--- #endif
 import Text.Megaparsec (eof)
 -- import Text.Printf
 import System.Time