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