Skip to content

Commit 4af279e

Browse files
AliasQliAliasQli
authored
Disable test (#1124)
* allow disable tests on client side
1 parent c2dd35c commit 4af279e

File tree

8 files changed

+195
-42
lines changed

8 files changed

+195
-42
lines changed

‎datafiles/templates/Html/maintain.html.st

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -46,6 +46,11 @@ package after its been released.
4646
<p>$versions:{pkgid|<a href="/package/$pkgid$/$pkgname$.cabal/edit">$pkgid$</a>}; separator=", "$</p>
4747
</dd>
4848

49+
<dt>Test settings</dt>
50+
<dd>If your package contains tests that can't run on hackage, you can disable them here.
51+
<p>$versions:{pkgid|<a href="/package/$pkgid$/reports/test">$pkgid$</a>}; separator=", "$</p>
52+
</dd>
53+
4954
<dt>Trigger rebuild</dt>
5055
<dd>Reset the fail count and trigger rebuild. Choose this option only if you believe our build process didn't go right for some reason. Reseting fail count won't trigger rebuild if your package has documentation.
5156
<p>$versions:{pkgid|<a href="/package/$pkgid$/reports/reset" onclick="return confirm('Are you sure you want to trigger rebuild?')" >$pkgid$</a>}; separator=", "$</p>

‎datafiles/templates/Html/reports-test.html.st

Lines changed: 25 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,25 @@
1+
<!DOCTYPE html>
2+
<html>
3+
<head>
4+
$hackageCssTheme()$
5+
<title>Test settings</title>
6+
</head>
7+
<body>
8+
$hackagePageHeader()$
9+
10+
<div id="content">
11+
<h2>Test settings for $pkgid$</h2>
12+
13+
<form action="." method="post" enctype="multipart/form-data">
14+
15+
<dl>
16+
<dt>Run tests</dt>
17+
<dd><input type="checkbox" name="runTests" id="runTests" $if(runTests)$checked$endif$>
18+
Whether hackage should run the tests.
19+
</dd>
20+
21+
<p><input type="submit" value="Save">
22+
</form>
23+
24+
</div>
25+
</body></html>

‎exes/BuildClient.hs

Lines changed: 17 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -362,6 +362,7 @@ data DocInfo = DocInfo {
362362
docInfoPackage :: PackageIdentifier
363363
, docInfoHasDocs :: HasDocs
364364
, docInfoIsCandidate :: Bool
365+
, docInfoRunTests :: Bool
365366
}
366367

367368
docInfoPackageName :: DocInfo -> PackageName
@@ -410,8 +411,8 @@ getDocumentationStats verbosity opts config pkgs = do
410411
(Just (perrs, packages), Just (cerrs, candidates)) -> do
411412
liftIO . when (not . null $ perrs) . putStrLn $ "failed package json parses: " ++ show perrs
412413
liftIO . when (not . null $ cerrs) . putStrLn $ "failed candidate json parses: " ++ show cerrs
413-
packages' <- liftIO $ mapM checkFailed packages
414-
candidates' <- liftIO $ mapM checkFailed candidates
414+
let packages' = map checkFailed packages
415+
candidates' = map checkFailed candidates
415416
return $ map (setIsCandidate False) packages'
416417
++ map (setIsCandidate True) candidates'
417418
where
@@ -447,21 +448,23 @@ getDocumentationStats verbosity opts config pkgs = do
447448
addEnd (Just pkgs') Nothing uri = uri <//> "docs.json" ++ "?pkgs=" ++ (getQry pkgs')
448449
addEnd Nothing Nothing uri = uri <//> "docs.json"
449450

450-
checkFailed :: BR.PkgDetails -> IO (PackageIdentifier, HasDocs)
451-
checkFailed pkgDetails = do
451+
checkFailed :: BR.PkgDetails -> (PackageIdentifier, HasDocs, Bool)
452+
checkFailed pkgDetails =
452453
let pkgId = BR.pkid pkgDetails
453-
case (BR.docs pkgDetails, BR.failCnt pkgDetails) of
454-
(True , _) -> return (pkgId, HasDocs)
455-
(False, Just BR.BuildOK) -> return (pkgId, DocsFailed)
456-
(False, Just (BR.BuildFailCnt a))
457-
| a >= bo_buildAttempts opts -> return (pkgId, DocsFailed)
458-
(False, _) -> return (pkgId, DocsNotBuilt)
459-
460-
setIsCandidate :: Bool -> (PackageIdentifier, HasDocs) -> DocInfo
461-
setIsCandidate isCandidate (pId, hasDocs) = DocInfo {
454+
hasDocs = case (BR.docs pkgDetails, BR.failCnt pkgDetails) of
455+
(True , _) -> HasDocs
456+
(False, Just BR.BuildOK) -> DocsFailed
457+
(False, Just (BR.BuildFailCnt a))
458+
| a >= bo_buildAttempts opts -> DocsFailed
459+
(False, _) -> DocsNotBuilt
460+
in (pkgId, hasDocs, fromMaybe True $ BR.runTests pkgDetails)
461+
462+
setIsCandidate :: Bool -> (PackageIdentifier, HasDocs, Bool) -> DocInfo
463+
setIsCandidate isCandidate (pId, hasDocs, runTests) = DocInfo {
462464
docInfoPackage = pId
463465
, docInfoHasDocs = hasDocs
464466
, docInfoIsCandidate = isCandidate
467+
, docInfoRunTests = runTests
465468
}
466469

467470

@@ -573,7 +576,7 @@ processPkg verbosity opts config docInfo = do
573576
let installOk = fmap ("install-outcome: InstallOk" `isInfixOf`) buildReport == Just True
574577

575578
-- Run Tests if installOk, Run coverage is Tests runs
576-
(testOutcome, hpcLoc) <- case installOk of
579+
(testOutcome, hpcLoc) <- case installOk && docInfoRunTests docInfo of
577580
True -> testPackage verbosity opts docInfo
578581
False -> return (Nothing, Nothing)
579582
coverageFile <- mapM (coveragePackage verbosity opts docInfo) hpcLoc

‎src/Distribution/Server/Features/BuildReports.hs

Lines changed: 34 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,7 @@ import Data.ByteString.Lazy (toStrict)
3232
import Data.String (fromString)
3333
import Data.Maybe
3434
import Distribution.Compiler ( CompilerId(..) )
35+
import Data.Aeson (toJSON)
3536

3637

3738
-- TODO:
@@ -47,6 +48,7 @@ data ReportsFeature = ReportsFeature {
4748
queryBuildLog :: forall m. MonadIO m => BuildLog -> m Resource.BuildLog,
4849
pkgReportDetails :: forall m. MonadIO m => (PackageIdentifier, Bool) -> m BuildReport.PkgDetails,
4950
queryLastReportStats:: forall m. MonadIO m => PackageIdentifier -> m (Maybe (BuildReportId, BuildReport, Maybe BuildCovg)),
51+
queryRunTests :: forall m. MonadIO m => PackageId -> m Bool,
5052
reportsResource :: ReportsResource
5153
}
5254

@@ -59,6 +61,7 @@ data ReportsResource = ReportsResource {
5961
reportsPage :: Resource,
6062
reportsLog :: Resource,
6163
reportsReset:: Resource,
64+
reportsTest :: Resource,
6265
reportsListUri :: String -> PackageId -> String,
6366
reportsPageUri :: String -> PackageId -> BuildReportId -> String,
6467
reportsLogUri :: PackageId -> BuildReportId -> String
@@ -119,6 +122,7 @@ buildReportsFeature name
119122
, reportsPage
120123
, reportsLog
121124
, reportsReset
125+
, reportsTest
122126
]
123127
, featureState = [abstractAcidStateComponent reportsState]
124128
}
@@ -140,6 +144,13 @@ buildReportsFeature name
140144
]
141145
, resourceGet = [ ("", resetBuildFails) ]
142146
}
147+
, reportsTest = (extendResourcePath "/reports/test/" corePackagePage) {
148+
resourceDesc = [ (GET, "Get reports test settings")
149+
, (POST, "Set reports test settings")
150+
]
151+
, resourceGet = [ ("json", getReportsTest) ]
152+
, resourcePost = [ ("", postReportsTest) ]
153+
}
143154
, reportsPage = (extendResourcePath "/reports/:id.:format" corePackagePage) {
144155
resourceDesc = [ (GET, "Get a specific build report")
145156
, (DELETE, "Delete a specific build report")
@@ -201,12 +212,13 @@ buildReportsFeature name
201212
pkgReportDetails (pkgid, docs) = do
202213
failCnt <- queryState reportsState $ LookupFailCount pkgid
203214
latestRpt <- queryState reportsState $ LookupLatestReport pkgid
215+
runTests <- fmap Just . queryState reportsState $ LookupRunTests pkgid
204216
(time, ghcId) <- case latestRpt of
205217
Nothing -> return (Nothing,Nothing)
206218
Just (_, brp, _, _) -> do
207219
let (CompilerId _ vrsn) = compiler brp
208220
return (time brp, Just vrsn)
209-
return (BuildReport.PkgDetails pkgid docs failCnt time ghcId)
221+
return (BuildReport.PkgDetails pkgid docs failCnt time ghcId runTests)
210222

211223
queryLastReportStats :: MonadIO m => PackageIdentifier -> m (Maybe (BuildReportId, BuildReport, Maybe BuildCovg))
212224
queryLastReportStats pkgid = do
@@ -215,6 +227,8 @@ buildReportsFeature name
215227
Nothing -> return Nothing
216228
Just (rptId, rpt, _, covg) -> return (Just (rptId, rpt, covg))
217229

230+
queryRunTests :: MonadIO m => PackageId -> m Bool
231+
queryRunTests pkgid = queryState reportsState $ LookupRunTests pkgid
218232

219233
---------------------------------------------------------------------------
220234

@@ -318,6 +332,25 @@ buildReportsFeature name
318332
then seeOther (reportsListUri reportsResource "" pkgid) $ toResponse ()
319333
else errNotFound "Report not found" [MText "Build report does not exist"]
320334

335+
getReportsTest :: DynamicPath -> ServerPartE Response
336+
getReportsTest dpath = do
337+
pkgid <- packageInPath dpath
338+
guardValidPackageId pkgid
339+
guardAuthorisedAsMaintainerOrTrustee (packageName pkgid)
340+
runTest <- queryRunTests pkgid
341+
pure $ toResponse $ toJSON runTest
342+
343+
postReportsTest :: DynamicPath -> ServerPartE Response
344+
postReportsTest dpath = do
345+
pkgid <- packageInPath dpath
346+
runTests <- body $ looks "runTests"
347+
guardValidPackageId pkgid
348+
guardAuthorisedAsMaintainerOrTrustee (packageName pkgid)
349+
success <- updateState reportsState $ SetRunTests pkgid ("on" `elem` runTests)
350+
if success
351+
then seeOther (reportsListUri reportsResource "" pkgid) $ toResponse ()
352+
else errNotFound "Package not found" [MText "Package does not exist"]
353+
321354

322355
putAllReports :: DynamicPath -> ServerPartE Response
323356
putAllReports dpath = do

‎src/Distribution/Server/Features/BuildReports/BuildReport.hs

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -635,7 +635,8 @@ data PkgDetails = PkgDetails {
635635
docs :: Bool,
636636
failCnt :: Maybe BuildStatus,
637637
buildTime :: Maybe UTCTime,
638-
ghcId :: Maybe Version
638+
ghcId :: Maybe Version,
639+
runTests :: Maybe Bool
639640
} deriving(Show)
640641

641642
instance Data.Aeson.ToJSON PkgDetails where
@@ -644,7 +645,8 @@ instance Data.Aeson.ToJSON PkgDetails where
644645
"docs" .= docs p,
645646
"failCnt" .= failCnt p,
646647
"buildTime" .= buildTime p,
647-
"ghcId" .= k (ghcId p) ]
648+
"ghcId" .= k (ghcId p),
649+
"runTests" .= runTests p ]
648650
where
649651
k (Just a) = Just $ DT.display a
650652
k Nothing = Nothing
@@ -657,6 +659,7 @@ instance Data.Aeson.FromJSON PkgDetails where
657659
<*> o .:? "failCnt"
658660
<*> o .:? "buildTime"
659661
<*> fmap parseVersion (o .:? "ghcId")
662+
<*> o .: "runTests"
660663
where
661664
parseVersion :: Maybe String -> Maybe Version
662665
parseVersion Nothing = Nothing

0 commit comments

Comments
 (0)