From 55c2994e856ceaf82edd06587e2faffb7c58950c Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Fri, 25 Feb 2022 16:30:45 +0100
Subject: server: write out adjusted maps

---
 server/Worker.hs | 26 +++++++++++++++++++++-----
 1 file changed, 21 insertions(+), 5 deletions(-)

(limited to 'server/Worker.hs')

diff --git a/server/Worker.hs b/server/Worker.hs
index af07904..b3ce1da 100644
--- a/server/Worker.hs
+++ b/server/Worker.hs
@@ -20,12 +20,13 @@ import qualified Data.UUID.V4                  as UUID
 import           Server                        (Config, JobStatus (..),
                                                 Org (..),
                                                 RemoteRef (reporef, repourl),
-                                                ServerState, setJobStatus,
-                                                tmpdir)
+                                                ServerState, adjustedPath,
+                                                setJobStatus, tmpdir)
 import           System.Directory              (doesDirectoryExist)
+import           System.Exit                   (ExitCode (ExitFailure))
 import           System.FilePath               ((</>))
 import           System.Process
-
+import           WriteRepo                     (writeAdjustedRepository)
 
 data Job = Job
   { jobRef :: RemoteRef
@@ -67,9 +68,24 @@ runJob config Job {..} done = do
       callgit gitdir [ "worktree", "add", "--force", workdir, toString ref ]
 
       res <- recursiveCheckDir (orgLintconfig jobOrg) workdir (orgEntrypoint jobOrg)
-               >>= evaluateNF . shrinkDirResult
+               >>= evaluateNF
+
+      writeAdjustedRepository (orgLintconfig jobOrg) workdir (toString $ adjustedPath rev jobOrg) res
+        >>= \case ExitFailure 1 ->
+                    -- error's in the result anyways
+                    pure ()
+                  ExitFailure 2 ->
+                    -- TODO: use a fastlogger for this or sth
+                    -- TODO: shouldn't have linted this map at all
+                    putTextLn "ERROR: outpath already exists"
+                  ExitFailure n -> do -- impossible
+                    print n
+                    pure ()
+                  _ -> pure () -- all good
+
+      putTextLn "still here!"
       setJobStatus done jobOrg jobRef $
-        Linted res rev
+        Linted (shrinkDirResult res) rev
 
     cleanup workdir = do
       callgit gitdir [ "worktree", "remove", "-f", "-f", workdir ]
-- 
cgit v1.2.3