{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
-- | Module: Capnp.New.Accessors
-- Description: Functions for accessing parts of messaages.
module Capnp.New.Accessors
    ( readField
    , getField
    , setField
    , newField
    , hasField
    , encodeField
    , parseField
    , setVariant
    , initVariant
    , encodeVariant
    , structWhich
    , unionWhich
    , structUnion
    , unionStruct
    ) where


import qualified Capnp.Fields         as F
import           Capnp.Message        (Mutability(..))
import qualified Capnp.New.Classes    as C
import qualified Capnp.Repr           as R
import           Capnp.TraversalLimit (evalLimitT)
import qualified Capnp.Untyped        as U
import           Data.Bits
import           Data.Maybe           (fromJust, isJust)
import           Data.Word
import           GHC.Prim             (coerce)

{-# INLINE readField #-}
-- | Read the value of a field of a struct.
readField
    ::  forall k a b mut m.
        ( R.IsStruct a
        , U.ReadCtx m mut
        )
    => F.Field k a b
    -> R.Raw a mut
    -> m (R.Raw b mut)
readField :: Field k a b -> Raw a mut -> m (Raw b mut)
readField (F.Field FieldLoc k (ReprFor b)
field) (R.Raw Unwrapped (Untyped (ReprFor a) mut)
struct) =
    case FieldLoc k (ReprFor b)
field of
        F.DataField F.DataFieldLoc{ BitCount
shift :: forall (sz :: DataSz). DataFieldLoc sz -> BitCount
shift :: BitCount
shift, Word16
index :: forall (sz :: DataSz). DataFieldLoc sz -> Word16
index :: Word16
index, Word64
mask :: forall (sz :: DataSz). DataFieldLoc sz -> Word64
mask :: Word64
mask, Word64
defaultValue :: forall (sz :: DataSz). DataFieldLoc sz -> Word64
defaultValue :: Word64
defaultValue } -> do
            Word64
word <- Int -> Struct mut -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
index) Unwrapped (Untyped (ReprFor a) mut)
Struct mut
struct
            Raw b mut -> m (Raw b mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Raw b mut -> m (Raw b mut)) -> Raw b mut -> m (Raw b mut)
forall a b. (a -> b) -> a -> b
$ Unwrapped (Untyped (ReprFor b) mut) -> Raw b mut
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw (Unwrapped (Untyped (ReprFor b) mut) -> Raw b mut)
-> Unwrapped (Untyped (ReprFor b) mut) -> Raw b mut
forall a b. (a -> b) -> a -> b
$ Word64 -> UntypedData a
forall a. IsWord a => Word64 -> a
C.fromWord (Word64 -> UntypedData a) -> Word64 -> UntypedData a
forall a b. (a -> b) -> a -> b
$ ((Word64
word Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
mask) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` BitCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral BitCount
shift) Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
defaultValue
        F.PtrField Word16
index ->
            Int -> Struct mut -> m (Maybe (Ptr mut))
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
index) Unwrapped (Untyped (ReprFor a) mut)
Struct mut
struct m (Maybe (Ptr mut))
-> (Maybe (Ptr mut) -> m (Raw b mut)) -> m (Raw b mut)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (Ptr mut) -> m (Raw b mut)
forall (pr :: Maybe PtrRepr).
(ReprFor b ~ 'Ptr pr, IsPtrRepr pr) =>
Maybe (Ptr mut) -> m (Raw b mut)
readPtrField
        FieldLoc k (ReprFor b)
F.GroupField ->
            Raw b mut -> m (Raw b mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Raw b mut -> m (Raw b mut)) -> Raw b mut -> m (Raw b mut)
forall a b. (a -> b) -> a -> b
$ Unwrapped (Untyped (ReprFor b) mut) -> Raw b mut
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor a) mut)
Unwrapped (Untyped (ReprFor b) mut)
struct
        FieldLoc k (ReprFor b)
F.VoidField ->
            Raw b mut -> m (Raw b mut)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Raw b mut -> m (Raw b mut)) -> Raw b mut -> m (Raw b mut)
forall a b. (a -> b) -> a -> b
$ Unwrapped (Untyped (ReprFor b) mut) -> Raw b mut
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw ()
  where
    -- This is broken out because the type checker needs some extra help:
    readPtrField
        :: forall pr.
        ( R.ReprFor b ~ 'R.Ptr pr
        , R.IsPtrRepr pr
        ) => Maybe (U.Ptr mut) -> m (R.Raw b mut)
    readPtrField :: Maybe (Ptr mut) -> m (Raw b mut)
readPtrField Maybe (Ptr mut)
ptr =
        Unwrapped (UntypedPtr pr mut) -> Raw b mut
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw (Unwrapped (UntypedPtr pr mut) -> Raw b mut)
-> m (Unwrapped (UntypedPtr pr mut)) -> m (Raw b mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message mut
-> Maybe (Ptr mut) -> m (Unwrapped (Untyped ('Ptr pr) mut))
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 @pr (Unwrapped (Struct mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @U.Struct Unwrapped (Untyped (ReprFor a) mut)
Unwrapped (Struct mut)
struct) Maybe (Ptr mut)
ptr

-- | Return whether the specified field is present. Only applicable for pointer
-- fields.
hasField ::
    ( U.ReadCtx m mut
    , R.IsStruct a
    , R.IsPtr b
    ) => F.Field 'F.Slot a b -> R.Raw a mut -> m Bool
hasField :: Field 'Slot a b -> Raw a mut -> m Bool
hasField (F.Field (F.PtrField Word16
index)) (R.Raw Unwrapped (Untyped (ReprFor a) mut)
struct) =
    Maybe (Ptr mut) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Ptr mut) -> Bool) -> m (Maybe (Ptr mut)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Struct mut -> m (Maybe (Ptr mut))
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
index) Unwrapped (Untyped (ReprFor a) mut)
Struct mut
struct

{-# INLINE getField #-}
-- | Like 'readField', but:
--
-- * Doesn't need the monadic context; can be used in pure code.
-- * Only works for immutable values.
-- * Only works for fields in the struct's data section.
getField
    ::  ( R.IsStruct a
        , R.ReprFor b ~ 'R.Data sz
        , C.Parse b bp
        )
    => F.Field 'F.Slot a b
    -> R.Raw a 'Const
    -> bp
getField :: Field 'Slot a b -> Raw a 'Const -> bp
getField Field 'Slot a b
field Raw a 'Const
struct =
    Maybe bp -> bp
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe bp -> bp) -> Maybe bp -> bp
forall a b. (a -> b) -> a -> b
$ WordCount -> LimitT Maybe bp -> Maybe bp
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
forall a. Bounded a => a
maxBound (LimitT Maybe bp -> Maybe bp) -> LimitT Maybe bp -> Maybe bp
forall a b. (a -> b) -> a -> b
$
        Field 'Slot a b -> Raw a 'Const -> LimitT Maybe (Raw b 'Const)
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 'Slot a b
field Raw a 'Const
struct LimitT Maybe (Raw b 'Const)
-> (Raw b 'Const -> LimitT Maybe bp) -> LimitT Maybe bp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Raw b 'Const -> LimitT Maybe bp
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse

{-# INLINE setField #-}
-- | Set a struct field to a value. Not usable for group fields.
setField ::
    forall a b m s.
    ( R.IsStruct a
    , U.RWCtx m s
    ) => F.Field 'F.Slot a b -> R.Raw b ('Mut s) -> R.Raw a ('Mut s) -> m ()
setField :: Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
setField (F.Field FieldLoc 'Slot (ReprFor b)
field) (R.Raw Unwrapped (Untyped (ReprFor b) ('Mut s))
value) (R.Raw Unwrapped (Untyped (ReprFor a) ('Mut s))
struct) =
    case FieldLoc 'Slot (ReprFor b)
field of
        F.DataField DataFieldLoc a
fieldLoc ->
            DataFieldLoc a -> m ()
forall (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
DataFieldLoc sz -> m ()
setDataField DataFieldLoc a
fieldLoc
        F.PtrField Word16
index ->
            Word16
-> Unwrapped (UntypedPtr a ('Mut s)) -> Struct ('Mut s) -> m ()
forall (pr :: Maybe PtrRepr).
(ReprFor b ~ 'Ptr pr, IsPtrRepr pr) =>
Word16
-> Unwrapped (UntypedPtr pr ('Mut s)) -> Struct ('Mut s) -> m ()
setPtrField Word16
index Unwrapped (UntypedPtr a ('Mut s))
Unwrapped (Untyped (ReprFor b) ('Mut s))
value Unwrapped (Untyped (ReprFor a) ('Mut s))
Struct ('Mut s)
struct
        FieldLoc 'Slot (ReprFor b)
F.VoidField ->
            () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  where
    -- This was originally broken out because the type checker needs some extra
    -- help, but it's probably more readable this way anyway.
    setPtrField
        :: forall pr.
        ( R.ReprFor b ~ 'R.Ptr pr
        , R.IsPtrRepr pr
        ) => Word16 -> U.Unwrapped (R.UntypedPtr pr ('Mut s)) -> U.Struct ('Mut s) -> m ()
    setPtrField :: Word16
-> Unwrapped (UntypedPtr pr ('Mut s)) -> Struct ('Mut s) -> m ()
setPtrField Word16
index Unwrapped (UntypedPtr pr ('Mut s))
value Struct ('Mut s)
struct =
        Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m ('Mut s), WriteCtx m s) =>
Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
U.setPtr (Unwrapped (Untyped ('Ptr pr) ('Mut s)) -> Maybe (Ptr ('Mut s))
forall (r :: Maybe PtrRepr) (mut :: Mutability).
IsPtrRepr r =>
Unwrapped (Untyped ('Ptr r) mut) -> Maybe (Ptr mut)
R.toPtr @pr Unwrapped (UntypedPtr pr ('Mut s))
Unwrapped (Untyped ('Ptr pr) ('Mut s))
value) (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
index) Struct ('Mut s)
struct

    setDataField
        :: forall sz.
        ( R.ReprFor b ~ 'R.Data sz
        , C.IsWord (R.UntypedData sz)
        ) => F.DataFieldLoc sz -> m ()
    setDataField :: DataFieldLoc sz -> m ()
setDataField F.DataFieldLoc{ BitCount
shift :: BitCount
shift :: forall (sz :: DataSz). DataFieldLoc sz -> BitCount
shift, Word16
index :: Word16
index :: forall (sz :: DataSz). DataFieldLoc sz -> Word16
index, Word64
mask :: Word64
mask :: forall (sz :: DataSz). DataFieldLoc sz -> Word64
mask, Word64
defaultValue :: Word64
defaultValue :: forall (sz :: DataSz). DataFieldLoc sz -> Word64
defaultValue } = do
        Word64
oldWord <- Int -> Struct ('Mut s) -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
index) Unwrapped (Untyped (ReprFor a) ('Mut s))
Struct ('Mut s)
struct
        let valueWord :: Word64
valueWord = UntypedData sz -> Word64
forall a. IsWord a => a -> Word64
C.toWord UntypedData sz
Unwrapped (Untyped (ReprFor b) ('Mut s))
value Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
`xor` Word64
defaultValue
            newWord :: Word64
newWord = (Word64
oldWord Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64 -> Word64
forall a. Bits a => a -> a
complement Word64
mask)
                  Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word64
valueWord 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 -> Int -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m ('Mut s), WriteCtx m s) =>
Word64 -> Int -> Struct ('Mut s) -> m ()
U.setData Word64
newWord (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
index) Unwrapped (Untyped (ReprFor a) ('Mut s))
Struct ('Mut s)
struct

-- | Allocate space for the value of a field, and return it.
newField ::
    forall a b m s.
    ( R.IsStruct a
    , C.Allocate b
    , U.RWCtx m s
    ) => F.Field 'F.Slot a b -> C.AllocHint b -> R.Raw a ('Mut s) -> m (R.Raw b ('Mut s))
newField :: Field 'Slot a b
-> AllocHint b -> Raw a ('Mut s) -> m (Raw b ('Mut s))
newField Field 'Slot a b
field AllocHint b
hint Raw a ('Mut s)
parent = do
    Raw b ('Mut s)
value <- AllocHint b -> Message ('Mut s) -> m (Raw b ('Mut s))
forall a (m :: * -> *) s.
(Allocate a, RWCtx m s) =>
AllocHint a -> Message ('Mut s) -> m (Raw a ('Mut s))
C.new @b AllocHint b
hint (Unwrapped (Raw a ('Mut s)) -> Message ('Mut s)
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @(R.Raw a) Unwrapped (Raw a ('Mut s))
Raw a ('Mut s)
parent)
    Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
forall a b (m :: * -> *) s.
(IsStruct a, RWCtx m s) =>
Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
setField Field 'Slot a b
field Raw b ('Mut s)
value Raw a ('Mut s)
parent
    Raw b ('Mut s) -> m (Raw b ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Raw b ('Mut s)
value

-- | Marshal a parsed value into a struct's field.
encodeField ::
    forall a b m s bp.
    ( R.IsStruct a
    , C.Parse b bp
    , U.RWCtx m s
    ) => F.Field 'F.Slot a b -> bp -> R.Raw a ('Mut s) -> m ()
encodeField :: Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
encodeField Field 'Slot a b
field bp
parsed Raw a ('Mut s)
struct = do
    Raw b ('Mut s)
encoded <- Message ('Mut s) -> bp -> m (Raw b ('Mut s))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw t ('Mut s))
C.encode (Unwrapped (Raw a ('Mut s)) -> Message ('Mut s)
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @(R.Raw a) Unwrapped (Raw a ('Mut s))
Raw a ('Mut s)
struct) bp
parsed
    Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
forall a b (m :: * -> *) s.
(IsStruct a, RWCtx m s) =>
Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
setField Field 'Slot a b
field Raw b ('Mut s)
encoded Raw a ('Mut s)
struct

-- | parse a struct's field and return its parsed form.
parseField ::
    ( R.IsStruct a
    , C.Parse b bp
    , U.ReadCtx m 'Const
    ) => F.Field k a b -> R.Raw a 'Const -> m bp
parseField :: Field k a b -> Raw a 'Const -> m bp
parseField Field k a b
field Raw a 'Const
raw =
    Field k a b -> Raw a 'Const -> m (Raw b 'Const)
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 Raw a 'Const
raw m (Raw b 'Const) -> (Raw b 'Const -> m bp) -> m bp
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Raw b 'Const -> m bp
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse

-- | Set the struct's anonymous union to the given variant, with the
-- supplied value as its argument. Not applicable for variants whose
-- argument is a group; use 'initVariant' instead.
setVariant
    :: forall a b m s.
    ( F.HasUnion a
    , U.RWCtx m s
    ) => F.Variant 'F.Slot a b -> R.Raw a ('Mut s) -> R.Raw b ('Mut s) -> m ()
setVariant :: Variant 'Slot a b -> Raw a ('Mut s) -> Raw b ('Mut s) -> m ()
setVariant F.Variant{Field 'Slot a b
field :: forall (k :: FieldKind) a b. Variant k a b -> Field k a b
field :: Field 'Slot a b
field, Word16
tagValue :: forall (k :: FieldKind) a b. Variant k a b -> Word16
tagValue :: Word16
tagValue} Raw a ('Mut s)
struct Raw b ('Mut s)
value = do
    Field 'Slot a Word16
-> Raw Word16 ('Mut s) -> Raw a ('Mut s) -> m ()
forall a b (m :: * -> *) s.
(IsStruct a, RWCtx m s) =>
Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
setField (HasUnion a => Field 'Slot a Word16
forall a. HasUnion a => Field 'Slot a Word16
F.unionField @a) (Unwrapped (Untyped (ReprFor Word16) ('Mut s))
-> Raw Word16 ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Word16
Unwrapped (Untyped (ReprFor Word16) ('Mut s))
tagValue) Raw a ('Mut s)
struct
    Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
forall a b (m :: * -> *) s.
(IsStruct a, RWCtx m s) =>
Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
setField Field 'Slot a b
field Raw b ('Mut s)
value Raw a ('Mut s)
struct

-- | Set the struct's anonymous union to the given variant, marshalling
-- the supplied value into the message to be its argument. Not applicable
-- for variants whose argument is a group; use 'initVariant' instead.
encodeVariant
    :: forall a b m s bp.
    ( F.HasUnion a
    , C.Parse b bp
    , U.RWCtx m s
    ) => F.Variant 'F.Slot a b -> bp -> R.Raw a ('Mut s) -> m ()
encodeVariant :: Variant 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
encodeVariant F.Variant{Field 'Slot a b
field :: Field 'Slot a b
field :: forall (k :: FieldKind) a b. Variant k a b -> Field k a b
field, Word16
tagValue :: Word16
tagValue :: forall (k :: FieldKind) a b. Variant k a b -> Word16
tagValue} bp
value Raw a ('Mut s)
struct = do
    Field 'Slot a Word16
-> Raw Word16 ('Mut s) -> Raw a ('Mut s) -> m ()
forall a b (m :: * -> *) s.
(IsStruct a, RWCtx m s) =>
Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
setField (HasUnion a => Field 'Slot a Word16
forall a. HasUnion a => Field 'Slot a Word16
F.unionField @a) (Unwrapped (Untyped (ReprFor Word16) ('Mut s))
-> Raw Word16 ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Word16
Unwrapped (Untyped (ReprFor Word16) ('Mut s))
tagValue) Raw a ('Mut s)
struct
    Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
forall a b (m :: * -> *) s bp.
(IsStruct a, Parse b bp, RWCtx m s) =>
Field 'Slot a b -> bp -> Raw a ('Mut s) -> m ()
encodeField Field 'Slot a b
field bp
value Raw a ('Mut s)
struct

-- | Set the struct's anonymous union to the given variant, returning
-- the variant's argument, which must be a group (for non-group fields,
-- use 'setVariant' or 'encodeVariant'.
initVariant
    :: forall a b m s. (F.HasUnion a, U.RWCtx m s)
    => F.Variant 'F.Group a b -> R.Raw a ('Mut s) -> m (R.Raw b ('Mut s))
initVariant :: Variant 'Group a b -> Raw a ('Mut s) -> m (Raw b ('Mut s))
initVariant F.Variant{Field 'Group a b
field :: Field 'Group a b
field :: forall (k :: FieldKind) a b. Variant k a b -> Field k a b
field, Word16
tagValue :: Word16
tagValue :: forall (k :: FieldKind) a b. Variant k a b -> Word16
tagValue} Raw a ('Mut s)
struct = do
    Field 'Slot a Word16
-> Raw Word16 ('Mut s) -> Raw a ('Mut s) -> m ()
forall a b (m :: * -> *) s.
(IsStruct a, RWCtx m s) =>
Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
setField (HasUnion a => Field 'Slot a Word16
forall a. HasUnion a => Field 'Slot a Word16
F.unionField @a) (Unwrapped (Untyped (ReprFor Word16) ('Mut s))
-> Raw Word16 ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Word16
Unwrapped (Untyped (ReprFor Word16) ('Mut s))
tagValue) Raw a ('Mut s)
struct
    Field 'Group a b -> Raw a ('Mut s) -> m (Raw b ('Mut s))
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 'Group a b
field Raw a ('Mut s)
struct

-- | Get the anonymous union for a struct.
structUnion :: F.HasUnion a => R.Raw a mut -> R.Raw (F.Which a) mut
structUnion :: Raw a mut -> Raw (Which a) mut
structUnion = Raw a mut -> Raw (Which a) mut
coerce

-- | Get the struct enclosing an anonymous union.
unionStruct :: F.HasUnion a => R.Raw (F.Which a) mut -> R.Raw a mut
unionStruct :: Raw (Which a) mut -> Raw a mut
unionStruct = Raw (Which a) mut -> Raw a mut
coerce

-- | Get a non-opaque view on the struct's anonymous union, which
-- can be used to pattern match on.
structWhich :: forall a mut m. (U.ReadCtx m mut, F.HasUnion a) => R.Raw a mut -> m (F.RawWhich a mut)
structWhich :: Raw a mut -> m (RawWhich a mut)
structWhich Raw a mut
struct = do
    R.Raw Unwrapped (Untyped (ReprFor Word16) mut)
tagValue <- Field 'Slot a Word16 -> Raw a mut -> m (Raw Word16 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 (HasUnion a => Field 'Slot a Word16
forall a. HasUnion a => Field 'Slot a Word16
F.unionField @a) Raw a mut
struct
    Word16 -> Raw a mut -> m (RawWhich a mut)
forall a (m :: * -> *) (mut :: Mutability).
(HasUnion a, ReadCtx m mut) =>
Word16 -> Raw a mut -> m (RawWhich a mut)
F.internalWhich Word16
Unwrapped (Untyped (ReprFor Word16) mut)
tagValue Raw a mut
struct

-- | Get a non-opaque view on the anonymous union, which can be
-- used to pattern match on.
unionWhich :: forall a mut m. (U.ReadCtx m mut, F.HasUnion a) => R.Raw (F.Which a) mut -> m (F.RawWhich a mut)
unionWhich :: Raw (Which a) mut -> m (RawWhich a mut)
unionWhich = Raw a mut -> m (RawWhich a mut)
forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw a mut -> m (RawWhich a mut)
structWhich (Raw a mut -> m (RawWhich a mut))
-> (Raw (Which a) mut -> Raw a mut)
-> Raw (Which a) mut
-> m (RawWhich a mut)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw (Which a) mut -> Raw a mut
forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
unionStruct