src/Settlr/Config.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}

module Settlr.Config
  ( Config(..)
  , ConfigException(..)
  , loadConfig
  ) where

import Data.Text (Text)
import qualified Data.Text as T
import Network.CGI (getVarWithDefault, getVar, scriptName)
import Control.Exception (Exception)
import Control.Monad.Catch (MonadThrow, throwM)
import Network.CGI.Monad (MonadCGI(..))

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
                              }