diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index f2d50be13..ad4791760 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/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 { diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index d102934d3..d1cc92459 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/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 diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index da6ed4de5..23aa43508 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/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" [ diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index ed0aa9e3f..1e3ce59c2 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/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) - -- "0000/01/01\n\n" `gives` nulltransaction + assertEqual "Equal postings" (tpostings t) (tpostings t2) + + 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 ] ]