{-# 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.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 M.ConstMsg (C.Cerial M.ConstMsg 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
$
        ConstMsg -> LimitT Maybe (Struct ConstMsg)
forall (m :: * -> *) msg. ReadCtx m msg => msg -> m (Struct msg)
U.rootPtr ConstMsg
M.empty LimitT Maybe (Struct ConstMsg)
-> (Struct ConstMsg -> LimitT Maybe (Cerial ConstMsg a))
-> LimitT Maybe (Cerial ConstMsg a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Struct ConstMsg -> LimitT Maybe (Cerial ConstMsg a)
forall msg a (m :: * -> *).
(FromStruct msg a, ReadCtx m msg) =>
Struct msg -> m a
C.fromStruct LimitT Maybe (Cerial ConstMsg a)
-> (Cerial ConstMsg a -> LimitT Maybe a) -> LimitT Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cerial ConstMsg a -> LimitT Maybe a
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
C.decerialize

convertValue ::
    ( U.RWCtx m s
    , M.Message m M.ConstMsg
    , C.Cerialize s a
    , C.ToStruct (M.MutMsg s) (C.Cerial (M.MutMsg s) a)
    , C.Decerialize b
    , C.FromStruct M.ConstMsg (C.Cerial M.ConstMsg b)
    ) => a -> m b
convertValue :: a -> m b
convertValue a
from = do
    ConstMsg
constMsg :: M.ConstMsg <- a -> m (MutMsg s)
forall (m :: * -> *) s a.
(MonadLimit m, WriteCtx m s, Cerialize s a,
 ToStruct (MutMsg s) (Cerial (MutMsg s) a)) =>
a -> m (MutMsg s)
Convert.valueToMsg a
from m (MutMsg s) -> (MutMsg s -> m ConstMsg) -> m ConstMsg
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MutMsg s -> m ConstMsg
forall a (m :: * -> *) s.
(Thaw a, PrimMonad m, PrimState m ~ s) =>
Mutable s a -> m a
freeze
    ConstMsg -> m (Cerial ConstMsg b)
forall (m :: * -> *) msg a.
(MonadThrow m, Message (LimitT m) msg, Message m msg,
 FromStruct msg a) =>
msg -> m a
Convert.msgToValue ConstMsg
constMsg m (Cerial ConstMsg b) -> (Cerial ConstMsg b -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Cerial ConstMsg b -> m b
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg 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 M.ConstMsg a -> a
toPurePtrConst :: Cerial ConstMsg a -> a
toPurePtrConst = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a)
-> (Cerial ConstMsg a -> Maybe a) -> Cerial ConstMsg 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 ConstMsg a -> LimitT Maybe a)
-> Cerial ConstMsg a
-> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cerial ConstMsg a -> LimitT Maybe a
forall a (m :: * -> *).
(Decerialize a, ReadCtx m ConstMsg) =>
Cerial ConstMsg a -> m a
C.decerialize