redone backend handling and config parsing

app/Config.hs

@@ -1,6 +1,9 @@
 {-# LANGUAGE OverloadedStrings #-}
-module Config(Configuration(..),forkBackend,withConfigs,forkWithConfigs) where
-  
+module Config(forkBackend,withConfigs,forkWithConfigs,ConfigM,configM,getConfigM,setConfigM) where
+
+import Data.Semigroup
+
+
 import Toml (TomlCodec, (.=))
 import qualified Toml
 import System.IO
@@ -8,138 +11,26 @@ import qualified Data.Text as T
 import Control.Concurrent.MVar
 import Control.Concurrent
 import WaiApp
+import Data.Maybe(fromJust)
+import Data.Coerce
 
--- this module should handle everything connected to our TOML config
-#if defined(HTTP_SUPPORT) || defined(HTTPS_SUPPORT)
-import Data.String
-import qualified Network.Wai.Handler.Warp as HTTP
-#endif
 
-#ifdef HTTPS_SUPPORT
-import qualified Network.Wai.Handler.WarpTLS as HTTPS
-#endif
+-- This Type is here to replace Toml.Codec.Monoid.First as the First Monoid
+-- will be replaced with Maybe First with the First Semigroup
+type ConfigM a = Maybe (First a)
 
-data Configuration = Configuration
-  { cppDummy :: () -- this is a hack to get around the , rules of haskell records and the preprocessor
-#ifdef HTTP_SUPPORT
-  , httpConf :: [HttpConfiguration]
-#endif
-#ifdef HTTPS_SUPPORT
-  , httpsConf :: [(HttpConfiguration,HttpsConfiguration)]
-#endif
-#ifdef FASTCGI_SUPPORT
-  , fastCgiConf :: [FastCgiConfiguration]
-#endif
-#ifdef CGI_SUPPORT
-  , cgiConf :: [CgiConfiguration]
-#endif
-  }
+-- WARNING this function IS NOT total be sure the option is given!
+getConfigM :: ConfigM a -> a
+getConfigM = coerce . fromJust
 
-#if defined(HTTP_SUPPORT) || defined(HTTPS_SUPPORT)
--- We leave it as a Text here and defer the conversion to the warp type to the last possible moment.
--- At least we can touch and print a String. Excepet that we don't use it so we don't need it in another
--- form
-type BindPreference = String
+setConfigM :: a -> ConfigM a
+setConfigM = Just . coerce
 
-_BindPreference :: Toml.TomlBiMap BindPreference Toml.AnyValue
-_BindPreference = Toml._String
-
-bindPreference :: Toml.Key -> TomlCodec BindPreference
-bindPreference = Toml.match _BindPreference
-
-data HttpConfiguration = HttpConfiguration
-  { port :: Int
-  , bindPref :: BindPreference
-  }
-httpDefaultSettings :: HttpConfiguration
-httpDefaultSettings = HttpConfiguration 80 "*"
-#endif
-
-#ifdef HTTPS_SUPPORT
-data HttpsConfiguration = HttpsConfiguration
-  { certFile :: FilePath
-  , certChain :: [FilePath]
-  , keyFile :: FilePath
-  }
-httpsDefaultSettings :: HttpsConfiguration
-httpsDefaultSettings = HttpsConfiguration "certificate.pem" [] "key.pem"
-#endif
-
-#ifdef FASTCGI_SUPPORT
-data FastCgiConfiguration = FastCgiConfiguration
-#endif
-
-#ifdef CGI_SUPPORT
-data CgiConfiguration = CgiConfiguration
-#endif
-
-defaultConfiguration :: Configuration
-defaultConfiguration = Configuration ()
-#ifdef HTTP_SUPPORT
-  [httpDefaultSettings]
-#endif
-#ifdef HTTPS_SUPPORT
-  [(httpDefaultSettings,httpsDefaultSettings)]
-#endif
-#ifdef FASTCGI_SUPPORT
-  [FastCgiConfiguration]
-#endif
-#ifdef CGI_SUPPORT
-  [CgiConfiguration]
-#endif
-
-#if defined(HTTP_SUPPORT) || defined(HTTPS_SUPPORT)
--- why a String? Why is the only way to generate a HostPreference by its IsString instance?
--- why does warp not expose its constructors??
-httpConfigConstructor :: Int -> String -> HTTP.Settings
-httpConfigConstructor port bind = HTTP.setPort port $ HTTP.setHost (fromString bind) HTTP.defaultSettings
-httpConfigCodec :: TomlCodec HttpConfiguration
-httpConfigCodec = HttpConfiguration
-  <$> Toml.int "Port"       .= port
-  <*> bindPreference "Bind" .= bindPref
-#endif
-
-#ifdef HTTPS_SUPPORT
-httpsConfigCodec :: TomlCodec (HttpConfiguration,HttpsConfiguration)
-httpsConfigCodec = Toml.pair httpConfigCodec httpsConfigCodec'
-
-httpsConfigCodec' :: TomlCodec HttpsConfiguration
-httpsConfigCodec' = HttpsConfiguration
--- the hardcoded strings are a bloody hack, but we can't extract the values back out of a config (they are there
--- warp just doesn't export the neccesarry types). So we hardcode default values, which is kind of realy bad, but
--- we don't need it in our usecase
-  <$> Toml.string "Certificate"             .= certFile
-  <*> Toml.arrayOf Toml._String "CertChain" .= certChain
-  <*> Toml.string "KeyFile"                 .= keyFile
-#endif
-
-#ifdef FASTCGI_SUPPORT
-fastCgiConfigCodec :: TomlCodec FastCgiConfiguration
-fastCgiConfigCodec = pure FastCgiConfiguration
-#endif
-
-#ifdef CGI_SUPPORT
-cgiConfigCodec :: TomlCodec CgiConfiguration
-cgiConfigCodec = pure CgiConfiguration
-#endif
-
-configurationCodec :: TomlCodec Configuration
-configurationCodec = pure (Configuration ())
-#ifdef HTTP_SUPPORT
-  <*> Toml.list httpConfigCodec "http" .= httpConf
-#endif
-#ifdef HTTPS_SUPPORT
-  <*> Toml.list httpsConfigCodec "https" .= httpsConf
-#endif
-#ifdef FASTCGI_SUPPORT
-  <*> Toml.list fastCgiConfigCodec "fast-cgi" .= fastCgiConf
-#endif
-#ifdef CGI_SUPPORT
-  <*> Toml.list cgiConfigCodec "cgi" .= cgiConf
-#endif
+configM :: (Toml.Key -> TomlCodec a) -> Toml.Key -> TomlCodec (ConfigM a)
+configM codec = Toml.diwrap . Toml.dioptional . codec
 
 forkWithConfigs :: (a -> IO ()) -> TomlCodec [a] -> FilePath -> IO [MVar ()]
-forkWithConfigs f = withConfigs (\conf -> forkBackend $ f conf)
+forkWithConfigs f = withConfigs (forkBackend . f)
 
 withConfigs :: (a -> IO (MVar ())) -> TomlCodec [a] -> FilePath -> IO [MVar ()]
 withConfigs f codec configFile = do