{-|
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 :: (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) =
    EncodeParams db params a
-> DecodeRow row c
-> Manipulation '[] db params row
-> Statement db a c
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 ((a -> b) -> EncodeParams db params b -> EncodeParams db params a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> 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) =
    EncodeParams db params a
-> DecodeRow row c
-> Query '[] '[] db params row
-> Statement db a c
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 ((a -> b) -> EncodeParams db params b -> EncodeParams db params a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f EncodeParams db params b
encode) DecodeRow row c
decode Query '[] '[] db params row
q
  rmap :: (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) =
    EncodeParams db params a
-> DecodeRow row c
-> Manipulation '[] db params row
-> Statement db a c
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 ((b -> c) -> DecodeRow row b -> DecodeRow row c
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) =
    EncodeParams db params a
-> DecodeRow row c
-> Query '[] '[] db params row
-> Statement db a c
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 ((b -> c) -> DecodeRow row b -> DecodeRow row c
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 :: (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) =
    EncodeParams db params a
-> DecodeRow row d
-> Manipulation '[] db params row
-> Statement db a d
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 ((a -> b) -> EncodeParams db params b -> EncodeParams db params a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f EncodeParams db params b
encode) ((c -> d) -> DecodeRow row c -> DecodeRow row d
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) =
    EncodeParams db params a
-> DecodeRow row d
-> Query '[] '[] db params row
-> Statement db a d
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 ((a -> b) -> EncodeParams db params b -> EncodeParams db params a
forall (f :: * -> *) a b. Contravariant f => (a -> b) -> f b -> f a
contramap a -> b
f EncodeParams db params b
encode) ((c -> d) -> DecodeRow row c -> DecodeRow row d
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 :: (a -> b) -> Statement db x a -> Statement db x b
fmap = (a -> b) -> Statement db x a -> Statement db x b
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) = Manipulation '[] db params row -> ByteString
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) = Query '[] '[] db params row -> ByteString
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 :: Query '[] '[] db params row -> Statement db x y
query = EncodeParams db params x
-> DecodeRow row y
-> Query '[] '[] db params row
-> Statement db x y
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 x
forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*]).
GenericParams db params x xs =>
EncodeParams db params x
genericParams DecodeRow row y
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 :: Manipulation '[] db params row -> Statement db x y
manipulation = EncodeParams db params x
-> DecodeRow row y
-> Manipulation '[] db params row
-> Statement db x y
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 x
forall (db :: SchemasType) (params :: [NullType]) x (xs :: [*]).
GenericParams db params x xs =>
EncodeParams db params x
genericParams DecodeRow row y
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
  { Prepared m x y -> x -> m y
runPrepared :: x -> m y -- ^ execute a prepared statement
  , Prepared m x y -> m ()
deallocate :: m () -- ^ manually clean up a prepared statement
  } deriving (a -> Prepared m x b -> Prepared m x a
(a -> b) -> Prepared m x a -> Prepared m x b
(forall a b. (a -> b) -> Prepared m x a -> Prepared m x b)
-> (forall a b. a -> Prepared m x b -> Prepared m x a)
-> Functor (Prepared m x)
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
<$ :: 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 :: (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 x. Prepared m x y -> Rep (Prepared m x y) x)
-> (forall x. Rep (Prepared m x y) x -> Prepared m x y)
-> Generic (Prepared m x y)
forall x. Rep (Prepared m x y) x -> Prepared m x y
forall x. Prepared m x y -> Rep (Prepared m x y) x
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 a. Prepared m x a -> Rep1 (Prepared m x) a)
-> (forall a. Rep1 (Prepared m x) a -> Prepared m x a)
-> Generic1 (Prepared m x)
forall a. Rep1 (Prepared m x) a -> Prepared m x a
forall a. Prepared m x a -> Rep1 (Prepared m x) a
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 :: a -> Prepared m x a
pure a
a = (x -> m a) -> m () -> Prepared m x a
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (\x
_ -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  Prepared m x (a -> b)
p1 <*> :: Prepared m x (a -> b) -> Prepared m x a -> Prepared m x b
<*> Prepared m x a
p2 = (x -> m b) -> m () -> Prepared m x b
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    ((Kleisli m x (a -> b) -> Kleisli m x a -> Kleisli m x b)
-> Prepared m x (a -> b) -> Prepared m x a -> x -> m b
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 x (a -> b) -> Kleisli m x a -> Kleisli m x b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) Prepared m x (a -> b)
p1 Prepared m x a
p2)
    (Prepared m x (a -> b) -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m x (a -> b)
p1 m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Prepared m x a -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m x a
p2)

