{-# 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