module Snap.App.Model
(model
,runDB
,query
,single
,singleNoParams
,queryNoParams
,processQuery
,queryProcessed
,exec
,DB.Only(..))
where
import Control.Monad.Env (env)
import Control.Monad.Reader
import Data.String
import Database.PostgreSQL.Base (withPoolConnection,withTransaction)
import Database.PostgreSQL.Simple (Only(..),ProcessedQuery,Query)
import qualified Database.PostgreSQL.Simple as DB
import Database.PostgreSQL.Simple (Pool)
import Database.PostgreSQL.Simple.QueryParams
import Database.PostgreSQL.Simple.QueryResults
import Snap.App.Types
runDB :: s -> c -> Pool -> Model c s () -> IO ()
runDB st conf pool mdl = do
withPoolConnection pool $ \conn -> do
withTransaction conn $ do
let state = ModelState conn st conf
runReaderT (runModel mdl) state
model :: AppLiftModel c s => Model c s a -> Controller c s a
model = liftModel
queryProcessed :: (QueryResults r) => ProcessedQuery r -> Model c s [r]
queryProcessed pq = do
conn <- env modelStateConn
Model $ ReaderT (\_ -> DB.queryProcessed conn pq)
processQuery :: (QueryParams q,QueryResults r) => Query -> q -> Model c s (ProcessedQuery r)
processQuery template qs = do
Model $ ReaderT (\_ -> DB.processQuery template qs)
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)
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
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
queryNoParams :: (QueryResults r) => [String] -> Model c s [r]
queryNoParams q = do
conn <- env modelStateConn
Model $ ReaderT (\_ -> DB.query_ conn (fromString (unlines q)))
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)