diff options
Diffstat (limited to 'server')
| -rw-r--r-- | server/HtmlOrphans.hs | 2 | ||||
| -rw-r--r-- | server/Server.hs | 5 | ||||
| -rw-r--r-- | server/Worker.hs | 5 |
3 files changed, 8 insertions, 4 deletions
diff --git a/server/HtmlOrphans.hs b/server/HtmlOrphans.hs index ebe65aa..9b09f1d 100644 --- a/server/HtmlOrphans.hs +++ b/server/HtmlOrphans.hs @@ -108,7 +108,7 @@ headerText = \case -- | The fully monky -instance ToHtml DirResult where +instance ToHtml (DirResult a) where toHtml res@DirResult { .. } = do p_ $ do badge maxlevel "Linted:"; " "; headerText maxlevel diff --git a/server/Server.hs b/server/Server.hs index f2b286b..711da88 100644 --- a/server/Server.hs +++ b/server/Server.hs @@ -3,6 +3,8 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} @@ -31,6 +33,7 @@ module Server ( loadConfig import Universum import CheckDir (DirResult) +import CheckMap (ResultKind (Full, Shrunk)) import Control.Arrow ((>>>)) import Control.Concurrent (modifyMVar_, withMVar) import Crypto.Hash.SHA1 (hash) @@ -162,7 +165,7 @@ configCodec = Config -- | a job status (of a specific uuid) data JobStatus = - Pending | Linted !DirResult Text | Failed Text + Pending | Linted !(DirResult Shrunk) Text | Failed Text deriving (Generic, ToJSON, NFData) instance TS.Show JobStatus where diff --git a/server/Worker.hs b/server/Worker.hs index 91fa8e2..af07904 100644 --- a/server/Worker.hs +++ b/server/Worker.hs @@ -9,7 +9,8 @@ module Worker (linterThread, Job(..)) where import Universum -import CheckDir (recursiveCheckDir) +import CheckDir (recursiveCheckDir, + shrinkDirResult) import Control.Concurrent.Async (async, link) import Control.Concurrent.STM.TQueue import Control.Exception (IOException, handle) @@ -66,7 +67,7 @@ runJob config Job {..} done = do callgit gitdir [ "worktree", "add", "--force", workdir, toString ref ] res <- recursiveCheckDir (orgLintconfig jobOrg) workdir (orgEntrypoint jobOrg) - >>= evaluateNF + >>= evaluateNF . shrinkDirResult setJobStatus done jobOrg jobRef $ Linted res rev |