Skip to content

Commit 44dd360

Browse files
phadejphadej
authored
Merge pull request #104 from phadej/module-opt
Add --module option
2 parents 7a6e584 + 0644383 commit 44dd360

File tree

8 files changed

+64
-43
lines changed

8 files changed

+64
-43
lines changed

‎cabal-docspec/MANUAL.md‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -116,6 +116,11 @@ However, in this list we mostly only list and show the --option version of them.
116116

117117
: Stop after the second phase, i.e. evaluation in GHCi phase.
118118

119+
**-m, \--module** *modulename*
120+
121+
: Check only these modules.
122+
Default is to check all.
123+
119124
**\--builddir** *dir*
120125

121126
: Directory to look for **plan.json** and local package database.

‎cabal-docspec/Makefile‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
1-
VERSION=0.0.0.20210111
1+
VERSION=0.0.0.20211114
22

33
cabal-docspec.1 : MANUAL.md
4-
echo '.TH CABAL-DOCSPEC 1 "January 10, 2021" "cabal-docspec $(VERSION)" "Cabal Extras"' > cabal-docspec.1
4+
echo '.TH CABAL-DOCSPEC 1 "January 15, 2021" "cabal-docspec $(VERSION)" "Cabal Extras"' > cabal-docspec.1
55
pandoc -f markdown -t man MANUAL.md >> cabal-docspec.1
66

77
man : cabal-docspec.1

‎cabal-docspec/cabal-docspec.1‎

Lines changed: 5 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
.TH CABAL-DOCSPEC 1 "January 10, 2021" "cabal-docspec 0.0.0.20210111" "Cabal Extras"
1+
.TH CABAL-DOCSPEC 1 "January 15, 2021" "cabal-docspec 0.0.0.20211114" "Cabal Extras"
22
.SH NAME
33
.PP
44
cabal-docspec - another doctest for Haskell
@@ -115,6 +115,10 @@ doctest examples from their comments.
115115
\f[B]--phase2\f[R]
116116
Stop after the second phase, i.e.\ evaluation in GHCi phase.
117117
.TP
118+
\f[B]-m, --module\f[R] \f[I]modulename\f[R]
119+
Check only these modules.
120+
Default is to check all.
121+
.TP
118122
\f[B]--builddir\f[R] \f[I]dir\f[R]
119123
Directory to look for \f[B]plan.json\f[R] and local package database.
120124
.TP

‎cabal-docspec/cabal-docspec.cabal‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
cabal-version: 2.2
22
name: cabal-docspec
3-
version: 0.0.0.20210228
3+
version: 0.0.0.20211114
44
synopsis: Run examples in your docs
55
category: Development
66
description:

‎cabal-docspec/src/CabalDocspec/Main.hs‎

Lines changed: 6 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ import Control.Applicative ((<**>))
1414
import qualified Cabal.Config as Cabal
1515
import qualified Cabal.Plan as Plan
1616
import qualified Data.Map.Strict as Map
17+
import qualified Data.Set as Set
1718
import qualified Distribution.Compiler as C
1819
import qualified Distribution.ModuleName as C
1920
import qualified Distribution.Package as C
@@ -187,15 +188,6 @@ checkGhcVersion tracer ghcInfo plan
187188
ghcId = PackageIdentifier "ghc" (ghcVersion ghcInfo)
188189
planId = toCabal (Plan.pjCompilerId plan)
189190

190-
-------------------------------------------------------------------------------
191-
-- Skipping
192-
-------------------------------------------------------------------------------
193-
194-
skipModule :: Module [Located DocTest] -> Summary
195-
skipModule m =
196-
mempty { sSetup = foldMap (foldMap (foldMap skipSetupDocTest)) (moduleSetup m) } <>
197-
foldMap (foldMap (foldMap skipDocTest)) (moduleContent m)
198-
199191
-------------------------------------------------------------------------------
200192
-- With plan.json
201193
-------------------------------------------------------------------------------
@@ -231,7 +223,7 @@ testComponent tracer0 tracerTop dynOptsCli ghcInfo buildDir cabalCfg plan env pk
231223
let tracer = adjustTracer (optVerbosity dynOpts) tracer0
232224

233225
-- find extra units
234-
extraUnitIds <- findExtraPackages tracer plan (propPkgs dynOpts ++ optExtraPkgs dynOpts)
226+
extraUnitIds <- findExtraPackages tracer plan $ Set.toList $ propPkgs dynOpts <> optExtraPkgs dynOpts
235227

