lib: add a doctest suite
This commit is contained in:
		
							parent
							
								
									9946e7df88
								
							
						
					
					
						commit
						259e7bfbe3
					
				
							
								
								
									
										3
									
								
								Makefile
									
									
									
									
									
								
							
							
						
						
									
										3
									
								
								Makefile
									
									
									
									
									
								
							| @ -809,6 +809,9 @@ ghci-api: \ | |||||||
| # 		$(call def-help,ghci-api, start a GHCI REPL and load the hledger-lib, hledger and hledger-api packages)
 | # 		$(call def-help,ghci-api, start a GHCI REPL and load the hledger-lib, hledger and hledger-api packages)
 | ||||||
| 	stack exec $(GHCI) -- $(BUILDFLAGS) hledger-api/hledger-api.hs | 	stack exec $(GHCI) -- $(BUILDFLAGS) hledger-api/hledger-api.hs | ||||||
| 
 | 
 | ||||||
|  | ghcid-lib-doctest: | ||||||
|  | 	ghcid --command 'cd hledger-lib; stack ghci hledger-lib:test:doctests' --test ':main' --reload hledger-lib | ||||||
|  | 
 | ||||||
| samplejournals: \ | samplejournals: \ | ||||||
| 	data/sample.journal \
 | 	data/sample.journal \
 | ||||||
| 	data/100x100x10.journal \
 | 	data/100x100x10.journal \
 | ||||||
|  | |||||||
| @ -1,7 +1,7 @@ | |||||||
| -- * doc | --- * doc | ||||||
| -- lines beginning "-- *" are collapsible orgstruct nodes. Emacs users: | -- lines beginning "--- *" are collapsible orgstruct nodes. Emacs users: | ||||||
| -- (add-hook 'haskell-mode-hook | -- (add-hook 'haskell-mode-hook | ||||||
| --   (lambda () (set-variable 'orgstruct-heading-prefix-regexp "-- " t)) | --   (lambda () (set-variable 'orgstruct-heading-prefix-regexp "--- " t)) | ||||||
| --   'orgstruct-mode) | --   'orgstruct-mode) | ||||||
| 
 | 
 | ||||||
| {-| | {-| | ||||||
| @ -20,11 +20,14 @@ reader should handle many ledger files as well. Example: | |||||||
| 
 | 
 | ||||||
| -} | -} | ||||||
| 
 | 
 | ||||||
| -- * module | --- * module | ||||||
|  | 
 | ||||||
| -- {-# OPTIONS_GHC -F -pgmF htfpp #-} | -- {-# OPTIONS_GHC -F -pgmF htfpp #-} | ||||||
|  | 
 | ||||||
| {-# LANGUAGE CPP, RecordWildCards, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts #-} | {-# LANGUAGE CPP, RecordWildCards, NoMonoLocalBinds, ScopedTypeVariables, FlexibleContexts #-} | ||||||
| 
 | 
 | ||||||
| module Hledger.Read.JournalReader ( | module Hledger.Read.JournalReader ( | ||||||
|  | 
 | ||||||
|   -- * Reader |   -- * Reader | ||||||
|   reader, |   reader, | ||||||
| 
 | 
 | ||||||
| @ -61,7 +64,7 @@ module Hledger.Read.JournalReader ( | |||||||
| #endif | #endif | ||||||
| ) | ) | ||||||
| where | where | ||||||
| -- * imports | --- * imports | ||||||
| import Prelude () | import Prelude () | ||||||
| import Prelude.Compat hiding (readFile) | import Prelude.Compat hiding (readFile) | ||||||
| import qualified Control.Exception as C | import qualified Control.Exception as C | ||||||
| @ -88,7 +91,7 @@ import Hledger.Data | |||||||
| import Hledger.Utils | import Hledger.Utils | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| -- * reader | --- * reader | ||||||
| 
 | 
 | ||||||
| reader :: Reader | reader :: Reader | ||||||
| reader = Reader format detect parse | reader = Reader format detect parse | ||||||
| @ -107,7 +110,7 @@ detect f s | |||||||
| parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal | parse :: Maybe FilePath -> Bool -> FilePath -> String -> ExceptT String IO Journal | ||||||
| parse _ = parseAndFinaliseJournal journalp | parse _ = parseAndFinaliseJournal journalp | ||||||
| 
 | 
 | ||||||
| -- * parsing utils | --- * parsing utils | ||||||
| 
 | 
 | ||||||
| genericSourcePos :: SourcePos -> GenericSourcePos | genericSourcePos :: SourcePos -> GenericSourcePos | ||||||
| genericSourcePos p = GenericSourcePos (sourceName p) (sourceLine p) (sourceColumn p) | genericSourcePos p = GenericSourcePos (sourceName p) (sourceLine p) (sourceColumn p) | ||||||
| @ -233,8 +236,8 @@ getIndex = liftM ctxTransactionIndex getState | |||||||
| setIndex :: Stream [Char] m Char => Integer -> ParsecT [Char] JournalContext m () | setIndex :: Stream [Char] m Char => Integer -> ParsecT [Char] JournalContext m () | ||||||
| setIndex i = modifyState (\ctx -> ctx{ctxTransactionIndex=i}) | setIndex i = modifyState (\ctx -> ctx{ctxTransactionIndex=i}) | ||||||
| 
 | 
 | ||||||
| -- * parsers | --- * parsers | ||||||
| -- ** journal | --- ** journal | ||||||
| 
 | 
 | ||||||
| -- | Top-level journal parser. Returns a single composite, I/O performing, | -- | Top-level journal parser. Returns a single composite, I/O performing, | ||||||
| -- error-raising "JournalUpdate" (and final "JournalContext") which can be | -- error-raising "JournalUpdate" (and final "JournalContext") which can be | ||||||
| @ -258,7 +261,7 @@ journalp = do | |||||||
|                            , multilinecommentp >> return (return id) |                            , multilinecommentp >> return (return id) | ||||||
|                            ] <?> "journal transaction or directive" |                            ] <?> "journal transaction or directive" | ||||||
| 
 | 
 | ||||||
| -- ** directives | --- ** directives | ||||||
| 
 | 
 | ||||||
| -- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives | -- cf http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives | ||||||
| directivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate | directivep :: ParsecT [Char] JournalContext (ExceptT String IO) JournalUpdate | ||||||
| @ -442,7 +445,7 @@ commodityconversiondirectivep = do | |||||||
|   restofline |   restofline | ||||||
|   return $ return id |   return $ return id | ||||||
| 
 | 
 | ||||||
| -- ** transactions | --- ** transactions | ||||||
| 
 | 
 | ||||||
| modifiertransactionp :: ParsecT [Char] JournalContext (ExceptT String IO) ModifierTransaction | modifiertransactionp :: ParsecT [Char] JournalContext (ExceptT String IO) ModifierTransaction | ||||||
| modifiertransactionp = do | modifiertransactionp = do | ||||||
| @ -585,7 +588,7 @@ codep = try (do { many1 spacenonewline; char '(' <?> "codep"; code <- anyChar `m | |||||||
| 
 | 
 | ||||||
| descriptionp = many (noneOf ";\n") | descriptionp = many (noneOf ";\n") | ||||||
| 
 | 
 | ||||||
| -- ** dates | --- ** dates | ||||||
| 
 | 
 | ||||||
| -- | Parse a date in YYYY/MM/DD format. | -- | Parse a date in YYYY/MM/DD format. | ||||||
| -- Hyphen (-) and period (.) are also allowed as separators. | -- Hyphen (-) and period (.) are also allowed as separators. | ||||||
| @ -662,7 +665,7 @@ secondarydatep primarydate = do | |||||||
|   edate <- withDefaultYear primarydate datep |   edate <- withDefaultYear primarydate datep | ||||||
|   return edate |   return edate | ||||||
| 
 | 
 | ||||||
| -- ** postings | --- ** postings | ||||||
| 
 | 
 | ||||||
| -- Parse the following whitespace-beginning lines as postings, posting tags, and/or comments. | -- Parse the following whitespace-beginning lines as postings, posting tags, and/or comments. | ||||||
| postingsp :: Stream [Char] m Char => ParsecT [Char] JournalContext m [Posting] | postingsp :: Stream [Char] m Char => ParsecT [Char] JournalContext m [Posting] | ||||||
| @ -759,7 +762,7 @@ test_postingp = do | |||||||
|     -- assertEqual (Just nullmixedamt) (pbalanceassertion p) |     -- assertEqual (Just nullmixedamt) (pbalanceassertion p) | ||||||
| #endif | #endif | ||||||
| 
 | 
 | ||||||
| -- ** account names | --- ** account names | ||||||
| 
 | 
 | ||||||
| -- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect. | -- | Parse an account name, then apply any parent account prefix and/or account aliases currently in effect. | ||||||
| modifiedaccountnamep :: Stream [Char] m Char => ParsecT [Char] JournalContext m AccountName | modifiedaccountnamep :: Stream [Char] m Char => ParsecT [Char] JournalContext m AccountName | ||||||
| @ -795,7 +798,7 @@ accountnamep = do | |||||||
| -- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace | -- accountnamechar = notFollowedBy (oneOf "()[]") >> nonspace | ||||||
| --     <?> "account name character (non-bracket, non-parenthesis, non-whitespace)" | --     <?> "account name character (non-bracket, non-parenthesis, non-whitespace)" | ||||||
| 
 | 
 | ||||||
| -- ** amounts | --- ** amounts | ||||||
| 
 | 
 | ||||||
| -- | Parse whitespace then an amount, with an optional left or right | -- | Parse whitespace then an amount, with an optional left or right | ||||||
| -- currency symbol and optional price, or return the special | -- currency symbol and optional price, or return the special | ||||||
| @ -1040,7 +1043,7 @@ numberp = do | |||||||
| --       assertFails ".1," | --       assertFails ".1," | ||||||
| --       assertFails ",1." | --       assertFails ",1." | ||||||
| 
 | 
 | ||||||
| -- ** comments | --- ** comments | ||||||
| 
 | 
 | ||||||
| multilinecommentp :: Stream [Char] m Char => ParsecT [Char] JournalContext m () | multilinecommentp :: Stream [Char] m Char => ParsecT [Char] JournalContext m () | ||||||
| multilinecommentp = do | multilinecommentp = do | ||||||
| @ -1081,13 +1084,21 @@ commentStartingWithp cs = do | |||||||
|   optional newline |   optional newline | ||||||
|   return l |   return l | ||||||
| 
 | 
 | ||||||
| -- ** tags | --- ** tags | ||||||
| 
 | 
 | ||||||
| tagsInComment :: String -> [Tag] | tagsInComment :: String -> [Tag] | ||||||
| tagsInComment c = concatMap tagsInCommentLine $ lines c' | tagsInComment c = concatMap tagsInCommentLine $ lines c' | ||||||
|   where |   where | ||||||
|     c' = ledgerDateSyntaxToTags c |     c' = ledgerDateSyntaxToTags c | ||||||
| 
 | 
 | ||||||
|  | -- | | ||||||
|  | -- ==== __Examples__ | ||||||
|  | -- >>> tagsInCommentLine "" | ||||||
|  | -- [] | ||||||
|  | -- >>> tagsInCommentLine "a b" | ||||||
|  | -- [] | ||||||
|  | -- >>> tagsInCommentLine "a b:, c:c d:d, e" | ||||||
|  | -- [("c","c d:d")] | ||||||
| tagsInCommentLine :: String -> [Tag] | tagsInCommentLine :: String -> [Tag] | ||||||
| tagsInCommentLine = catMaybes . map maybetag . map strip . splitAtElement ',' | tagsInCommentLine = catMaybes . map maybetag . map strip . splitAtElement ',' | ||||||
|   where |   where | ||||||
| @ -1142,7 +1153,7 @@ dateValueFromTags  ts = maybe Nothing (Just . snd) $ find ((=="date") . fst) ts | |||||||
| date2ValueFromTags ts = maybe Nothing (Just . snd) $ find ((=="date2") . fst) ts | date2ValueFromTags ts = maybe Nothing (Just . snd) $ find ((=="date2") . fst) ts | ||||||
| 
 | 
 | ||||||
| 
 | 
 | ||||||
| -- * tests | --- * tests | ||||||
| 
 | 
 | ||||||
| tests_Hledger_Read_JournalReader = TestList $ concat [ | tests_Hledger_Read_JournalReader = TestList $ concat [ | ||||||
|     -- test_numberp |     -- test_numberp | ||||||
|  | |||||||
| @ -138,11 +138,10 @@ library | |||||||
|       Hledger.Utils.UTF8IOCompat |       Hledger.Utils.UTF8IOCompat | ||||||
|   default-language: Haskell2010 |   default-language: Haskell2010 | ||||||
| 
 | 
 | ||||||
| test-suite tests | test-suite hunittests | ||||||
|   type: exitcode-stdio-1.0 |   type: exitcode-stdio-1.0 | ||||||
|   main-is: suite.hs |   main-is: hunittests.hs | ||||||
|   hs-source-dirs: |   hs-source-dirs: tests | ||||||
|       tests |  | ||||||
|   ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans |   ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-name-shadowing -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-orphans | ||||||
|   build-depends: |   build-depends: | ||||||
|       base >= 4.3 && < 5 |       base >= 4.3 && < 5 | ||||||
| @ -181,3 +180,12 @@ test-suite tests | |||||||
|     build-depends: time >= 1.5 |     build-depends: time >= 1.5 | ||||||
| 
 | 
 | ||||||
|   default-language: Haskell2010 |   default-language: Haskell2010 | ||||||
|  | 
 | ||||||
|  | test-suite doctests | ||||||
|  |   type: exitcode-stdio-1.0 | ||||||
|  |   hs-source-dirs: tests | ||||||
|  |   main-is: doctests.hs | ||||||
|  |   build-depends: | ||||||
|  |       base | ||||||
|  |     , doctest >= 0.8 | ||||||
|  |   default-language: Haskell2010 | ||||||
|  | |||||||
							
								
								
									
										5
									
								
								hledger-lib/tests/doctests.hs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										5
									
								
								hledger-lib/tests/doctests.hs
									
									
									
									
									
										Normal file
									
								
							| @ -0,0 +1,5 @@ | |||||||
|  | import Test.DocTest | ||||||
|  | 
 | ||||||
|  | main = doctest [ | ||||||
|  |   "Hledger/Read/JournalReader.hs" | ||||||
|  |   ] | ||||||
		Loading…
	
		Reference in New Issue
	
	Block a user