From c69c90f3d12d088eb60cf6da66c7cc473d399abf Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Tue, 15 Feb 2022 22:28:24 +0100
Subject: server: switch to universum prelude, some cleanup

it's slightly less of a mess than it was before
---
 server/Server.hs | 40 ++++++++++++++++++++++------------------
 1 file changed, 22 insertions(+), 18 deletions(-)

(limited to 'server/Server.hs')

diff --git a/server/Server.hs b/server/Server.hs
index d7205bc..8014053 100644
--- a/server/Server.hs
+++ b/server/Server.hs
@@ -5,7 +5,6 @@
 {-# LANGUAGE DerivingStrategies         #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE KindSignatures             #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE TemplateHaskell            #-}
@@ -13,25 +12,28 @@
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE TypeOperators              #-}
 
-module Server (loadConfig, Config(..), RemoteRef(..), State, registry, jobs, JobStatus(..),
-                    setJobStatus,defaultState,setRegistry, AdminOverview(..)) where
+module Server ( loadConfig
+              , Config(..)
+              , RemoteRef(..)
+              , ServerState, registry, jobs, defaultState
+              , JobStatus(..)
+              , setJobStatus
+              , setRegistry
+              , AdminOverview(..)
+              ) where
+
+import           Universum
 
 import           CheckDir             (DirResult)
-import           Control.Concurrent   (MVar, modifyMVar_)
+import           Control.Concurrent   (modifyMVar_)
 import           Data.Aeson           (FromJSON, ToJSON (toJSON), eitherDecode,
                                        (.=))
 import qualified Data.Aeson           as A
 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.Extras    (view)
 import           Lens.Micro.TH
 import           LintConfig           (LintConfig')
-import           System.Exit.Compat   (exitFailure)
 import           Toml                 (TomlCodec)
 import qualified Toml                 as T
 
@@ -50,6 +52,7 @@ data Config (loaded :: Bool) = Config
   { tmpdir     :: FilePath
   -- ^ dir to clone git things in
   , port       :: Int
+  , verbose    :: Bool
   -- ^ port to bind to
   , entrypoint :: FilePath
   , lintconfig :: ConfigRes loaded LintConfig'
@@ -59,6 +62,7 @@ configCodec :: TomlCodec (Config False)
 configCodec = Config
     <$> T.string "tmpdir" T..= tmpdir
     <*> T.int "port" T..= port
+    <*> T.bool "verbose" T..= verbose
     <*> T.string "entrypoint" T..= entrypoint
     <*> T.string "lintconfig" T..= lintconfig
 
@@ -68,17 +72,17 @@ data JobStatus =
   deriving (Generic, ToJSON)
 
 -- | the server's global state
-data State = State
+data ServerState = ServerState
   { _jobs     :: Map RemoteRef JobStatus
   , _registry :: Map UUID RemoteRef
   }
-makeLenses ''State
+makeLenses ''ServerState
 
-defaultState :: State
-defaultState = State mempty mempty
+defaultState :: ServerState
+defaultState = ServerState mempty mempty
 
 newtype AdminOverview =
-  AdminOverview { unAdminOverview :: State }
+  AdminOverview { unAdminOverview :: ServerState }
 
 instance ToJSON AdminOverview where
   toJSON (AdminOverview state) =
@@ -103,15 +107,15 @@ loadConfig' :: Config False -> IO (Config True)
 loadConfig' config = do
   loaded <- LB.readFile (lintconfig config) >>= \res ->
       case eitherDecode res :: Either String LintConfig' of
-        Left err   -> error $ "config file invalid: " <> err
+        Left err   -> error $ "config file invalid: " <> show err
         Right file -> pure file
   pure $ config { lintconfig = loaded }
 
 
-setJobStatus :: MVar State -> RemoteRef -> JobStatus -> IO ()
+setJobStatus :: MVar ServerState -> RemoteRef -> JobStatus -> IO ()
 setJobStatus mvar !ref !status = modifyMVar_ mvar
   $ pure . over jobs (M.insert ref status)
 
-setRegistry :: MVar State -> UUID -> RemoteRef -> IO ()
+setRegistry :: MVar ServerState -> UUID -> RemoteRef -> IO ()
 setRegistry mvar !uuid !ref = modifyMVar_ mvar
   $ pure . over registry (M.insert uuid ref)
-- 
cgit v1.2.3