non-blocking server

1 files changed, 20 insertions, 4 deletions

diff --git a/server/Serverconfig.hs b/server/Server.hs
index d919567..41e5bde 100644
--- a/server/Serverconfig.hs
+++ b/server/Server.hs
@@ -2,16 +2,20 @@
 {-# LANGUAGE DeriveAnyClass      #-}
 {-# LANGUAGE DeriveGeneric       #-}
 {-# LANGUAGE KindSignatures      #-}
-{-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications    #-}
 {-# LANGUAGE TypeFamilies        #-}
 {-# LANGUAGE TypeOperators       #-}
 
-module Serverconfig (loadConfig, Config(..), RemoteRef(..)) where
+module Server (loadConfig, Config(..), RemoteRef(..), State, JobStatus(..),
+                    setJobStatus) where
 
-import           Data.Aeson           (FromJSON, eitherDecode)
+import           CheckDir             (DirResult)
+import           Control.Concurrent   (MVar, modifyMVar_)
+import           Data.Aeson           (FromJSON, ToJSON, eitherDecode)
 import qualified Data.ByteString.Lazy as LB
+import           Data.Map             (Map)
+import qualified Data.Map             as M
 import           Data.Text            (Text)
 import           GHC.Generics         (Generic)
 import           LintConfig           (LintConfig')
@@ -20,7 +24,7 @@ import           LintConfig           (LintConfig')
 data RemoteRef = RemoteRef
   { repourl :: Text
   , reporef :: Text
-  } deriving (Generic, FromJSON)
+  } deriving (Generic, FromJSON, Eq, Ord)
 
 type family ConfigRes (b :: Bool) a where
   ConfigRes True a = a
@@ -36,6 +40,13 @@ data Config l = Config
   , lintconfig :: ConfigRes l LintConfig'
   }
 
+data JobStatus =
+  Pending | Linted DirResult | Failed Text
+  deriving (Generic, ToJSON)
+
+type State = Map RemoteRef JobStatus
+
+
 loadConfig :: Config False -> IO (Config True)
 loadConfig config = do
   loaded <- LB.readFile (lintconfig config) >>= \res ->
@@ -43,3 +54,8 @@ loadConfig config = do
         Left err   -> error $ "config file invalid: " <> err
         Right file -> pure file
   pure $ config { lintconfig = loaded }
+
+
+setJobStatus :: MVar State -> RemoteRef -> JobStatus -> IO ()
+setJobStatus mvar ref status = modifyMVar_ mvar $ \state ->
+  pure $ M.insert ref status state