From 7c49e6c367c9d021f3630c08a4a13ba9abc5df08 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Fri, 18 Feb 2022 18:09:23 +0100
Subject: switch to universum prelude

also don't keep adjusted maps around if not necessary
---
 server/HtmlOrphans.hs | 2 +-
 server/Server.hs      | 5 ++++-
 server/Worker.hs      | 5 +++--
 3 files changed, 8 insertions(+), 4 deletions(-)

(limited to 'server')

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
 
-- 
cgit v1.2.3