summaryrefslogtreecommitdiff
path: root/server/Server.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--server/Server.hs19
1 files changed, 12 insertions, 7 deletions
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