Beam.hs

{-# LANGUAGE GeneralizedNewtypeDeriving, CPP #-}
{-|
Description: 

-}
module TsWeb.Db.Beam
  ( module Database.Beam
  , RoPg(..)
  , ReadOnlyM(..)
  , Sel
  ) where

import qualified Database.Beam as Beam

import Database.Beam hiding (runSelectReturningList, runSelectReturningOne)
#if MIN_VERSION_beam_core(0, 8, 0)
import Database.Beam.Postgres (Pg, Postgres)
#else
import Database.Beam.Postgres (Pg, Postgres, PgSelectSyntax)
#endif

-- | Type alias to handle the beam 0.7 - 0.8 API change that replaced
-- PgSelectSyntax with just plain Postgres.
#if MIN_VERSION_beam_core(0, 8, 0)
type Sel a = SqlSelect Postgres a
#else
type Sel a = SqlSelect PgSelectSyntax a
#endif

-- | class of read-only Beam operations - this has one obvious instance in
-- 'Database.Beam.Postgres.Pg' itself, plus it lets us create a read-only alias
-- in order to restrict views to only reading from the database pool (where
-- appropriate).
class ReadOnlyM m where
  runSelectReturningOne ::
       FromBackendRow Postgres a => Sel a -> m (Maybe a)
  runSelectReturningList ::
       FromBackendRow Postgres a => Sel a -> m [a]

instance ReadOnlyM Pg where
  runSelectReturningOne = Beam.runSelectReturningOne
  runSelectReturningList = Beam.runSelectReturningList

-- | newtype wrapper around 'Database.Beam.Postgres.Pg' that only exports
-- read-only operations (currently runSelectReturningOne and
-- runSelectReturningList).
newtype RoPg a = RoPg
  { _fromRoPg :: Pg a
  } deriving (Functor, Applicative, Monad)

instance ReadOnlyM RoPg where
  runSelectReturningOne = RoPg . Beam.runSelectReturningOne
  runSelectReturningList = RoPg . Beam.runSelectReturningList