{-|
Module: Squeal.PostgreSQL.Session.Statement
Description: statements
Copyright: (c) Eitan Chatav, 2019
Maintainer: eitan@morphism.tech
Stability: experimental

A top-level `Statement` type wraps a `Squeal.PostgreSQL.Query.Query`
or `Squeal.PostgreSQL.Manipulation.Manipulation`
together with an `EncodeParams` and a `DecodeRow`.
-}

{-# LANGUAGE
    DataKinds
  , DeriveFunctor
  , DeriveFoldable
  , DeriveGeneric
  , DeriveTraversable
  , FlexibleContexts
  , GADTs
  , RankNTypes
#-}

module Squeal.PostgreSQL.Session.Statement
  ( -- * Statement
    Statement (..)
  , query
  , manipulation
    -- * Prepared
  , Prepared (..)
  ) where

import Control.Applicative
import Control.Arrow
import Control.Category
import Control.Monad
import Control.Monad.Fix
import Data.Functor.Contravariant
import Data.Profunctor
import Data.Profunctor.Traversing
import GHC.Generics
import Prelude hiding ((.),id)

import qualified Generics.SOP as SOP

import Squeal.PostgreSQL.Manipulation
import Squeal.PostgreSQL.Session.Decode
import Squeal.PostgreSQL.Session.Encode
import Squeal.PostgreSQL.Session.Oid
import Squeal.PostgreSQL.Query
import Squeal.PostgreSQL.Render hiding ((<+>))

-- | A `Statement` consists of a `Squeal.PostgreSQL.Statement.Manipulation`
-- or a `Squeal.PostgreSQL.Session.Statement.Query` that can be run
-- in a `Squeal.PostgreSQL.Session.Monad.MonadPQ`.
data Statement db x y where
  -- | Constructor for a data manipulation language `Statement`
  Manipulation
    :: (SOP.All (OidOfNull db) params, SOP.SListI row)
    => EncodeParams db params x -- ^ encoding of parameters
    -> DecodeRow row y -- ^ decoding of returned rows
    -> Manipulation '[] db params row
    -- ^ `Squeal.PostgreSQL.Manipulation.Insert.insertInto`,
    -- `Squeal.PostgreSQL.Manipulation.Update.update`,
    -- or `Squeal.PostgreSQL.Manipulation.Delete.deleteFrom`, ...
    -> Statement db x y
  -- | Constructor for a structured query language `Statement`
  Query
    :: (SOP.All (OidOfNull db) params, SOP.SListI row)
    => EncodeParams db params x -- ^ encoding of parameters
    -> DecodeRow row y -- ^ decoding of returned rows
    -> Query '[] '[] db params row
    -- ^ `Squeal.PostgreSQL.Query.Select.select`,
    -- `Squeal.PostgreSQL.Query.Values.values`, ...
    -> Statement db x y

instance Profunctor (Statement db) where
  lmap :: forall a b c. (a -> b) -> Statement db b c -> Statement db a c
lmap a -> b
f (Manipulation EncodeParams db params b
encode DecodeRow row c
decode Manipulation '[] db params row
q) =
    forall (db :: SchemasType) (params :: [NullType]) (row :: RowType)
       x y.
(All (OidOfNull db) params, SListI row) =>
EncodeParams db params x
-> DecodeRow row y
-> Manipulation '[] db params row
-> Statement db x y
Manipulation (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a -> b
f EncodeParams db params b
encode) DecodeRow row c
decode Manipulation '[] db params row
q
  lmap a -> b
f (Query EncodeParams db params b
encode DecodeRow row c
decode Query '[] '[] db params row
q) =
    forall (db :: SchemasType) (params :: [NullType]) (row :: RowType)
       x y.
(All (OidOfNull db) params, SListI row) =>
EncodeParams db params x
-> DecodeRow row y
-> Query '[] '[] db params row
-> Statement db x y
Query (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a -> b
f EncodeParams db params b
encode) DecodeRow row c
decode Query '[] '[] db params row
q
  rmap :: forall b c a. (b -> c) -> Statement db a b -> Statement db a c
rmap b -> c
f (Manipulation EncodeParams db params a
encode DecodeRow row b
decode Manipulation '[] db params row
q) =
    forall (db :: SchemasType) (params :: [NullType]) (row :: RowType)
       x y.
(All (OidOfNull db) params, SListI row) =>
EncodeParams db params x
-> DecodeRow row y
-> Manipulation '[] db params row
-> Statement db x y
Manipulation EncodeParams db params a
encode (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f DecodeRow row b
decode) Manipulation '[] db params row
q
  rmap b -> c
f (Query EncodeParams db params a
encode DecodeRow row b
decode Query '[] '[] db params row
q) =
    forall (db :: SchemasType) (params :: [NullType]) (row :: RowType)
       x y.
(All (OidOfNull db) params, SListI row) =>
EncodeParams db params x
-> DecodeRow row y
-> Query '[] '[] db params row
-> Statement db x y
Query EncodeParams db params a
encode (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
f DecodeRow row b
decode) Query '[] '[] db params row
q
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Statement db b c -> Statement db a d
dimap a -> b
f c -> d
g (Manipulation EncodeParams db params b
encode DecodeRow row c
decode Manipulation '[] db params row
q) =
    forall (db :: SchemasType) (params :: [NullType]) (row :: RowType)
       x y.
(All (OidOfNull db) params, SListI row) =>
EncodeParams db params x
-> DecodeRow row y
-> Manipulation '[] db params row
-> Statement db x y
Manipulation (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a -> b
f EncodeParams db params b
encode) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g DecodeRow row c
decode) Manipulation '[] db params row
q
  dimap a -> b
