diff options
Diffstat (limited to '')
| -rw-r--r-- | server/Server.hs | 27 |
1 files changed, 22 insertions, 5 deletions
diff --git a/server/Server.hs b/server/Server.hs index 41e5bde..93bfb30 100644 --- a/server/Server.hs +++ b/server/Server.hs @@ -3,12 +3,13 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} -module Server (loadConfig, Config(..), RemoteRef(..), State, JobStatus(..), - setJobStatus) where +module Server (loadConfig, Config(..), RemoteRef(..), State, registry, jobs, JobStatus(..), + setJobStatus,defaultState,setRegistry) where import CheckDir (DirResult) import Control.Concurrent (MVar, modifyMVar_) @@ -17,9 +18,13 @@ import qualified Data.ByteString.Lazy as LB import Data.Map (Map) import qualified Data.Map as M import Data.Text (Text) +import Data.UUID (UUID) import GHC.Generics (Generic) +import Lens.Micro (over) +import Lens.Micro.TH import LintConfig (LintConfig') + -- | a reference in a remote git repository data RemoteRef = RemoteRef { repourl :: Text @@ -44,7 +49,15 @@ data JobStatus = Pending | Linted DirResult | Failed Text deriving (Generic, ToJSON) -type State = Map RemoteRef JobStatus +data State = State + { _jobs :: Map RemoteRef JobStatus + , _registry :: Map UUID RemoteRef + } + +makeLenses ''State + +defaultState :: State +defaultState = State mempty mempty loadConfig :: Config False -> IO (Config True) @@ -57,5 +70,9 @@ loadConfig config = do setJobStatus :: MVar State -> RemoteRef -> JobStatus -> IO () -setJobStatus mvar ref status = modifyMVar_ mvar $ \state -> - pure $ M.insert ref status state +setJobStatus mvar ref status = modifyMVar_ mvar + $ pure . over jobs (M.insert ref status) + +setRegistry :: MVar State -> UUID -> RemoteRef -> IO () +setRegistry mvar uuid ref = modifyMVar_ mvar + $ pure . over registry (M.insert uuid ref) |