{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{- |
Module: Capnp.GenHelpers.Pure
Description: Misc. helpers for generated code.

This module provides various helpers used by generated code; developers
are not expected to invoke them directly.

These helpers are only used by the high-level api. "Capnp.GenHelpers"
defines helpers used by the low-level api.
-}
module Capnp.GenHelpers.Pure
    ( defaultStruct
    , convertValue
    , getRoot
    , createPure
    , toPurePtrConst
    , cerializeBasicVec
    , cerializeCompositeVec
    ) where

import Data.Maybe (fromJust)

import Capnp.Classes        (cerializeBasicVec, cerializeCompositeVec)
import Capnp.Message        (Mutability(..))
import Capnp.TraversalLimit (evalLimitT)
import Codec.Capnp          (getRoot)

import Data.Mutable       (freeze)
import Internal.BuildPure (createPure)

import qualified Capnp.Classes as C
import qualified Capnp.Convert as Convert
import qualified Capnp.Message as M
import qualified Capnp.Untyped as U

-- | A valid implementation for 'Data.Default.Default' for any type that meets
-- the given constraints.
defaultStruct :: (C.Decerialize a, C.FromStruct 'Const (C.Cerial 'Const a)) => a
defaultStruct :: a
defaultStruct =
    Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$
    WordCount -> LimitT Maybe a -> Maybe a
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
forall a. Bounded a => a
maxBound (LimitT Maybe a -> Maybe a) -> LimitT Maybe a -> Maybe a
forall a b. (a -> b) -> a -> b
$
        Message 'Const -> LimitT Maybe (Struct 'Const)
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Message mut -> m (Struct mut)
U.rootPtr Message 'Const
M.empty LimitT Maybe (Struct 'Const)
-> (Struct 'Const -> LimitT Maybe (Cerial 'Const a))
-> LimitT Maybe (Cerial 'Const a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Struct 'Const -> LimitT Maybe (Cerial 'Const a)
forall (mut :: Mutability) a (m :: * -> *).
(FromStruct mut a, ReadCtx m mut) =>
Struct mut -> m a
C.fromStruct LimitT Maybe (Cerial 'Const a)
-> (Cerial 'Const a -> LimitT Maybe a) -> LimitT Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cerial 'Const a -> LimitT Maybe a
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
C.decerialize

convertValue ::
    ( U.RWCtx m s
    , M.MonadReadMessage 'Const m
    , C.Cerialize s a
    , C.ToStruct ('Mut s) (C.Cerial ('Mut s) a)
    , C.Decerialize b
    , C.FromStruct 'Const (C.Cerial 'Const b)
    ) => a -> m b
convertValue :: a -> m b
convertValue a
from = do
    Message 'Const
constMsg :: M.Message 'Const <- a -> m (Message ('Mut s))
forall (m :: * -> *) s a.
(MonadLimit m, WriteCtx m s, Cerialize s a,
 ToStruct ('Mut s) (Cerial ('Mut s) a)) =>
a -> m (Message ('Mut s))
Convert.valueToMsg a
from m (Message ('Mut s))
-> (Message ('Mut s) -> m (Message 'Const)) -> m (Message 'Const)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message ('Mut s) -> m (Message 'Const)
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    Message 'Const -> m (Cerial 'Const b)
forall (m :: * -> *) (mut :: Mutability) a.
(MonadThrow m, MonadReadMessage mut (LimitT m),
 MonadReadMessage mut m, FromStruct mut a) =>
Message mut -> m a
Convert.msgToValue Message 'Const
constMsg m (Cerial 'Const b) -> (Cerial 'Const b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cerial 'Const b -> m b
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
C.decerialize

-- | convert a low-level value to a high-level one. This is not safe against
-- malicious or invalid input; it is used for declaring top-level constants.
toPurePtrConst :: C.Decerialize a => C.Cerial 'Const a -> a
toPurePtrConst :: Cerial 'Const a -> a
toPurePtrConst = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a)
-> (Cerial 'Const a -> Maybe a) -> Cerial 'Const a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordCount -> LimitT Maybe a -> Maybe a
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
forall a. Bounded a => a
maxBound (LimitT Maybe a -> Maybe a)
-> (Cerial 'Const a -> LimitT Maybe a)
-> Cerial 'Const a
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cerial 'Const a -> LimitT Maybe a
forall a (m :: * -> *).
(Decerialize a, ReadCtx m 'Const) =>
Cerial 'Const a -> m a
C.decerialize