f c -> d
g (Query EncodeParams db params b
encode DecodeRow row c
decode Query '[] '[] db params row
q) =
    forall (db :: SchemasType) (params :: [NullType]) (row :: RowType)
       x y.
(All (OidOfNull db) params, SListI row) =>
EncodeParams db params x
-> DecodeRow row y
-> Query '[] '[] db params row
-> Statement db x y
Query (forall (f :: * -> *) a' a.
Contravariant f =>
(a' -> a) -> f a -> f a'
contramap a -> b
f EncodeParams db params b
encode) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g DecodeRow row c
decode) Query '[] '[] db params row
q

instance Functor (Statement db x) where fmap :: forall a b. (a -> b) -> Statement db x a -> Statement db x b
fmap = forall (p :: * -> * -> *) b c a.
Profunctor p =>
(b -> c) -> p a b -> p a c
rmap

instance RenderSQL (Statement db x y) where
  renderSQL :: Statement db x y -> ByteString
renderSQL (Manipulation EncodeParams db params x
_ DecodeRow row y
_ Manipulation '[] db params row
q) = forall sql. RenderSQL sql => sql -> ByteString
renderSQL Manipulation '[] db params row
q
  renderSQL (Query EncodeParams db params x
_ DecodeRow row y
_ Query '[] '[] db params row
q) = forall sql. RenderSQL sql => sql -> ByteString
renderSQL Query '[] '[] db params row
q

-- | Smart constructor for a structured query language `Statement`
query ::
  ( GenericParams db params x xs
  , GenericRow row y ys
  ) => Query '[] '[] db params row
    -- ^ `Squeal.PostgreSQL.Query.Select.select`,
    -- `Squeal.PostgreSQL.Query.Values.values`, ...
    -> Statement db x y
query :: forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*])
       (row :: RowType) y (ys :: RecordCode).
(GenericParams db params x xs, GenericRow row y ys) =>
Query '[] '[] db params row -> Statement db x y
query = forall (db :: SchemasType) (params :: [NullType]) (row :: RowType)
       x y.
(All (OidOfNull db) params, SListI row) =>
EncodeParams db params x
-> DecodeRow row y
-> Query '[] '[] db params row
-> Statement db x y
Query forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*]).
GenericParams db params x xs =>
EncodeParams db params x
genericParams forall (row :: RowType) y (ys :: RecordCode).
GenericRow row y ys =>
DecodeRow row y
genericRow

