{-# LANGUAGE TemplateHaskell #-}

module Effectful.Opaleye
  ( -- * Effect
    Opaleye (..)

    -- * Effectful functions

    -- ** Select
  , runSelect
  , runSelectI
  , runSelectExplicit

    -- ** Select-fold
  , runSelectFold
  , runSelectFoldExplicit

    -- ** Insert
  , runInsert

    -- ** Delete
  , runDelete

    -- ** Update
  , runUpdate

    -- * Interpreters
  , runOpaleyeWithConnection
  , runOpaleyeConnection
  )
where

import Data.Profunctor.Product.Default
import qualified Database.PostgreSQL.Simple as PSQL
import Effectful
import Effectful.Dispatch.Dynamic
import qualified Effectful.PostgreSQL.Connection as Conn
import Effectful.TH
import qualified Opaleye as O
import qualified Opaleye.Internal.Inferrable as O

-- | A dynamic effect to perform @opaleye@ operations.
data Opaleye :: Effect where
  -- | Lifted 'O.RunSelectExplicit'.
  RunSelectExplicit :: O.FromFields fields haskells -> O.Select fields -> Opaleye m [haskells]
  -- | Lifted 'O.RunSelectFoldExplicit'.
  RunSelectFoldExplicit ::
    O.FromFields fields haskells ->
    O.Select fields ->
    b ->
    (b -> haskells -> m b) ->
    Opaleye m b
  -- | Lifted 'O.RunInsert'.
  RunInsert :: O.Insert haskells -> Opaleye m haskells
  -- | Lifted 'O.RunDelete'.
  RunDelete :: O.Delete haskells -> Opaleye m haskells
  -- | Lifted 'O.RunUpdate'.
  RunUpdate :: O.Update haskells -> Opaleye m haskells

makeEffect ''Opaleye

-- | Lifted 'O.runSelect'.
runSelect ::
  (HasCallStack, Opaleye :> es, Default O.FromFields fields haskells) =>
  O.Select fields ->
  Eff es [haskells]
runSelect :: forall (es :: [Effect]) fields haskells.
(HasCallStack, Opaleye :> es,
 Default FromFields fields haskells) =>
Select fields -> Eff es [haskells]
runSelect = FromFields fields haskells -> Select fields -> Eff es [haskells]
forall fields haskells (es :: [Effect]).
(HasCallStack, Opaleye :> es) =>
FromFields fields haskells -> Select fields -> Eff es [haskells]
runSelectExplicit FromFields fields haskells
forall (p :: * -> * -> *) a b. Default p a b => p a b
def

-- | Lifted 'O.runSelectFold'.
runSelectFold ::
  (HasCallStack, Opaleye :> es, Default O.FromFields fields haskells) =>
  O.Select fields ->
  b ->
  (b -> haskells -> Eff es b) ->
  Eff es b
runSelectFold :: forall (es :: [Effect]) fields haskells b.
(HasCallStack, Opaleye :> es,
 Default FromFields fields haskells) =>
Select fields -> b -> (b -> haskells -> Eff es b) -> Eff es b
runSelectFold = FromFields fields haskells
-> Select fields -> b -> (b -> haskells -> Eff es b) -> Eff es b
forall fields haskells b (es :: [Effect]).
(HasCallStack, Opaleye :> es) =>
FromFields fields haskells
-> Select fields -> b -> (b -> haskells -> Eff es b) -> Eff es b
runSelectFoldExplicit FromFields fields haskells
forall (p :: * -> * -> *) a b. Default p a b => p a b
def

-- | Lifted 'O.runSelectI'.
runSelectI ::
  (HasCallStack, Opaleye :> es, Default (O.Inferrable O.FromFields) fields haskells) =>
  O.Select fields ->
  Eff es [haskells]
runSelectI :: forall (es :: [Effect]) fields haskells.
(HasCallStack, Opaleye :> es,
 Default (Inferrable FromFields) fields haskells) =>
Select fields -> Eff es [haskells]
runSelectI = FromFields fields haskells -> Select fields -> Eff es [haskells]
forall fields haskells (es :: [Effect]).
(HasCallStack, Opaleye :> es) =>
FromFields fields haskells -> Select fields -> Eff es [haskells]
runSelectExplicit (Inferrable FromFields fields haskells -> FromFields fields haskells
forall (p :: * -> * -> *) a b. Inferrable p a b -> p a b
O.runInferrable Inferrable FromFields fields haskells
forall (p :: * -> * -> *) a b. Default p a b => p a b
def)

-- | Lifted 'O.runOpaleyeWithConnection'.
runOpaleyeWithConnection ::
  (HasCallStack, Conn.WithConnection :> es, IOE :> es) =>
  Eff (Opaleye : es) a ->
  Eff es a
runOpaleyeWithConnection :: forall (es :: [Effect]) a.
(HasCallStack, WithConnection :> es, IOE :> es) =>
Eff (Opaleye : es) a -> Eff es a
runOpaleyeWithConnection = EffectHandler Opaleye es -> Eff (Opaleye : es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret (EffectHandler Opaleye es -> Eff (Opaleye : es) a -> Eff es a)
-> EffectHandler Opaleye es -> Eff (Opaleye : es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs es
env -> \case
  RunSelectExplicit FromFields fields haskells
ff Select fields
sel -> (Connection -> Eff es a) -> Eff es a
forall a (es :: [Effect]).
(HasCallStack, WithConnection :> es) =>
(Connection -> Eff es a) -> Eff es a
Conn.withConnection ((Connection -> Eff es a) -> Eff es a)
-> (Connection -> Eff es a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ FromFields fields haskells
-> Connection -> Select fields -> IO [haskells]
forall fields haskells.
FromFields fields haskells
-> Connection -> Select fields -> IO [haskells]
O.runSelectExplicit FromFields fields haskells
ff Connection
conn Select fields
sel
  RunSelectFoldExplicit FromFields fields haskells
ff Select fields
sel a
initial a -> haskells -> Eff localEs a
foldFn ->
    (Connection -> Eff es a) -> Eff es a
forall a (es :: [Effect]).
(HasCallStack, WithConnection :> es) =>
(Connection -> Eff es a) -> Eff es a
Conn.withConnection ((Connection -> Eff es a) -> Eff es a)
-> (Connection -> Eff es a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Connection
conn ->
      LocalEnv localEs es
-> ((forall r. Eff localEs r -> IO r) -> IO a) -> Eff es a
forall (es :: [Effect]) (handlerEs :: [Effect])
       (localEs :: [Effect]) a.
(HasCallStack, SharedSuffix es handlerEs, IOE :> es) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> IO r) -> IO a) -> Eff es a
localSeqUnliftIO LocalEnv localEs es
env (((forall r. Eff localEs r -> IO r) -> IO a) -> Eff es a)
-> ((forall r. Eff localEs r -> IO r) -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> IO r
unlift ->
        IO a -> IO a
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ FromFields fields haskells
-> Connection
-> Select fields
-> a
-> (a -> haskells -> IO a)
-> IO a
forall fields haskells b.
FromFields fields haskells
-> Connection
-> Select fields
-> b
-> (b -> haskells -> IO b)
-> IO b
O.runSelectFoldExplicit FromFields fields haskells
ff Connection
conn Select fields
sel a
initial (\a
acc haskells
new -> Eff localEs a -> IO a
forall r. Eff localEs r -> IO r
unlift (Eff localEs a -> IO a) -> Eff localEs a -> IO a
forall a b. (a -> b) -> a -> b
$ a -> haskells -> Eff localEs a
foldFn a
acc haskells
new)
  RunInsert Insert a
sel -> (Connection -> Eff es a) -> Eff es a
forall a (es :: [Effect]).
(HasCallStack, WithConnection :> es) =>
(Connection -> Eff es a) -> Eff es a
Conn.withConnection ((Connection -> Eff es a) -> Eff es a)
-> (Connection -> Eff es a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Connection -> Insert a -> IO a
forall haskells. Connection -> Insert haskells -> IO haskells
O.runInsert Connection
conn Insert a
sel
  RunDelete Delete a
sel -> (Connection -> Eff es a) -> Eff es a
forall a (es :: [Effect]).
(HasCallStack, WithConnection :> es) =>
(Connection -> Eff es a) -> Eff es a
Conn.withConnection ((Connection -> Eff es a) -> Eff es a)
-> (Connection -> Eff es a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Connection -> Delete a -> IO a
forall haskells. Connection -> Delete haskells -> IO haskells
O.runDelete Connection
conn Delete a
sel
  RunUpdate Update a
sel -> (Connection -> Eff es a) -> Eff es a
forall a (es :: [Effect]).
(HasCallStack, WithConnection :> es) =>
(Connection -> Eff es a) -> Eff es a
Conn.withConnection ((Connection -> Eff es a) -> Eff es a)
-> (Connection -> Eff es a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Connection -> Update a -> IO a
forall haskells. Connection -> Update haskells -> IO haskells
O.runUpdate Connection
conn Update a
sel

-- | Lifted 'O.runOpaleyeConnection'.
runOpaleyeConnection ::
  (HasCallStack, IOE :> es) =>
  PSQL.Connection ->
  Eff (Opaleye : es) a ->
  Eff es a
runOpaleyeConnection :: forall (es :: [Effect]) a.
(HasCallStack, IOE :> es) =>
Connection -> Eff (Opaleye : es) a -> Eff es a
runOpaleyeConnection Connection
conn = EffectHandler Opaleye es -> Eff (Opaleye : es) a -> Eff es a
forall (e :: Effect) (es :: [Effect]) a.
(DispatchOf e ~ 'Dynamic) =>
EffectHandler e es -> Eff (e : es) a -> Eff es a
interpret (EffectHandler Opaleye es -> Eff (Opaleye : es) a -> Eff es a)
-> EffectHandler Opaleye es -> Eff (Opaleye : es) a -> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs es
env -> \case
  RunSelectExplicit FromFields fields haskells
ff Select fields
sel -> IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ FromFields fields haskells
-> Connection -> Select fields -> IO [haskells]
forall fields haskells.
FromFields fields haskells
-> Connection -> Select fields -> IO [haskells]
O.runSelectExplicit FromFields fields haskells
ff Connection
conn Select fields
sel
  RunSelectFoldExplicit FromFields fields haskells
ff Select fields
sel a
initial a -> haskells -> Eff localEs a
foldFn ->
    LocalEnv localEs es
-> ((forall r. Eff localEs r -> IO r) -> IO a) -> Eff es a
forall (es :: [Effect]) (handlerEs :: [Effect])
       (localEs :: [Effect]) a.
(HasCallStack, SharedSuffix es handlerEs, IOE :> es) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> IO r) -> IO a) -> Eff es a
localSeqUnliftIO LocalEnv localEs es
env (((forall r. Eff localEs r -> IO r) -> IO a) -> Eff es a)
-> ((forall r. Eff localEs r -> IO r) -> IO a) -> Eff es a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> IO r
unlift ->
      IO a -> IO a
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ FromFields fields haskells
-> Connection
-> Select fields
-> a
-> (a -> haskells -> IO a)
-> IO a
forall fields haskells b.
FromFields fields haskells
-> Connection
-> Select fields
-> b
-> (b -> haskells -> IO b)
-> IO b
O.runSelectFoldExplicit FromFields fields haskells
ff Connection
conn Select fields
sel a
initial (\a
acc haskells
new -> Eff localEs a -> IO a
forall r. Eff localEs r -> IO r
unlift (Eff localEs a -> IO a) -> Eff localEs a -> IO a
forall a b. (a -> b) -> a -> b
$ a -> haskells -> Eff localEs a
foldFn a
acc haskells
new)
  RunInsert Insert a
sel -> IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Connection -> Insert a -> IO a
forall haskells. Connection -> Insert haskells -> IO haskells
O.runInsert Connection
conn Insert a
sel
  RunDelete Delete a
sel -> IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Connection -> Delete a -> IO a
forall haskells. Connection -> Delete haskells -> IO haskells
O.runDelete Connection
conn Delete a
sel
  RunUpdate Update a
sel -> IO a -> Eff es a
forall a. IO a -> Eff es a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Eff es a) -> IO a -> Eff es a
forall a b. (a -> b) -> a -> b
$ Connection -> Update a -> IO a
forall haskells. Connection -> Update haskells -> IO haskells
O.runUpdate Connection
conn Update a
sel