Model.hs

{-# OPTIONS -Wall #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

-- | Model running.

module Snap.App.Model
  (model
  ,query
  ,single
  ,singleNoParams
  ,queryNoParams
  ,exec
  ,DB.Only(..))
  where

import           Control.Monad.Env                       (env)

import           Control.Monad.Reader
import           Data.String
import           Database.PostgreSQL.Simple              (Only(..))
import qualified Database.PostgreSQL.Simple              as DB
import           Database.PostgreSQL.Simple.QueryParams
import           Database.PostgreSQL.Simple.QueryResults
import           Snap.App.Types

-- | Run a model action.
model :: AppLiftModel c s => Model c s a -> Controller c s a
model = liftModel

-- | Query with some parameters.
query :: (QueryParams ps,QueryResults r) => [String] -> ps -> Model c s [r]
query q ps = do
  conn <- env modelStateConn
  Model $ ReaderT (\_ -> DB.query conn (fromString (unlines q)) ps)

-- | Query a single field from a single result.
single :: (QueryParams ps,QueryResults (Only r)) => [String] -> ps -> Model c s (Maybe r)
single q ps = do
  rows <- query q ps
  case rows of
    [(Only r)] -> return (Just r)
    _          -> return Nothing

-- | Query a single field from a single result (no params).
singleNoParams :: (QueryResults (Only r)) => [String] -> Model c s (Maybe r)
singleNoParams q = do
  rows <- queryNoParams q
  case rows of
    [(Only r)] -> return (Just r)
    _          -> return Nothing

-- | Query with no parameters.
queryNoParams :: (QueryResults r) => [String] -> Model c s [r]
queryNoParams q = do
  conn <- env modelStateConn
  Model $ ReaderT (\_ -> DB.query_ conn (fromString (unlines q)))

-- | Execute some SQL returning the rows affected.
exec :: (QueryParams ps) => [String] -> ps -> Model c s Integer
exec q ps = do
  conn <- env modelStateConn
  Model $ ReaderT (\_ -> DB.execute conn (fromString (unlines q)) ps)