-- | Smart constructor for a data manipulation language `Statement`
manipulation ::
  ( GenericParams db params x xs
  , GenericRow row y ys
  ) => Manipulation '[] db params row
    -- ^ `Squeal.PostgreSQL.Manipulation.Insert.insertInto`,
    -- `Squeal.PostgreSQL.Manipulation.Update.update`,
    -- or `Squeal.PostgreSQL.Manipulation.Delete.deleteFrom`, ...
    -> Statement db x y
manipulation :: forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*])
       (row :: RowType) y (ys :: RecordCode).
(GenericParams db params x xs, GenericRow row y ys) =>
Manipulation '[] db params row -> Statement db x y
manipulation = forall (db :: SchemasType) (params :: [NullType]) (row :: RowType)
       x y.
(All (OidOfNull db) params, SListI row) =>
EncodeParams db params x
-> DecodeRow row y
-> Manipulation '[] db params row
-> Statement db x y
Manipulation forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*]).
GenericParams db params x xs =>
EncodeParams db params x
genericParams forall (row :: RowType) y (ys :: RecordCode).
GenericRow row y ys =>
DecodeRow row y
genericRow

{- |
`Squeal.PostgreSQL.Session.Monad.prepare` and
`Squeal.PostgreSQL.Session.Monad.prepare_` create a `Prepared` statement.
A `Prepared` statement is a server-side object
that can be used to optimize performance.
When `Squeal.PostgreSQL.Session.Monad.prepare`
or `Squeal.PostgreSQL.Session.Monad.prepare_` is executed,
the specified `Statement` is parsed, analyzed, and rewritten.

When the `runPrepared` command is subsequently issued,
the `Prepared` statement is planned and executed.
This division of labor avoids repetitive parse analysis work,
while allowing the execution plan to
depend on the specific parameter values supplied.

`Prepared` statements only last for the duration
of the current database session.
`Prepared` statements can be manually cleaned up
using the `deallocate` command.
-}
data Prepared m x y = Prepared
  { forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared :: x -> m y -- ^ execute a prepared statement
  , forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate :: m () -- ^ manually clean up a prepared statement
  } deriving (forall a b. a -> Prepared m x b -> Prepared m x a
forall a b. (a -> b) -> Prepared m x a -> Prepared m x b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) x a b.
Functor m =>
a -> Prepared m x b -> Prepared m x a
forall (m :: * -> *) x a b.
Functor m =>
(a -> b) -> Prepared m x a -> Prepared m x b
<$ :: forall a b. a -> Prepared m x b -> Prepared m x a
$c<$ :: forall (m :: * -> *) x a b.
Functor m =>
a -> Prepared m x b -> Prepared m x a
fmap :: forall a b. (a -> b) -> Prepared m x a -> Prepared m x b
$cfmap :: forall (m :: * -> *) x a b.
Functor m =>
(a -> b) -> Prepared m x a -> Prepared m x b
Functor, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) x y x.
Rep (Prepared m x y) x -> Prepared m x y
forall (m :: * -> *) x y x.
Prepared m x y -> Rep (Prepared m x y) x
$cto :: forall (m :: * -> *) x y x.
Rep (Prepared m x y) x -> Prepared m x y
$cfrom :: forall (m :: * -> *) x y x.
Prepared m x y -> Rep (Prepared m x y) x
Generic, forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall (m :: * -> *) x a. Rep1 (Prepared m x) a -> Prepared m x a
forall (m :: * -> *) x a. Prepared m x a -> Rep1 (Prepared m x) a
$cto1 :: forall (m :: * -> *) x a. Rep1 (Prepared m x) a -> Prepared m x a
$cfrom1 :: forall (m :: * -> *) x a. Prepared m x a -> Rep1 (Prepared m x) a
Generic1)

instance Applicative m => Applicative (Prepared m x) where
  pure :: forall a. a -> Prepared m x a
pure a
a = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (\x
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  Prepared m x (a -> b)
p1 <*> :: forall a b.
Prepared m x (a -> b) -> Prepared m x a -> Prepared m x b
<*> Prepared m x a
p2 = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    (forall (m :: * -> *) a b c d e f.
(Kleisli m a b -> Kleisli m c d -> Kleisli m e f)
-> Prepared m a b -> Prepared m c d -> e -> m f
run2 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) Prepared m x (a -> b)
p1 Prepared m x a
p2)
    (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m x (a -> b)
p1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m x a
p2)

