summaryrefslogtreecommitdiff
path: root/server
diff options
context:
space:
mode:
authorstuebinm2022-02-07 20:44:06 +0100
committerstuebinm2022-02-07 20:44:06 +0100
commit3a109e79363b52e22da35aaecf666014a75fcb63 (patch)
treee9750fe27fcd004f16054dfd4704283785888578 /server
parent729a1983372ed23ec0ceeeb1acdadc6e6989b37a (diff)
server: simple toml config
Diffstat (limited to 'server')
-rw-r--r--server/Main.hs5
-rw-r--r--server/Server.hs51
2 files changed, 39 insertions, 17 deletions
diff --git a/server/Main.hs b/server/Main.hs
index ecaf6b7..0fbc4b4 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -71,7 +71,6 @@ app config =
main :: IO ()
main = do
+ config' <- loadConfig "./config.toml"
state <- newMVar defaultState
- let config = Config "/tmp" 8080 "main.json" "./config.json"
- config' <- loadConfig config
- run (port config) (app config' state)
+ run (port config') (app config' state)
diff --git a/server/Server.hs b/server/Server.hs
index 93bfb30..a5a820a 100644
--- a/server/Server.hs
+++ b/server/Server.hs
@@ -1,12 +1,16 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE KindSignatures #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
module Server (loadConfig, Config(..), RemoteRef(..), State, registry, jobs, JobStatus(..),
setJobStatus,defaultState,setRegistry) where
@@ -23,6 +27,10 @@ import GHC.Generics (Generic)
import Lens.Micro (over)
import Lens.Micro.TH
import LintConfig (LintConfig')
+import System.Exit.Compat (exitFailure)
+import Toml (TomlCodec)
+import qualified Toml
+import Toml.Codec ((.=))
-- | a reference in a remote git repository
@@ -36,14 +44,21 @@ type family ConfigRes (b :: Bool) a where
ConfigRes False a = FilePath
-- | the server's configuration
-data Config l = Config
+data Config (loaded :: Bool) = Config
{ tmpdir :: FilePath
-- ^ dir to clone git things in
, port :: Int
-- ^ port to bind to
, entrypoint :: FilePath
- , lintconfig :: ConfigRes l LintConfig'
- }
+ , lintconfig :: ConfigRes loaded LintConfig'
+ } deriving Generic
+
+configCodec :: TomlCodec (Config False)
+configCodec = Config
+ <$> Toml.string "tmpdir" .= tmpdir
+ <*> Toml.int "port" .= port
+ <*> Toml.string "entrypoint" .= entrypoint
+ <*> Toml.string "lintconfig" .= lintconfig
data JobStatus =
Pending | Linted DirResult | Failed Text
@@ -59,9 +74,17 @@ makeLenses ''State
defaultState :: State
defaultState = State mempty mempty
+loadConfig :: FilePath -> IO (Config True)
+loadConfig path = do
+ res <- Toml.decodeFileEither configCodec path
+ case res of
+ Right config -> loadConfig' config
+ Left err -> do
+ print err
+ exitFailure
-loadConfig :: Config False -> IO (Config True)
-loadConfig config = do
+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