lib: restore some old unit tests

Also change nullsourcepos, tests prefer JournalSourcePos for some reason.

hledger-lib/Hledger/Data/Transaction.hs

@@ -83,7 +83,7 @@ showGenericSourcePos = \case
     JournalSourcePos fp (line, line') -> show fp ++ " (lines " ++ show line ++ "-" ++ show line' ++ ")"
 
 nullsourcepos :: GenericSourcePos
-nullsourcepos = GenericSourcePos "" 1 1
+nullsourcepos = JournalSourcePos "" (1,1)
 
 nulltransaction :: Transaction
 nulltransaction = Transaction {

hledger-lib/Hledger/Data/Types.hs

@@ -268,6 +268,11 @@ data TransactionModifier = TransactionModifier {
 instance NFData TransactionModifier
 
 -- ^ A periodic transaction rule, describing a transaction that recurs.
+nulltransactionmodifier = TransactionModifier{
+  tmquerytxt = ""
+ ,tmpostings = []
+}
+
 data PeriodicTransaction = PeriodicTransaction {
       ptperiodexpr   :: Text,     -- ^ the period expression as written
       ptinterval     :: Interval, -- ^ the interval at which this transaction recurs 

hledger-lib/Hledger/Read/Common.hs

@@ -691,6 +691,28 @@ numberp suggestedStyle = label "number" $ do
       Left errMsg -> fail errMsg
       Right (q, p, d, g) -> pure (sign q, p, d, g)
 
+test_numberp = TestCase $ do
+  let t `is` n = assertParseEqual (rtp (numberp Nothing) t) n
+  let assertFails = assertBool "numberp" . isLeft . rtp (numberp Nothing)
+  assertFails ""
+  "0"          `is` (0, 0, Nothing, Nothing)
+  "1"          `is` (1, 0, Nothing, Nothing)
+  "1.1"        `is` (1.1, 1, Just '.', Nothing)
+  "1,000.1"    `is` (1000.1, 1, Just '.', Just $ DigitGroups ',' [3])
+  "1.00.000,1" `is` (100000.1, 1, Just ',', Just $ DigitGroups '.' [3,2])
+  "1,000,000"  `is` (1000000, 0, Nothing, Just $ DigitGroups ',' [3,3])  -- could be simplified to [3]
+  "1."         `is` (1, 0, Just '.', Nothing)
+  "1,"         `is` (1, 0, Just ',', Nothing)
+  ".1"         `is` (0.1, 1, Just '.', Nothing)
+  ",1"         `is` (0.1, 1, Just ',', Nothing)
+  assertFails "1,000.000,1"
+  assertFails "1.000,000.1"
+  assertFails "1,000.000.1"
+  assertFails "1,,1"
+  assertFails "1..1"
+  assertFails ".1,"
+  assertFails ",1."
+
 exponentp :: TextParser m Int
 exponentp = char' 'e' *> signp <*> decimal <?> "exponent"
 
@@ -879,7 +901,6 @@ digitgroupp = label "digits"
     makeGroup = uncurry DigitGrp . foldl' step (0, 0) . T.unpack
     step (!l, !a) c = (l+1, a*10 + fromIntegral (digitToInt c))
 
-
 data RawNumber
   = NoSeparators   DigitGrp (Maybe (Char, DigitGrp))        -- 100 or 100. or .100 or 100.50
   | WithSeparators Char [DigitGrp] (Maybe (Char, DigitGrp)) -- 1,000,000 or 1,000.50
@@ -888,28 +909,6 @@ data RawNumber
 data AmbiguousNumber = AmbiguousNumber DigitGrp Char DigitGrp  -- 1,000
   deriving (Show, Eq)
 
--- test_numberp = do
---       let s `is` n = assertParseEqual (parseWithState mempty numberp s) n
---           assertFails = assertBool . isLeft . parseWithState mempty numberp
---       assertFails ""
---       "0"          `is` (0, 0, '.', ',', [])
---       "1"          `is` (1, 0, '.', ',', [])
---       "1.1"        `is` (1.1, 1, '.', ',', [])
---       "1,000.1"    `is` (1000.1, 1, '.', ',', [3])
---       "1.00.000,1" `is` (100000.1, 1, ',', '.', [3,2])
---       "1,000,000"  `is` (1000000, 0, '.', ',', [3,3])
---       "1."         `is` (1,   0, '.', ',', [])
---       "1,"         `is` (1,   0, ',', '.', [])
---       ".1"         `is` (0.1, 1, '.', ',', [])
---       ",1"         `is` (0.1, 1, ',', '.', [])
---       assertFails "1,000.000,1"
---       assertFails "1.000,000.1"
---       assertFails "1,000.000.1"
---       assertFails "1,,1"
---       assertFails "1..1"
---       assertFails ".1,"
---       assertFails ",1."
-
 --- ** comments
 
 multilinecommentp :: TextParser m ()
@@ -1229,7 +1228,8 @@ match' p = do
   pure (txt, p)
 
 tests_Hledger_Read_Common = TestList [
-  test_spaceandamountormissingp
+   test_numberp
+  ,test_spaceandamountormissingp
   ]
 
 easytests = tests "Common" [

hledger-lib/Hledger/Read/JournalReader.hs

@@ -540,6 +540,7 @@ transactionp = do
   let sourcepos = journalSourcePos startpos endpos
   return $ txnTieKnot $ Transaction 0 sourcepos date edate status code description comment tags postings ""
 
+-- old HUnit tests
 test_transactionp = TestCase $ do
     let s `gives` t = do
                         let p = runIdentity $ parseWithState mempty transactionp s
@@ -554,8 +555,10 @@ test_transactionp = TestCase $ do
                         assertEqual "Equal comment" (tcomment t) (tcomment t2)
                         assertEqual "Equal tags" (ttags t) (ttags t2)
                         assertEqual "Equal preceding comments" (tpreceding_comment_lines t) (tpreceding_comment_lines t2)
-                        assertEqual "Equal postings" (show $ tpostings t) (show $ tpostings t2)
+                        assertEqual "Equal postings" (tpostings t) (tpostings t2)
-    -- "0000/01/01\n\n" `gives` nulltransaction
+
+    T.unlines ["2015/1/1"] `gives` nulltransaction{ tdate=parsedate "2015/01/01" }
+
     T.unlines [
       "2012/05/14=2012/05/15 (code) desc  ; tcomment1",
       "    ; tcomment2",
@@ -576,7 +579,7 @@ test_transactionp = TestCase $ do
       ttags=[("ttag1","val1")],
       tpostings=[
         nullposting{
-          pdate=Just $ parsedate "2012/05/14",
+          pdate=Nothing,
           pstatus=Cleared,
           paccount="a",
           pamount=Mixed [usd 1],
@@ -588,9 +591,6 @@ test_transactionp = TestCase $ do
         ],
       tpreceding_comment_lines=""
       }
-    T.unlines ["2015/1/1"]
-     `gives`
-     nulltransaction{ tdate=parsedate "2015/01/01" }
 
     assertBool "transactionp parses a well-formed transactionParse OK" $
       isRight . runIdentity . parseWithState mempty transactionp $ T.unlines
@@ -622,6 +622,77 @@ 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
+transactionp_tests = tests "transactionp" [
+
+   test "just-a-date" $ expectParseEq transactionp "2015/1/1\n" nulltransaction{tdate=parsedate "2015/01/01"}
+
+  ,test "more-complex" $ expectParseEq transactionp 
+    (T.unlines [
+      "2012/05/14=2012/05/15 (code) desc  ; tcomment1",
+      "    ; tcomment2",
+      "    ; ttag1: val1",
+      "    * a         $1.00  ; pcomment1",
+      "    ; pcomment2",
+      "    ; ptag1: val1",
+      "    ; ptag2: val2"
+      ])
+    nulltransaction{
+      tsourcepos=JournalSourcePos "" (1,7),  -- XXX why 7 here ?
+      tpreceding_comment_lines="",
+      tdate=parsedate "2012/05/14",
+      tdate2=Just $ parsedate "2012/05/15",
+      tstatus=Unmarked,
+      tcode="code",
+      tdescription="desc",
+      tcomment="tcomment1\ntcomment2\nttag1: val1\n",
+      ttags=[("ttag1","val1")],
+      tpostings=[
+        nullposting{
+          pdate=Nothing,
+          pstatus=Cleared,
+          paccount="a",
+          pamount=Mixed [usd 1],
+          pcomment="pcomment1\npcomment2\nptag1: val1\nptag2: val2\n",
+          ptype=RegularPosting,
+          ptags=[("ptag1","val1"),("ptag2","val2")],
+          ptransaction=Nothing
+          }
+        ]
+    }
+
+    ,it "parses a well-formed transaction" $
+      expect $ isRight $ rjp transactionp $ T.unlines
+        ["2007/01/28 coopportunity"
+        ,"    expenses:food:groceries                   $47.18"
+        ,"    assets:checking                          $-47.18"
+        ,""
+        ]
+
+--    ,it "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"
+--      (Right "a") (tdescription <$> p)
+
+--    assertBool "transactionp parses a following whitespace line" $
+--      isRight . runIdentity . parseWithState mempty transactionp $ T.unlines
+--        ["2012/1/1"
+--        ,"  a  1"
+--        ,"  b"
+--        ," "
+--        ]
+--
+--    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"
+--             ]
+--    assertBool "transactionp parses parses comments anywhere" (isRight p)
+--    assertEqual "Has 2 postings" 2 (let Right t = p in length $ tpostings t)
+
+  ]
+
 --- ** postings
 
 -- Parse the following whitespace-beginning lines as postings, posting
@@ -714,28 +785,13 @@ test_postingp = TestCase $ do
 tests_Hledger_Read_JournalReader = TestList [
     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
-
-tests_Hledger_Read_JournalReader = TestList $ concat [
-    test_numberp,
-    test_amountp,
-    test_spaceandamountormissingp,
-    test_tagcomment,
-    test_inlinecomment,
-    test_comments,
-    test_ledgerDateSyntaxToTags,
-    test_postingp,
-    test_transactionp,
-    [
-   "transactionmodifierp" ~: do
-     assertParse (parseWithState mempty transactionmodifierp "= (some value expr)\n some:postings  1\n")
 
+{- old hunit tests TODO
   ,"periodictransactionp" ~: do
      assertParse (parseWithState mempty periodictransactionp "~ (some period expr)\n some:postings  1\n")
 
@@ -810,12 +866,19 @@ tests_Hledger_Read_JournalReader = TestList $ concat [
              (either (const "parse error") showAmountDebug parseresult) ~?= (showAmountDebug amount)
      assertAmountParse (parseWithState mempty amountp "1 @ $2")
        (num 1 `withPrecision` 0 `at` (usd 2 `withPrecision` 0))
-
- ]]
 -}
+  ]
 
 easytests = tests "JournalReader" [
-  tests "periodictransactionp" [
+   tests "transactionmodifierp" [
+    test "transactionmodifierp" $ expectParseEqIO 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
@@ -859,5 +922,6 @@ easytests = tests "JournalReader" [
         ,ptdescription = "Next year blah blah\n"
         }
 
+    ,transactionp_tests
     ]
   ]