instance Alternative m => Alternative (Prepared m x) where
  empty :: Prepared m x a
empty = (x -> m a) -> m () -> Prepared m x a
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (Kleisli m x a -> x -> m a
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Kleisli m x a
forall (f :: * -> *) a. Alternative f => f a
empty) m ()
forall (f :: * -> *) a. Alternative f => f a
empty
  Prepared m x a
p1 <|> :: Prepared m x a -> Prepared m x a -> Prepared m x a
<|> Prepared m x a
p2 = (x -> m a) -> m () -> Prepared m x a
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    ((Kleisli m x a -> Kleisli m x a -> Kleisli m x a)
-> Prepared m x a -> Prepared m x a -> x -> m a
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 x a -> Kleisli m x a -> Kleisli m x a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Prepared m x a
p1 Prepared m x a
p2)
    (Prepared m x a -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m x a
p1 m () -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Prepared m x a -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m x a
p2)

instance Functor m => Profunctor (Prepared m) where
  dimap :: (a -> b) -> (c -> d) -> Prepared m b c -> Prepared m a d
dimap a -> b
g c -> d
f Prepared m b c
prepared = (a -> m d) -> m () -> Prepared m a d
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    ((c -> d) -> m c -> m d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
f (m c -> m d) -> (a -> m c) -> a -> m d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Prepared m b c -> b -> m c
forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared Prepared m b c
prepared (b -> m c) -> (a -> b) -> a -> m c
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)
    (Prepared m b c -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c
prepared)

instance Monad m => Strong (Prepared m) where
  first' :: Prepared m a b -> Prepared m (a, c) (b, c)
first' Prepared m a b
p = ((a, c) -> m (b, c)) -> m () -> Prepared m (a, c) (b, c)
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared ((Kleisli m a b -> Kleisli m (a, c) (b, c))
-> Prepared m a b -> (a, c) -> m (b, c)
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 (a, c) (b, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first' Prepared m a b
p) (Prepared m a b -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m a b
p)
  second' :: Prepared m a b -> Prepared m (c, a) (c, b)
second' Prepared m a b
p = ((c, a) -> m (c, b)) -> m () -> Prepared m (c, a) (c, b)
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared ((Kleisli m a b -> Kleisli m (c, a) (c, b))
-> Prepared m a b -> (c, a) -> m (c, b)
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, a) (c, b)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second' Prepared m a b
p) (Prepared m a b -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m a b
p)

instance Monad m => Choice (Prepared m) where
  left' :: Prepared m a b -> Prepared m (Either a c) (Either b c)
left' Prepared m a b
p = (Either a c -> m (Either b c))
-> m () -> Prepared m (Either a c) (Either b c)
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared ((Kleisli m a b -> Kleisli m (Either a c) (Either b c))
-> Prepared m a b -> Either a c -> m (Either b c)
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 (Either a c) (Either b c)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left' Prepared m a b
p) (Prepared m a b -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m a b
p)
  right' :: Prepared m a b -> Prepared m (Either c a) (Either c b)
right' Prepared m a b
p = (Either c a -> m (Either c b))
-> m () -> Prepared m (Either c a) (Either c b)
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared ((Kleisli m a b -> Kleisli m (Either c a) (Either c b))
-> Prepared m a b -> Either c a -> m (Either c b)
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 (Either c a) (Either c b)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right' Prepared m a b
p) (Prepared m a b -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m a b
p)

instance MonadFix m => Costrong (Prepared m) where
  unfirst :: Prepared m (a, d) (b, d) -> Prepared m a b
