diff options
Diffstat (limited to 'server/Server.hs')
| -rw-r--r-- | server/Server.hs | 19 |
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 |