1 files changed, 54 insertions, 0 deletions
diff --git a/src/Settlr/Config.hs b/src/Settlr/Config.hs
new file mode 100644
index 0000000..1e2ff09
--- /dev/null
+++ b/src/Settlr/Config.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleInstances #-}
+module Settlr.Config
+  ( ScriptM
+  , Config(..)
+  , ConfigException(..)
+  , loadConfig
+  , withConfig
+  ) where
+
+import Data.Text (Text)
+import qualified Data.Text as T
+import Network.CGI (getVarWithDefault, getVar, scriptName, CGIT, CGI)
+import Control.Exception (Exception)
+import Control.Monad.Catch (MonadThrow, throwM)
+import Control.Monad.Reader (ReaderT(runReaderT))
+import Network.CGI.Monad (MonadCGI(..))
+import Control.Monad.Trans (lift)
+
+type ScriptM = ReaderT Config (CGIT IO)
+
+instance MonadCGI ScriptM where
+  cgiAddHeader x y = lift $ cgiAddHeader x y
+  cgiGet x = lift $ cgiGet x
+
+data Config = Config
+  { cfgCssPath    :: !Text -- ^ $SETTLR_CSS_PATH, defaults to "/settlr.css"
+  , cfgScriptPath :: !Text -- ^ $SETTLR_SCRIPT_PATH, defaults to the CGI variable $SCRIPT_PATH or "/"
+  , cfgDataPath   :: !Text -- ^ $SETTLR_DATA_PATH, required
+  }
+
+data ConfigException
+  = CfgDataPathNotSet
+
+instance Show ConfigException where
+  show CfgDataPathNotSet = "Server misconfiguration: Required environment variable SETTLR_DATA_PATH not set."
+
+instance Exception ConfigException
+
+loadConfig :: MonadCGI m => MonadThrow m => m Config
+loadConfig = do cssPath     <- getVarWithDefault "SETTLR_CSS_PATH" "/settlr.css"
+                scriptPath' <- scriptName
+                scriptPath  <- getVarWithDefault "SETTLR_SCRIPT_PATH" scriptPath'
+                dataPath    <- getVar "SETTLR_DATA_PATH" >>= \case
+                                 Nothing -> throwM CfgDataPathNotSet
+                                 Just x  -> pure x
+                pure $ Config { cfgCssPath    = T.pack cssPath
+                              , cfgScriptPath = T.pack scriptPath
+                              , cfgDataPath   = T.pack dataPath
+                              }
+
+withConfig :: ScriptM a -> CGI a
+withConfig x = loadConfig >>= runReaderT x