unfirst Prepared m (a, d) (b, d)
p = (a -> m b) -> m () -> Prepared m a b
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared ((Kleisli m (a, d) (b, d) -> Kleisli m a b)
-> Prepared m (a, d) (b, d) -> a -> m b
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, d) (b, d) -> Kleisli m a b
forall (p :: * -> * -> *) a d b.
Costrong p =>
p (a, d) (b, d) -> p a b
unfirst Prepared m (a, d) (b, d)
p) (Prepared m (a, d) (b, d) -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m (a, d) (b, d)
p)
  unsecond :: Prepared m (d, a) (d, b) -> Prepared m a b
unsecond Prepared m (d, a) (d, b)
p = (a -> m b) -> m () -> Prepared m a b
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared ((Kleisli m (d, a) (d, b) -> Kleisli m a b)
-> Prepared m (d, a) (d, b) -> a -> m b
forall (m :: * -> *) a b c d.
(Kleisli m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
run1 Kleisli m (d, a) (d, b) -> Kleisli m a b
forall (p :: * -> * -> *) d a b.
Costrong p =>
p (d, a) (d, b) -> p a b
unsecond Prepared m (d, a) (d, b)
p) (Prepared m (d, a) (d, b) -> m ()
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 :: Prepared m a a
id = (a -> m a) -> m () -> Prepared m a a
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  Prepared m b c
cd . :: Prepared m b c -> Prepared m a b -> Prepared m a c
. Prepared m a b
ab = (a -> m c) -> m () -> Prepared m a c
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    (Prepared m a b -> a -> m b
forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared Prepared m a b
ab (a -> m b) -> (b -> m c) -> a -> m c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Prepared m b c -> b -> m c
forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared Prepared m b c
cd)
    (Prepared m a b -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m a b
ab m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Prepared m b c -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c
cd)

instance Monad m => Arrow (Prepared m) where
  arr :: (b -> c) -> Prepared m b c
arr b -> c
ab = (b -> m c) -> m () -> Prepared m b c
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (c -> m c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> m c) -> (b -> c) -> b -> m c
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) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  first :: Prepared m b c -> Prepared m (b, d) (c, d)
first = Prepared m b c -> Prepared m (b, d) (c, d)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (a, c) (b, c)
first'
  second :: Prepared m b c -> Prepared m (d, b) (d, c)
second = Prepared m b c -> Prepared m (d, b) (d, c)
forall (p :: * -> * -> *) a b c.
Strong p =>
p a b -> p (c, a) (c, b)
second'
  Prepared m b c
ab *** :: Prepared m b c -> Prepared m b' c' -> Prepared m (b, b') (c, c')
*** Prepared m b' c'
cd = Prepared m b c -> Prepared m (b, b') (c, b')
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first Prepared m b c
ab Prepared m (b, b') (c, b')
-> Prepared m (c, b') (c, c') -> Prepared m (b, b') (c, c')
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Prepared m b' c' -> Prepared m (c, b') (c, 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 &&& :: Prepared m b c -> Prepared m b c' -> Prepared m b (c, c')
&&& Prepared m b c'
ac = (b -> m (c, c')) -> m () -> Prepared m b (c, c')
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    ((Kleisli m b c -> Kleisli m b c' -> Kleisli m b (c, c'))
-> Prepared m b c -> Prepared m b c' -> b -> m (c, c')
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 b c -> Kleisli m b c' -> Kleisli m b (c, c')
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)
    (Prepared m b c -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c
ab m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Prepared m b c' -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c'
ac)

instance Monad m => ArrowChoice (Prepared m) where
  left :: Prepared m b c -> Prepared m (Either b d) (Either c d)
left = Prepared m b c -> Prepared m (Either b d) (Either c d)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either a c) (Either b c)
left'
  right :: Prepared m b c -> Prepared m (Either d b) (Either d c)
right = Prepared m b c -> Prepared m (Either d b) (Either d c)
forall (p :: * -> * -> *) a b c.
Choice p =>
p a b -> p (Either c a) (Either c b)
right'
  Prepared m b c