236228
-- find library module paths
237229
modulePaths <- findModules
@@ -331,7 +323,7 @@ testComponentNo tracer0 tracerTop dynOptsCli ghcInfo cabalCfg dbG pkg = do
331323
-- we don't have install plan, so we look for packages in IPI
332324
depends <- for (C.targetBuildDepends bi) $ \dep -> findUnit (C.depPkgName dep)
333325
thisUnitId <- findUnit (C.packageName (pkgGpd pkg))
334-
extraUnitIds <- traverse findUnit (propPkgs dynOpts ++ optExtraPkgs dynOpts)
326+
extraUnitIds <- traverse findUnit $ Set.toList $ propPkgs dynOpts <> optExtraPkgs dynOpts
335327

336328
let pkgIds :: [PackageIdentifier]
337329
pkgIds = map snd depends
@@ -398,11 +390,10 @@ findExtraPackages tracer plan = traverse $ \pn -> do
398390
-- Utilities
399391
-------------------------------------------------------------------------------
400392

401-
402-
propPkgs :: DynOpts -> [PackageName]
393+
propPkgs :: DynOpts -> Set PackageName
403394
propPkgs dynOpts = case optProperties dynOpts of
404-
SkipProperties -> []
405-
CheckProperties -> [ mkPackageName "QuickCheck" ]
395+
SkipProperties -> mempty
396+
CheckProperties -> Set.singleton (mkPackageName "QuickCheck")
406397

407398
manglePackageName :: C.PackageName -> String
408399
manglePackageName = map fixchar . prettyShow where

‎cabal-docspec/src/CabalDocspec/Opts.hs‎

Lines changed: 18 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ import Peura
44

55
import qualified Data.Set as Set
66
import qualified Distribution.Compat.CharParsing as P
7+
import qualified Distribution.ModuleName as C
78
import qualified Distribution.Parsec as C
89
import qualified Distribution.Types.BuildInfo as C
910
import qualified Options.Applicative as O
@@ -31,7 +32,8 @@ data DynOpts = DynOpts
3132
, optTimeoutMsg :: String -- ^ timeout response
3233
, optGhciRtsopts :: [String]
3334
, optSetup :: [String]
34-
, optExtraPkgs :: [PackageName]
35+
, optExtraPkgs :: Set PackageName
36+
, optModules :: Set C.ModuleName
3537
, optCppIncludeDirs :: [FsPath]
3638
, optProperties :: Properties
3739
, optPropVariables :: Set String
@@ -48,7 +50,8 @@ defaultDynOpts = DynOpts
4850
, optTimeoutMsg = "* Hangs forever *"
4951
, optGhciRtsopts = []
5052
, optSetup = []
51-
, optExtraPkgs = []
53+
, optExtraPkgs = mempty
54+
, optModules = mempty
5255
, optCppIncludeDirs = []
5356
, optProperties = SkipProperties
5457
, optPropVariables = mempty
@@ -102,7 +105,7 @@ dynOptsFromBuildInfo tracer bi = do
102105
Left err -> do
103106
putWarning tracer WInvalidField $ name ++ ": " ++ err
104107
return id
105-
108+
106109
Right strs -> return $ \dynOpts -> dynOpts
107110
{ optPropVariables = Set.fromList strs <> optPropVariables dynOpts
108111
}
@@ -114,7 +117,7 @@ dynOptsFromBuildInfo tracer bi = do
114117
return id
115118

