From 3a109e79363b52e22da35aaecf666014a75fcb63 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 7 Feb 2022 20:44:06 +0100
Subject: server: simple toml config

---
 config.toml      |  8 ++++++++
 package.yaml     |  1 +
 server/Main.hs   |  5 ++---
 server/Server.hs | 51 +++++++++++++++++++++++++++++++++++++--------------
 walint.cabal     |  1 +
 5 files changed, 49 insertions(+), 17 deletions(-)
 create mode 100644 config.toml

diff --git a/config.toml b/config.toml
new file mode 100644
index 0000000..94e189c
--- /dev/null
+++ b/config.toml
@@ -0,0 +1,8 @@
+
+
+port = 8080
+
+tmpdir = "/tmp"
+entrypoint = "main.json"
+lintconfig = "./config.json"
+
diff --git a/package.yaml b/package.yaml
index 7208cd9..a4681bc 100644
--- a/package.yaml
+++ b/package.yaml
@@ -73,3 +73,4 @@ executables:
       - containers
       - microlens
       - microlens-th
+      - tomland
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
diff --git a/walint.cabal b/walint.cabal
index 9846e7a..ab3c5c5 100644
--- a/walint.cabal
+++ b/walint.cabal
@@ -88,6 +88,7 @@ executable server
     , string-conversions
     , text
     , time
+    , tomland
     , uuid
     , wai
     , walint
-- 
cgit v1.2.3