instance Alternative m => Alternative (Prepared m x) where
  empty :: forall a. Prepared m x a
empty = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli forall (f :: * -> *) a. Alternative f => f a
empty) forall (f :: * -> *) a. Alternative f => f a
empty
  Prepared m x a
p1 <|> :: forall a. Prepared m x a -> Prepared m x a -> Prepared m x a
<|> Prepared m x a
p2 = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    (forall (m :: * -> *) a b c d e f.
(Kleisli m a b -> Kleisli m c d -> Kleisli m e f)
-> Prepared m a b -> Prepared m c d -> e -> m f
run2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Prepared m x a
p1 Prepared m x a
p2)
    (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m x a
p1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m x a
p2)

instance Functor m => Profunctor (Prepared m) where
  dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Prepared m b c -> Prepared m a d
dimap a -> b
g c -> d
f Prepared m b c
prepared = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared Prepared m b c
prepared forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. a -> b
g)
    (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c
prepared)

instance Monad m => Strong (Prepared m) where
  first' :: forall a b c. Prepared m a b -> Prepared m (a, c) (b, c)
first' Prepared m a b
p = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (forall (m :: * -> *) a b c d.
(Kleisli m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
run1 forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' Prepared m a b
p) (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m a b
p)
  second' :: forall a b c. Prepared m a b -> Prepared m (c, a) (c, b)
second' Prepared m a b
p = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (forall (m :: * -> *) a b c d.
(Kleisli m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
run1 forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second' Prepared m a b
p) (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m a b
p)

instance Monad m => Choice (Prepared m) where
  left' :: forall a b c.
Prepared m a b -> Prepared m (Either a c) (Either b c)
left' Prepared m a b
p = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (forall (m :: * -> *) a b c d.
(Kleisli m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
run1 forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left' Prepared m a b
p) (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m a b
p)
  right' :: forall a b c.
Prepared m a b -> Prepared m (Either c a) (Either c b)
right' Prepared m a b
p = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (forall (m :: * -> *) a b c d.
(Kleisli m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
run1 forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' Prepared m a b
p) (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m a b
p)

instance MonadFix m => Costrong (Prepared m) where
  unfirst :: forall a d b. Prepared m (a, d) (b, d) -> Prepared m a b
unfirst Prepared m (a, d) (b, d)
p = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (forall (m :: * -> *) a b c d.
(Kleisli m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
run1 forall (p :: * -> * -> *) a d b.
Costrong p =>
p (a, d) (b, d) -> p a b
unfirst Prepared m (a, d) (b, d)
p) (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m (a, d) (b, d)
p)
  unsecond :: forall d a b. Prepared m (d, a) (d, b) -> Prepared m a b
unsecond Prepared m (d, a) (d, b)
p = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (forall (m :: * -> *) a b c d.
(Kleisli m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
run1 forall (p :: * -> * -> *) d a b.
Costrong p =>
p (d, a) (d, b) -> p a b
unsecond Prepared m (d, a) (d, b)
p) (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m (d, a) (d, b)
p)

instance Monad m => Category (Prepared m) where
  id :: forall a. Prepared m a a
id = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. Monad m => a -> m a
return ())
  Prepared m b c
cd . :: forall b c a. Prepared m b c -> Prepared m a b -> Prepared m a c
. Prepared m a b
ab = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    (forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared Prepared m a b
ab forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared Prepared m b c
cd)
    (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m a b
ab forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c
cd)

instance Monad m => Arrow (Prepared m) where
  arr :: forall b c. (b -> c) -> Prepared m b c
arr b -> c
ab = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (forall (m :: * -> *) a. Monad m => a -> m a
return forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> c
ab) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
  first :: forall b c d. Prepared m b c -> Prepared m (b, d) (c, d)
first = forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first'
  second :: forall b c d. Prepared m b c -> Prepared m (d, b) (d, c)
second = forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second'
  Prepared m b c
ab *** :: forall b c b' c'.
Prepared m b c -> Prepared m b' c' -> Prepared m (b, b') (c, c')
*** Prepared m b' c'
cd = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Prepared m b c
ab forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Prepared m b' c'
cd
  Prepared m b c
ab &&& :: forall b c c'.
Prepared m b c -> Prepared m b c' -> Prepared m b (c, c')
&&& Prepared m b c'
ac = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    (forall (m :: * -> *) a b c d e f.
(Kleisli m a b -> Kleisli m c d -> Kleisli m e f)
-> Prepared m a b -> Prepared m c d -> e -> m f
run2 forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) Prepared m b c
ab Prepared m b c'
ac)
    (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c
ab forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c'
ac)

instance Monad m => ArrowChoice (Prepared m) where
  left :: forall b c d.
Prepared m b c -> Prepared m (Either b d) (Either c d)
left = forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left'
  right :: forall b c d.
Prepared m b c -> Prepared m (Either d b) (Either d c)
right = forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'
  Prepared m b c
ab +++ :: forall b c b' c'.
Prepared m b c
-> Prepared m b' c' -> Prepared m (Either b b') (Either c c')
+++ Prepared m b' c'
cd = forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Prepared m b c
ab forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right Prepared m b' c'
cd
  Prepared m b d
bd ||| :: forall b d c.
Prepared m b d -> Prepared m c d -> Prepared m (Either b c) d
||| Prepared m c d
cd = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    (forall (m :: * -> *) a b c d e f.
(Kleisli m a b -> Kleisli m c d -> Kleisli m e f)
-> Prepared m a b -> Prepared m c d -> e -> m f
run2 forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
(|||) Prepared m b d
bd Prepared m c d
cd)
    (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b d
bd forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m c d
cd)

instance MonadFix m => ArrowLoop (Prepared m) where
  loop :: forall b d c. Prepared m (b, d) (c, d) -> Prepared m b c
loop Prepared m (b, d) (c, d)
p = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (forall (m :: * -> *) a b c d.
(Kleisli m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
run1 forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop Prepared m (b, d) (c, d)
p) (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m (b, d) (c, d)
p)

instance MonadPlus m => ArrowZero (Prepared m) where
  zeroArrow :: forall b c. Prepared m b c
zeroArrow = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow) (forall (m :: * -> *) a. Monad m => a -> m a
return ())

instance MonadPlus m => ArrowPlus (Prepared m) where
  Prepared m b c
p1 <+> :: forall b c. Prepared m b c -> Prepared m b c -> Prepared m b c
<+> Prepared m b c
p2 = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    (forall (m :: * -> *) a b c d e f.
(Kleisli m a b -> Kleisli m c d -> Kleisli m e f)
-> Prepared m a b -> Prepared m c d -> e -> m f
run2 forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
(<+>) Prepared m b c
p1 Prepared m b c
p2)
    (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c
p1 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c
p2)

instance Monad m => Traversing (Prepared m) where
  traverse' :: forall (f :: * -> *) a b.
Traversable f =>
Prepared m a b -> Prepared m (f a) (f b)
traverse' Prepared m a b
p = forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (forall (m :: * -> *) a b c d.
(Kleisli m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
run1 forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse' Prepared m a b
p) (forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m a b
p)

-- helper functions

run1
  :: (Kleisli m a b -> Kleisli m c d)
  -> Prepared m a b -> c -> m d
run1 :: forall (m :: * -> *) a b c d.
(Kleisli m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
run1 Kleisli m a b -> Kleisli m c d
m = forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Kleisli m a b -> Kleisli m c d
m forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared

run2
  :: (Kleisli m a b -> Kleisli m c d -> Kleisli m e f)
  -> Prepared m a b -> Prepared m c d -> e -> m f
run2 :: forall (m :: * -> *) a b c d e f.
(Kleisli m a b -> Kleisli m c d -> Kleisli m e f)
-> Prepared m a b -> Prepared m c d -> e -> m f
run2 Kleisli m a b -> Kleisli m c d -> Kleisli m e f
(?) Prepared m a b
p1 Prepared m c d
p2 = forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared Prepared m a b
p1) Kleisli m a b -> Kleisli m c d -> Kleisli m e f
? forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared Prepared m c d
p2)