From ad7343815cc89d34c68f7d38239882bd3d36a577 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sun, 6 Mar 2022 08:02:30 +0100
Subject: server: add a very simple relint button

---
 server/Server.hs | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

(limited to 'server/Server.hs')

diff --git a/server/Server.hs b/server/Server.hs
index 46a1c8c..97f87ee 100644
--- a/server/Server.hs
+++ b/server/Server.hs
@@ -179,7 +179,7 @@ instance TS.Show JobStatus where
 -- | the server's global state; might eventually end up with more
 -- stuff in here, hence the newtype
 newtype ServerState = ServerState
-  { _unState :: Map (Org True) (Map Sha1 (RemoteRef, JobStatus)) }
+  { _unState :: Map Text (Org True, Map Sha1 (RemoteRef, JobStatus)) }
   deriving Generic
 
 instance NFData LintConfig' => NFData ServerState
@@ -190,7 +190,7 @@ makeLenses ''ServerState
 -- will default to a noop otherwise
 emptyState :: Config True -> ServerState
 emptyState config = ServerState
-  $ M.fromList $ map (, mempty) (view orgs config)
+  $ M.fromList $ map (\org -> (orgSlug org, (org, mempty))) (view orgs config)
 
 -- | loads a config, along with all things linked in it
 -- (e.g. linterconfigs for each org)
@@ -216,13 +216,18 @@ setJobStatus mvar !org !ref !status = do
     -- will otherwise cause a thunk leak, since Data.Map is annoyingly un-strict
     -- even in its strict variety. for some reason it also doesn't work when
     -- moved inside the `over` though …
-    _ <- evaluateNF (view (unState . ix org) state)
-    pure $ over (unState . ix org . at (toSha ref))
+    _ <- evaluateNF (view (unState . ix (orgSlug org) . _2) state)
+    pure $ over (unState . ix (orgSlug org) . _2 .  at (toSha ref))
                 (const $ Just (ref, status)) state
 
-getJobStatus :: MVar ServerState -> Text -> Sha1 -> IO (Maybe (RemoteRef, JobStatus))
-getJobStatus mvar orgslug sha = withMVar mvar $ \state ->
-  pure (M.lookup sha (view (unState . ix (Org { orgSlug = orgslug })) state))
+getJobStatus :: MVar ServerState -> Text -> Sha1 -> IO (Maybe (Org True, RemoteRef, JobStatus))
+getJobStatus mvar orgslug sha = withMVar mvar $ \state -> pure $ do
+  (org, jobs) <- view (unState . at orgslug) state
+  (ref, status) <- M.lookup sha jobs
+  Just (org, ref, status)
+    -- pure $ second (M.lookup sha) orgIndex
+  -- pure (M.lookup sha (view (unState . ix orgslug) state))
+
 
 -- | the path (relative to a baseurl / webdir) where an adjusted
 -- map should go
-- 
cgit v1.2.3