{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Capnp.GenHelpers.New
( dataField
, ptrField
, groupField
, voidField
, readVariant
, Mutability(..)
, TypeParam
, newStruct
, parseEnum
, encodeEnum
, getPtrConst
, BS.ByteString
, module F
, module Capnp.New.Accessors
, Proxy(..)
) where
import Capnp.Bits
import Capnp.Convert (bsToRaw)
import Capnp.Fields as F
import Capnp.Message (Mutability(..))
import qualified Capnp.Message as M
import Capnp.New.Accessors
import qualified Capnp.New.Basics as NB
import qualified Capnp.New.Classes as NC
import Capnp.New.Constraints (TypeParam)
import qualified Capnp.Repr as R
import Capnp.TraversalLimit (evalLimitT)
import qualified Capnp.Untyped as U
import Data.Bits
import qualified Data.ByteString as BS
import Data.Functor ((<&>))
import Data.Maybe (fromJust)
import Data.Proxy (Proxy(..))
import Data.Word
dataField
:: forall b a sz.
( R.ReprFor b ~ 'R.Data sz
, NC.IsWord (R.UntypedData sz)
)
=> BitCount -> Word16 -> BitCount -> Word64 -> F.Field 'F.Slot a b
dataField :: BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
dataField BitCount
shift Word16
index BitCount
nbits Word64
defaultValue = FieldLoc 'Slot (ReprFor b) -> Field 'Slot a b
forall (k :: FieldKind) a b. FieldLoc k (ReprFor b) -> Field k a b
F.Field (FieldLoc 'Slot (ReprFor b) -> Field 'Slot a b)
-> FieldLoc 'Slot (ReprFor b) -> Field 'Slot a b
forall a b. (a -> b) -> a -> b
$ DataFieldLoc sz -> FieldLoc 'Slot ('Data sz)
forall (a :: DataSz).
IsWord (UntypedData a) =>
DataFieldLoc a -> FieldLoc 'Slot ('Data a)
F.DataField @sz DataFieldLoc :: forall (sz :: DataSz).
BitCount -> Word16 -> Word64 -> Word64 -> DataFieldLoc sz
F.DataFieldLoc
{ BitCount
shift :: BitCount
shift :: BitCount
shift
, Word16
index :: Word16
index :: Word16
index
, mask :: Word64
mask = ((Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` BitCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral BitCount
nbits) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` BitCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral BitCount
shift
, Word64
defaultValue :: Word64
defaultValue :: Word64
defaultValue
}
ptrField :: forall a b. R.IsPtr b => Word16 -> F.Field 'F.Slot a b
ptrField :: Word16 -> Field 'Slot a b
ptrField = FieldLoc 'Slot ('Ptr (PtrReprFor (ReprFor b))) -> Field 'Slot a b
forall (k :: FieldKind) a b. FieldLoc k (ReprFor b) -> Field k a b
F.Field (FieldLoc 'Slot ('Ptr (PtrReprFor (ReprFor b))) -> Field 'Slot a b)
-> (Word16 -> FieldLoc 'Slot ('Ptr (PtrReprFor (ReprFor b))))
-> Word16
-> Field 'Slot a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsPtrRepr (PtrReprFor (ReprFor b)) =>
Word16 -> FieldLoc 'Slot ('Ptr (PtrReprFor (ReprFor b)))
forall (a :: Maybe PtrRepr).
IsPtrRepr a =>
Word16 -> FieldLoc 'Slot ('Ptr a)
F.PtrField @(R.PtrReprFor (R.ReprFor b))
groupField :: (R.ReprFor b ~ 'R.Ptr ('Just 'R.Struct)) => F.Field 'F.Group a b
groupField :: Field 'Group a b
groupField = FieldLoc 'Group (ReprFor b) -> Field 'Group a b
forall (k :: FieldKind) a b. FieldLoc k (ReprFor b) -> Field k a b
F.Field FieldLoc 'Group ('Ptr ('Just 'Struct))
FieldLoc 'Group (ReprFor b)
F.GroupField
voidField :: (R.ReprFor b ~ 'R.Data 'R.Sz0) => F.Field 'F.Slot a b
voidField :: Field 'Slot a b
voidField = FieldLoc 'Slot (ReprFor b) -> Field 'Slot a b
forall (k :: FieldKind) a b. FieldLoc k (ReprFor b) -> Field k a b
F.Field FieldLoc 'Slot ('Data 'Sz0)
FieldLoc 'Slot (ReprFor b)
F.VoidField
readVariant
:: forall k a b mut m.
( R.IsStruct a
, U.ReadCtx m mut
)
=> F.Variant k a b -> R.Raw a mut -> m (R.Raw b mut)
readVariant :: Variant k a b -> Raw a mut -> m (Raw b mut)
readVariant F.Variant{Field k a b
field :: forall (k :: FieldKind) a b. Variant k a b -> Field k a b
field :: Field k a b
field} = Field k a b -> Raw a mut -> m (Raw b mut)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Field k a b -> Raw a mut -> m (Raw b mut)
readField Field k a b
field
newStruct :: forall a m s. (U.RWCtx m s, NC.TypedStruct a) => () -> M.Message ('Mut s) -> m (R.Raw a ('Mut s))
newStruct :: () -> Message ('Mut s) -> m (Raw a ('Mut s))
newStruct () Message ('Mut s)
msg = Struct ('Mut s) -> Raw a ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw (Struct ('Mut s) -> Raw a ('Mut s))
-> (Raw AnyStruct ('Mut s) -> Struct ('Mut s))
-> Raw AnyStruct ('Mut s)
-> Raw a ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw AnyStruct ('Mut s) -> Struct ('Mut s)
forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw (Raw AnyStruct ('Mut s) -> Raw a ('Mut s))
-> m (Raw AnyStruct ('Mut s)) -> m (Raw a ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AllocHint AnyStruct
-> Message ('Mut s) -> m (Raw AnyStruct ('Mut s))
forall a (m :: * -> *) s.
(Allocate a, RWCtx m s) =>
AllocHint a -> Message ('Mut s) -> m (Raw a ('Mut s))
NC.new @NB.AnyStruct (TypedStruct a => Word16
forall a. TypedStruct a => Word16
NC.numStructWords @a, TypedStruct a => Word16
forall a. TypedStruct a => Word16
NC.numStructPtrs @a) Message ('Mut s)
msg
parseEnum :: (R.ReprFor a ~ 'R.Data 'R.Sz16, Enum a, Applicative m)
=> R.Raw a 'Const -> m a
parseEnum :: Raw a 'Const -> m a
parseEnum (R.Raw Unwrapped (Untyped (ReprFor a) 'Const)
n) = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
Unwrapped (Untyped (ReprFor a) 'Const)
n
encodeEnum :: forall a m s. (R.ReprFor a ~ 'R.Data 'R.Sz16, Enum a, U.RWCtx m s)
=> M.Message ('Mut s) -> a -> m (R.Raw a ('Mut s))
encodeEnum :: Message ('Mut s) -> a -> m (Raw a ('Mut s))
encodeEnum Message ('Mut s)
_msg a
value = Raw a ('Mut s) -> m (Raw a ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Raw a ('Mut s) -> m (Raw a ('Mut s)))
-> Raw a ('Mut s) -> m (Raw a ('Mut s))
forall a b. (a -> b) -> a -> b
$ Unwrapped (Untyped (ReprFor a) ('Mut s)) -> Raw a ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw (Unwrapped (Untyped (ReprFor a) ('Mut s)) -> Raw a ('Mut s))
-> Unwrapped (Untyped (ReprFor a) ('Mut s)) -> Raw a ('Mut s)
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Enum a => a -> Int
fromEnum @a a
value
getPtrConst :: forall a. R.IsPtr a => BS.ByteString -> R.Raw a 'Const
getPtrConst :: ByteString -> Raw a 'Const
getPtrConst ByteString
bytes = Maybe (Raw a 'Const) -> Raw a 'Const
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Raw a 'Const) -> Raw a 'Const)
-> Maybe (Raw a 'Const) -> Raw a 'Const
forall a b. (a -> b) -> a -> b
$ WordCount -> LimitT Maybe (Raw a 'Const) -> Maybe (Raw a 'Const)
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
forall a. Bounded a => a
maxBound (LimitT Maybe (Raw a 'Const) -> Maybe (Raw a 'Const))
-> LimitT Maybe (Raw a 'Const) -> Maybe (Raw a 'Const)
forall a b. (a -> b) -> a -> b
$ do
R.Raw Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
root <- ByteString -> LimitT Maybe (Raw AnyStruct 'Const)
forall a (m :: * -> *).
(ReadCtx m 'Const, IsStruct a) =>
ByteString -> m (Raw a 'Const)
bsToRaw @NB.AnyStruct ByteString
bytes
Int -> Struct 'Const -> LimitT Maybe (Maybe (Ptr 'Const))
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr Int
0 Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
Struct 'Const
root
LimitT Maybe (Maybe (Ptr 'Const))
-> (Maybe (Ptr 'Const)
-> LimitT
Maybe (Unwrapped (UntypedPtr (PtrReprFor (ReprFor a)) 'Const)))
-> LimitT
Maybe (Unwrapped (UntypedPtr (PtrReprFor (ReprFor a)) 'Const))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message 'Const
-> Maybe (Ptr 'Const)
-> LimitT
Maybe (Unwrapped (Untyped ('Ptr (PtrReprFor (ReprFor a))) 'Const))
forall (r :: Maybe PtrRepr) (m :: * -> *) (mut :: Mutability).
(IsPtrRepr r, ReadCtx m mut) =>
Message mut
-> Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr r) mut))
R.fromPtr @(R.PtrReprFor (R.ReprFor a)) (Unwrapped (Struct 'Const) -> Message 'Const
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @U.Struct Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
Unwrapped (Struct 'Const)
root)
LimitT
Maybe (Unwrapped (UntypedPtr (PtrReprFor (ReprFor a)) 'Const))
-> (Unwrapped (UntypedPtr (PtrReprFor (ReprFor a)) 'Const)
-> Raw a 'Const)
-> LimitT Maybe (Raw a 'Const)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Unwrapped (UntypedPtr (PtrReprFor (ReprFor a)) 'Const)
-> Raw a 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw