1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
{-
Run doctests in Hledger source files under the current directory
(./Hledger.hs, ./Hledger/**, ./Text/**) using the doctest runner.
https://github.com/sol/doctest#readme
Arguments are case-insensitive file path substrings, to limit the files searched.
--verbose shows files being searched for doctests and progress while running.
--slow reloads ghci between each test (https://github.com/sol/doctest#a-note-on-performance).
Eg, in hledger source dir:
$ make ghci-doctest, :main [--verbose] [--slow] [CIFILEPATHSUBSTRINGS]
or:
$ stack test hledger-lib:test:doctest --test-arguments="--verbose --slow [CIFILEPATHSUBSTRINGS]"
-}
-- This file can't be called doctest.hs ("File name does not match module name")
{-# LANGUAGE PackageImports #-}
import Control.Monad
import Data.Char
import Data.List
import System.Environment
import "Glob" System.FilePath.Glob
import Test.DocTest
main :: IO ()
main = do
args <- getArgs
let
verbose = "--verbose" `elem` args
slow = "--slow" `elem` args
pats = filter (not . ("-" `isPrefixOf`)) args
-- find source files
sourcefiles <- (filter (not . isInfixOf "/.") . concat) <$> sequence [
glob "Hledger.hs"
,glob "Hledger/**/*.hs"
,glob "Text/**/*.hs"
]
-- filter by patterns (case insensitive infix substring match)
let
fs | null pats = sourcefiles
| otherwise = [f | f <- sourcefiles, let f' = map toLower f, any (`isInfixOf` f') pats']
where pats' = map (map toLower) pats
fslen = length fs
if (null fs)
then do
putStrLn $ "No file paths found matching: " ++ unwords pats
else do
putStrLn $
"Loading and searching for doctests in "
++ show fslen
++ if fslen > 1 then " files, plus any files they import:" else " file, plus any files it imports:"
when verbose $ putStrLn $ unwords fs
doctest $
(if verbose then ("--verbose" :) else id) $ -- doctest >= 0.15.0
(if slow then id else ("--fast" :)) $ -- doctest >= 0.11.4
fs
|
