{-# LANGUAGE
DataKinds
, DefaultSignatures
, FlexibleContexts
, FlexibleInstances
, FunctionalDependencies
, PolyKinds
, MultiParamTypeClasses
, QuantifiedConstraints
, RankNTypes
, TypeApplications
, TypeFamilies
, UndecidableInstances
#-}
module Squeal.PostgreSQL.Session.Indexed
( IndexedMonadTrans (..)
, Indexed (..)
, IndexedMonadTransPQ (..)
, indexedDefine
) where
import Control.Category (Category (..))
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Trans
import Data.Function ((&))
import Prelude hiding (id, (.))
import Squeal.PostgreSQL.Definition
class
( forall i j m. Monad m => Functor (t i j m)
, forall i m. Monad m => Monad (t i i m)
, forall i. MonadTrans (t i i)
) => IndexedMonadTrans t where
{-# MINIMAL pqJoin | pqBind #-}
pqAp
:: Monad m
=> t i j m (x -> y)
-> t j k m x
-> t i k m y
pqAp t i j m (x -> y)
tf t j k m x
tx = forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *) x
(j :: k) (k :: k) y (i :: k).
(IndexedMonadTrans t, Monad m) =>
(x -> t j k m y) -> t i j m x -> t i k m y
pqBind (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t j k m x
tx) t i j m (x -> y)
tf
pqJoin
:: Monad m
=> t i j m (t j k m y)
-> t i k m y
pqJoin t i j m (t j k m y)
t = t i j m (t j k m y)
t forall a b. a -> (a -> b) -> b
& forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *) x
(j :: k) (k :: k) y (i :: k).
(IndexedMonadTrans t, Monad m) =>
(x -> t j k m y) -> t i j m x -> t i k m y
pqBind forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
pqBind
:: Monad m
=> (x -> t j k m y)
-> t i j m x
-> t i k m y
pqBind x -> t j k m y
f t i j m x
t = forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *)
(i :: k) (j :: k) (k :: k) y.
(IndexedMonadTrans t, Monad m) =>
t i j m (t j k m y) -> t i k m y
pqJoin (x -> t j k m y
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t i j m x
t)
pqThen
:: Monad m
=> t j k m y
-> t i j m x
-> t i k m y
pqThen t j k m y
pq2 t i j m x
pq1 = t i j m x
pq1 forall a b. a -> (a -> b) -> b
& forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *) x
(j :: k) (k :: k) y (i :: k).
(IndexedMonadTrans t, Monad m) =>
(x -> t j k m y) -> t i j m x -> t i k m y
pqBind (\ x
_ -> t j k m y
pq2)
pqAndThen
:: Monad m
=> (y -> t j k m z)
-> (x -> t i j m y)
-> x -> t i k m z
pqAndThen y -> t j k m z
g x -> t i j m y
f x
x = forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *) x
(j :: k) (k :: k) y (i :: k).
(IndexedMonadTrans t, Monad m) =>
(x -> t j k m y) -> t i j m x -> t i k m y
pqBind y -> t j k m z
g (x -> t i j m y
f x
x)
newtype Indexed t m r i j = Indexed {forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
Indexed t m r i j -> t i j m r
runIndexed :: t i j m r}
instance
( IndexedMonadTrans t
, Monad m
, Monoid r
) => Category (Indexed t m r) where
id :: forall (a :: k). Indexed t m r a a
id = forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
t i j m r -> Indexed t m r i j
Indexed (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Monoid a => a
mempty)
Indexed t b c m r
g . :: forall (b :: k) (c :: k) (a :: k).
Indexed t m r b c -> Indexed t m r a b -> Indexed t m r a c
. Indexed t a b m r
f = forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
t i j m r -> Indexed t m r i j
Indexed forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k -> k -> (* -> *) -> * -> *) (m :: * -> *)
(i :: k) (j :: k) x y (k :: k).
(IndexedMonadTrans t, Monad m) =>
t i j m (x -> y) -> t j k m x -> t i k m y
pqAp (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Semigroup a => a -> a -> a
(<>) t a b m r
f) t b c m r
g
class IndexedMonadTrans pq => IndexedMonadTransPQ pq where
define :: MonadIO io => Definition db0 db1 -> pq db0 db1 io ()
indexedDefine
:: (IndexedMonadTransPQ pq, MonadIO io)
=> Definition db0 db1 -> Indexed pq io () db0 db1
indexedDefine :: forall (pq :: SchemasType -> SchemasType -> (* -> *) -> * -> *)
(io :: * -> *) (db0 :: SchemasType) (db1 :: SchemasType).
(IndexedMonadTransPQ pq, MonadIO io) =>
Definition db0 db1 -> Indexed pq io () db0 db1
indexedDefine = forall {k} {k} {k} {k} (t :: k -> k -> k -> k -> *) (m :: k)
(r :: k) (i :: k) (j :: k).
t i j m r -> Indexed t m r i j
Indexed forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (pq :: SchemasType -> SchemasType -> (* -> *) -> * -> *)
(io :: * -> *) (db0 :: SchemasType) (db1 :: SchemasType).
(IndexedMonadTransPQ pq, MonadIO io) =>
Definition db0 db1 -> pq db0 db1 io ()
define