bein-0.3: Bein/Configuration.hs

{-# LANGUAGE FlexibleContexts #-}
module Bein.Configuration where

import Database.HDBC
    ( SqlValue,
      fromSql,
      toSql,
      Statement(execute, fetchRow),
      IConnection(prepare) )
import Control.Exception ()
import Data.Convertible ( Convertible )
import System.Posix.Syslog ()
import Bein.Types ( Configuration(..) )

readConfiguration :: IConnection c => c -> IO Configuration
readConfiguration conn = do
  stmt <- prepare conn "select value from configuration where key = ?"
  vfile_repository <- readKey stmt "file_repository"
  vscratch_directory <- readKey stmt "scratch_directory"
  vperl_executable <- readKey stmt "perl_executable"
  vr_executable <- readKey stmt "r_executable"
  vmax_executions <- readKey stmt "max_executions"
  vminion_command <- readKey stmt "minion_command"
  vdaemon_port <- readKey stmt "daemon_port"
  vminion_port <- readKey stmt "minion_port"
  vhttp_port <- readKey stmt "http_port"
  vhttp_base_url <- readKey stmt "http_base_url"
  vauthentication <- readKey stmt "authentication"
  vtemplate_path <- readKey stmt "template_path"
  vstatic_content_directory <- readKey stmt "static_content_directory"
  return $ Configuration {
    file_repository = vfile_repository,
    scratch_directory = vscratch_directory,
    static_content_directory = vstatic_content_directory,
    perl_executable = vperl_executable,
    r_executable = vr_executable,
    max_executions = vmax_executions,
    minion_command = vminion_command,
    daemon_port = vdaemon_port,
    minion_port = vminion_port,
    http_port = vhttp_port,
    http_base_url = vhttp_base_url, 
    template_path = vtemplate_path,
    authentication = vauthentication }
          
readKey :: Convertible SqlValue a => Statement -> String -> IO a  
readKey stmt k = do
  _ <- execute stmt [toSql k]
  fetchRow stmt >>= \v -> case v of
    Nothing -> error  $ "No value for parameter " ++ k
    Just [val] -> return $ fromSql val
    Just _ -> error "Received multiple fields from database when reading configuration key.  Your database schema is wrong."