ab +++ :: Prepared m b c
-> Prepared m b' c' -> Prepared m (Either b b') (Either c c')
+++ Prepared m b' c'
cd = Prepared m b c -> Prepared m (Either b b') (Either c b')
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left Prepared m b c
ab Prepared m (Either b b') (Either c b')
-> Prepared m (Either c b') (Either c c')
-> Prepared m (Either b b') (Either c c')
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> Prepared m b' c' -> Prepared m (Either c b') (Either c 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 ||| :: Prepared m b d -> Prepared m c d -> Prepared m (Either b c) d
||| Prepared m c d
cd = (Either b c -> m d) -> m () -> Prepared m (Either b c) d
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    ((Kleisli m b d -> Kleisli m c d -> Kleisli m (Either b c) d)
-> Prepared m b d -> Prepared m c d -> Either b c -> m d
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 b d -> Kleisli m c d -> Kleisli m (Either b c) d
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)
    (Prepared m b d -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b d
bd m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Prepared m c d -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m c d
cd)

instance MonadFix m => ArrowLoop (Prepared m) where
  loop :: Prepared m (b, d) (c, d) -> Prepared m b c
loop Prepared m (b, d) (c, d)
p = (b -> m c) -> m () -> Prepared m b c
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared ((Kleisli m (b, d) (c, d) -> Kleisli m b c)
-> Prepared m (b, d) (c, d) -> b -> m c
forall (m :: * -> *) a b c d.
(Kleisli m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
run1 Kleisli m (b, d) (c, d) -> Kleisli m b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop Prepared m (b, d) (c, d)
p) (Prepared m (b, d) (c, d) -> m ()
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 :: Prepared m b c
zeroArrow = (b -> m c) -> m () -> Prepared m b c
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared (Kleisli m b c -> b -> m c
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli Kleisli m b c
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow) (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

instance MonadPlus m => ArrowPlus (Prepared m) where
  Prepared m b c
p1 <+> :: Prepared m b c -> Prepared m b c -> Prepared m b c
<+> Prepared m b c
p2 = (b -> m c) -> m () -> Prepared m b c
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared
    ((Kleisli m b c -> Kleisli m b c -> Kleisli m b c)
-> Prepared m b c -> Prepared m b c -> b -> m c
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 b c -> Kleisli m b c -> Kleisli m b c
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)
    (Prepared m b c -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c
p1 m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Prepared m b c -> m ()
forall (m :: * -> *) x y. Prepared m x y -> m ()
deallocate Prepared m b c
p2)

instance Monad m => Traversing (Prepared m) where
  traverse' :: Prepared m a b -> Prepared m (f a) (f b)
traverse' Prepared m a b
p = (f a -> m (f b)) -> m () -> Prepared m (f a) (f b)
forall (m :: * -> *) x y. (x -> m y) -> m () -> Prepared m x y
Prepared ((Kleisli m a b -> Kleisli m (f a) (f b))
-> Prepared m a b -> f a -> m (f b)
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 (f a) (f b)
forall (p :: * -> * -> *) (f :: * -> *) a b.
(Traversing p, Traversable f) =>
p a b -> p (f a) (f b)
traverse' Prepared m a b
p) (Prepared m a b -> m ()
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 :: (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 = Kleisli m c d -> c -> m d
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli (Kleisli m c d -> c -> m d)
-> (Prepared m a b -> Kleisli m c d) -> Prepared m a b -> c -> m d
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 (Kleisli m a b -> Kleisli m c d)
-> (Prepared m a b -> Kleisli m a b)
-> Prepared m a b
-> Kleisli m c d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> m b) -> Kleisli m a b
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli ((a -> m b) -> Kleisli m a b)
-> (Prepared m a b -> a -> m b) -> Prepared m a b -> Kleisli m a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Prepared m a b -> a -> m b
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 :: (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 = Kleisli m e f -> e -> m f
forall (m :: * -> *) a b. Kleisli m a b -> a -> m b
runKleisli (Kleisli m e f -> e -> m f) -> Kleisli m e f -> e -> m f
forall a b. (a -> b) -> a -> b
$
  (a -> m b) -> Kleisli m a b
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (Prepared m a b -> a -> m b
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
? (c -> m d) -> Kleisli m c d
forall (m :: * -> *) a b. (a -> m b) -> Kleisli m a b
Kleisli (Prepared m c d -> c -> m d
forall (m :: * -> *) x y. Prepared m x y -> x -> m y
runPrepared Prepared m c d
p2)