116119
Right pkgs -> return $ \dynOpts -> dynOpts
117-
{ optExtraPkgs = optExtraPkgs dynOpts ++ pkgs
120+
{ optExtraPkgs = optExtraPkgs dynOpts <> Set.fromList pkgs
118121
}
119122

120123

@@ -147,20 +150,24 @@ dynOptsP = pure combine
147150
<*> timeoutMsgP
148151
<*> monoidP rtsOptsP
149152
<*> listP (O.strOption (O.long "setup" <> O.metavar "EXPR" <> O.help "A setup expression"))
150-
<*> listP extraPkgP
153+
<*> setP extraPkgP
154+
<*> setP moduleNameP
151155
<*> listP cppDirP
152156
<*> propertiesP
153157
<*> monoidP propVariablesP
154158
<*> verbosityP
155159
where
160+
setP :: Ord a => O.Parser a -> O.Parser (Set a -> Set a)
161+
setP p = (\xs ys -> Set.fromList xs <> ys) <$> many p
162+
156163
listP :: O.Parser a -> O.Parser ([a] -> [a])
157164
listP p = flip (++) <$> many p
158165

159166
monoidP :: Monoid a => O.Parser a -> O.Parser (a -> a)
160167
monoidP p = (\xs ys -> mconcat (ys : xs)) <$> many p
161168

162-
combine f1 f2 f3 f4 f5 f6 f7 f8 f9 fA fB fC fD (DynOpts x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD) =
163-
DynOpts (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6) (f7 x7) (f8 x8) (f9 x9) (fA xA) (fB xB) (fC xC) (fD xD)
169+
combine f1 f2 f3 f4 f5 f6 f7 f8 f9 fA fB fC fD fE (DynOpts x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE) =
170+
DynOpts (f1 x1) (f2 x2) (f3 x3) (f4 x4) (f5 x5) (f6 x6) (f7 x7) (f8 x8) (f9 x9) (fA xA) (fB xB) (fC xC) (fD xD) (fE xE)
164171

165172
lastOpt :: [a] -> a -> a
166173
lastOpt xs initial = foldl' (\_ x -> x) initial xs
@@ -200,6 +207,10 @@ extraPkgP :: O.Parser PackageName
200207
extraPkgP = O.option (O.eitherReader C.eitherParsec) $
201208
O.long "extra-package" <> O.metavar "PKG" <> O.help "Extra packages to require (should exist in a plan)"
202209

210+
moduleNameP :: O.Parser C.ModuleName
211+
moduleNameP = O.option (O.eitherReader C.eitherParsec) $
212+
O.short 'm' <> O.long "module" <> O.metavar "MODULE" <> O.help "Which modules to check (all if empty)"
213+
203214
rtsOptsP :: O.Parser [String]
204215
rtsOptsP = O.option (fmap words O.str) $
205216
O.long "ghci-rtsopts" <> O.metavar "OPTS" <> O.help "RTS options for GHCi process"

‎cabal-docspec/src/CabalDocspec/Phase2.hs‎

Lines changed: 21 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -191,25 +191,29 @@ phase2 tracer dynOpts unitIds ghcInfo mbuildDir cabalCfg cwd extraEnv parsed = d
191191
= fmap (either id id)
192192
. foldl2 runExample skipping (Left acc)
193193

194-
-- run setup
195-
setupRes <- runSetupGroup
196-
197-
-- if there are no issues in setup
198-
if isOk setupRes
194+
if Set.null (optModules dynOpts) || Set.member (moduleName m) (optModules dynOpts)
199195
then do
200-
-- ... run content
201-
let combine xs = mconcat (mempty { sSetup = setupRes } : xs)
202-
fmap combine $ for (moduleContent m) $ \contents -> do
203-
-- we don't recount setups, even they are rerun
204-
_ <- runSetupGroup
205-
runExampleGroup mempty contents
206-
196+
-- run setup
197+
setupRes <- runSetupGroup
198+
199+
-- if there are no issues in setup
200+
if isOk setupRes
201+
then do
202+
-- ... run content
203+
let combine xs = mconcat (mempty { sSetup = setupRes } : xs)
204+
fmap combine $ for (moduleContent m) $ \contents -> do
205+
-- we don't recount setups, even they are rerun
206+
_ <- runSetupGroup
207+
runExampleGroup mempty contents
208+
209+
else do
210+
-- ... skip run
211+
putWarning tracer WErrorInSetup $
212+
"Issue in $setup, skipping " ++ prettyShow (moduleName m) ++ " module"
213+
let res = foldMap (foldMap (foldMap skipDocTest)) (moduleContent m)
214+
return $ mempty { sSetup = setupRes } <> res
207215
else do
208-
-- ... skip run
209-
putWarning tracer WErrorInSetup $
210-
"Issue in $setup, skipping " ++ prettyShow (moduleName m) ++ " module"
211-
let res = foldMap (foldMap (foldMap skipDocTest)) (moduleContent m)
212-
return $ mempty { sSetup = setupRes } <> res
216+
return (skipModule m)
213217

214218
foldl2
215219
:: (Monad m, Foldable f)

‎cabal-docspec/src/CabalDocspec/Summary.hs‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@ module CabalDocspec.Summary where
33
import Peura
44

55
import CabalDocspec.Doctest.Parse
6+
import CabalDocspec.Located
67

78
-- | Summary of a test run.
89
data Summary = Summary
@@ -64,3 +65,8 @@ skipDocTest Property {} = mempty { sProperties = ssSkip }
6465
skipSetupDocTest :: DocTest -> SubSummary
6566
skipSetupDocTest Example {} = ssSkip
6667
skipSetupDocTest Property {} = ssFailure
68+
69+
skipModule :: Module [Located DocTest] -> Summary
70+
skipModule m =
71+
mempty { sSetup = foldMap (foldMap (foldMap skipSetupDocTest)) (moduleSetup m) } <>
72+
foldMap (foldMap (foldMap skipDocTest)) (moduleContent m)

0 commit comments

Comments
 (0)