module Control.Flipper.Adapters.Postgres
( Config(..)
, FlipperT(..)
, runFlipperT
, module Control.Flipper
) where
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader
import Control.Monad.Trans (MonadTrans)
import qualified Data.Map.Strict as Map
import Database.Persist.Postgresql (ConnectionPool)
import Control.Flipper.Adapters.Postgres.DBAccess (DBAccess, db)
import qualified Control.Flipper.Adapters.Postgres.Query as Q
import Control.Flipper.Types (FeatureName,
Features (..),
HasFeatureFlags (..),
ModifiesFeatureFlags (..))
import Control.Flipper
newtype FlipperT m a = FlipperT { unFlipper :: ReaderT Config m a }
deriving ( Functor
, Applicative
, Monad
, MonadIO
, MonadReader Config
, MonadTrans
)
instance (MonadIO m) => HasFeatureFlags (FlipperT m) where
getFeatures = ask >>= \Config{..} -> Q.getFeatures appDB
getFeature name = ask >>= \Config{..} -> Q.getFeatureByName name appDB
instance (MonadIO m) => ModifiesFeatureFlags (FlipperT m) where
updateFeatures features =
void $ Map.traverseWithKey updateFeature (unFeatures features)
updateFeature _ feature = ask >>= \Config{..} ->
Q.upsertFeature feature appDB
runFlipperT :: (MonadIO m)
=> ConnectionPool -> FlipperT m a -> m a
runFlipperT pool f =
let cfg = Config pool (db pool)
in runReaderT (unFlipper f) cfg
data Config = forall m. (Monad m) => Config
{ appDBConn :: ConnectionPool
, appDB :: DBAccess m
}