{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-}

-- |
-- Module: Internal.BuildPure
-- Description: Helpers for building capnproto messages in pure code.
--
-- This module provides some helpers for building capnproto messages and values
-- in pure code, using the low-level API.
module Internal.BuildPure
  ( PureBuilder,
    createPure,
  )
where

import Capnp.Bits (WordCount)
import Capnp.Mutability
import Capnp.TraversalLimit (LimitT, MonadLimit, evalLimitT)
import Control.Monad.Catch (Exception, MonadThrow (..), SomeException)
import Control.Monad.Primitive (PrimMonad (..))
import Control.Monad.ST (ST)
import Internal.STE

-- | 'PureBuilder' is a monad transformer stack with the instnaces needed
-- manipulate mutable messages. @'PureBuilder' s a@ is morally equivalent
-- to @'LimitT' ('CatchT' ('ST' s)) a@
newtype PureBuilder s a = PureBuilder (LimitT (STE SomeException s) a)
  deriving (forall a b. a -> PureBuilder s b -> PureBuilder s a
forall a b. (a -> b) -> PureBuilder s a -> PureBuilder s b
forall s a b. a -> PureBuilder s b -> PureBuilder s a
forall s a b. (a -> b) -> PureBuilder s a -> PureBuilder s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> PureBuilder s b -> PureBuilder s a
$c<$ :: forall s a b. a -> PureBuilder s b -> PureBuilder s a
fmap :: forall a b. (a -> b) -> PureBuilder s a -> PureBuilder s b
$cfmap :: forall s a b. (a -> b) -> PureBuilder s a -> PureBuilder s b
Functor, forall s. Functor (PureBuilder s)
forall a. a -> PureBuilder s a
forall s a. a -> PureBuilder s a
forall a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s a
forall a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s b
forall a b.
PureBuilder s (a -> b) -> PureBuilder s a -> PureBuilder s b
forall s a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s a
forall s a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s b
forall s a b.
PureBuilder s (a -> b) -> PureBuilder s a -> PureBuilder s b
forall a b c.
(a -> b -> c)
-> PureBuilder s a -> PureBuilder s b -> PureBuilder s c
forall s a b c.
(a -> b -> c)
-> PureBuilder s a -> PureBuilder s b -> PureBuilder s c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s a
$c<* :: forall s a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s a
*> :: forall a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s b
$c*> :: forall s a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s b
liftA2 :: forall a b c.
(a -> b -> c)
-> PureBuilder s a -> PureBuilder s b -> PureBuilder s c
$cliftA2 :: forall s a b c.
(a -> b -> c)
-> PureBuilder s a -> PureBuilder s b -> PureBuilder s c
<*> :: forall a b.
PureBuilder s (a -> b) -> PureBuilder s a -> PureBuilder s b
$c<*> :: forall s a b.
PureBuilder s (a -> b) -> PureBuilder s a -> PureBuilder s b
pure :: forall a. a -> PureBuilder s a
$cpure :: forall s a. a -> PureBuilder s a
Applicative, forall s. Applicative (PureBuilder s)
forall a. a -> PureBuilder s a
forall s a. a -> PureBuilder s a
forall a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s b
forall a b.
PureBuilder s a -> (a -> PureBuilder s b) -> PureBuilder s b
forall s a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s b
forall s a b.
PureBuilder s a -> (a -> PureBuilder s b) -> PureBuilder s b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> PureBuilder s a
$creturn :: forall s a. a -> PureBuilder s a
>> :: forall a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s b
$c>> :: forall s a b. PureBuilder s a -> PureBuilder s b -> PureBuilder s b
>>= :: forall a b.
PureBuilder s a -> (a -> PureBuilder s b) -> PureBuilder s b
$c>>= :: forall s a b.
PureBuilder s a -> (a -> PureBuilder s b) -> PureBuilder s b
Monad, forall s. Monad (PureBuilder s)
forall e a. Exception e => e -> PureBuilder s a
forall s e a. Exception e => e -> PureBuilder s a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> PureBuilder s a
$cthrowM :: forall s e a. Exception e => e -> PureBuilder s a
MonadThrow, WordCount -> PureBuilder s ()
forall s. Monad (PureBuilder s)
forall s. WordCount -> PureBuilder s ()
forall (m :: * -> *).
Monad m -> (WordCount -> m ()) -> MonadLimit m
invoice :: WordCount -> PureBuilder s ()
$cinvoice :: forall s. WordCount -> PureBuilder s ()
MonadLimit)

instance PrimMonad (PureBuilder s) where
  type PrimState (PureBuilder s) = s
  primitive :: forall a.
(State# (PrimState (PureBuilder s))
 -> (# State# (PrimState (PureBuilder s)), a #))
-> PureBuilder s a
primitive = forall s a. LimitT (STE SomeException s) a -> PureBuilder s a
PureBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

runPureBuilder :: WordCount -> PureBuilder s a -> ST s (Either SomeException a)
runPureBuilder :: forall s a.
WordCount -> PureBuilder s a -> ST s (Either SomeException a)
runPureBuilder WordCount
limit (PureBuilder LimitT (STE SomeException s) a
m) = forall e s a. Typeable e => STE e s a -> ST s (Either e a)
steToST forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
limit LimitT (STE SomeException s) a
m

-- | @'createPure' limit m@ creates a capnproto value in pure code according
-- to @m@, then freezes it without copying. If @m@ calls 'throwM' then
-- 'createPure' rethrows the exception in the specified monad.
createPure :: (MonadThrow m, MaybeMutable f) => WordCount -> (forall s. PureBuilder s (f ('Mut s))) -> m (f 'Const)
createPure :: forall (m :: * -> *) (f :: Mutability -> *).
(MonadThrow m, MaybeMutable f) =>
WordCount -> (forall s. PureBuilder s (f ('Mut s))) -> m (f 'Const)
createPure WordCount
limit forall s. PureBuilder s (f ('Mut s))
m = forall e (m :: * -> *) a.
(Exception e, MonadThrow m) =>
Either e a -> m a
throwLeft forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: Mutability -> *).
(Traversable t, MaybeMutable f) =>
(forall s. ST s (t (f ('Mut s)))) -> t (f 'Const)
createT (forall s a.
WordCount -> PureBuilder s a -> ST s (Either SomeException a)
runPureBuilder WordCount
limit forall s. PureBuilder s (f ('Mut s))
m)
  where
    -- I(zenhack) am surprised not to have found this in one of the various
    -- exception packages:
    throwLeft :: (Exception e, MonadThrow m) => Either e a -> m a
    throwLeft :: forall e (m :: * -> *) a.
(Exception e, MonadThrow m) =>
Either e a -> m a
throwLeft (Left e
e) = forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e
    throwLeft (Right a
a) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a