{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Module: Capnp.Accessors
-- Description: Functions for accessing parts of messaages.
module Capnp.Accessors
  ( readField,
    getField,
    setField,
    newField,
    hasField,
    encodeField,
    parseField,
    setVariant,
    initVariant,
    encodeVariant,
    structWhich,
    unionWhich,
    structUnion,
    unionStruct,
  )
where

import qualified Capnp.Classes as C
import qualified Capnp.Fields as F
import Capnp.Message (Mutability (..))
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 :: 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 (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 <- forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
index) Unwrapped (Untyped (ReprFor a) mut)
struct
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw forall a b. (a -> b) -> a -> b
$ forall a. IsWord a => Word64 -> a
C.fromWord forall a b. (a -> b) -> a -> b
$ ((Word64
word forall a. Bits a => a -> a -> a
.&. Word64
mask) forall a. Bits a => a -> Int -> a
`shiftR` forall a b. (Integral a, Num b) => a -> b
fromIntegral BitCount
shift) forall a. Bits a => a -> a -> a
`xor` Word64
defaultValue
    F.PtrField Word16
index ->
      forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
index) Unwrapped (Untyped (ReprFor a) mut)
struct forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (pr :: Maybe PtrRepr).
(ReprFor b ~ 'Ptr pr, IsPtrRepr pr) =>
Maybe (Ptr mut) -> m (Raw b mut)
readPtrField
    FieldLoc k (ReprFor b)
F.GroupField ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor a) mut)
struct
    FieldLoc k (ReprFor b)
F.VoidField ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 :: forall (pr :: Maybe PtrRepr).
(ReprFor b ~ 'Ptr pr, IsPtrRepr pr) =>
Maybe (Ptr mut) -> m (Raw b mut)
readPtrField Maybe (Ptr mut)
ptr =
      forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @U.Struct Unwrapped (Untyped (ReprFor a) 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 :: forall (m :: * -> *) (mut :: Mutability) a b.
(ReadCtx m mut, IsStruct a, IsPtr b) =>
Field 'Slot a b -> Raw a mut -> m Bool
hasField (F.Field (F.PtrField Word16
index)) (R.Raw Unwrapped (Untyped (ReprFor a) mut)
struct) =
  forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
index) Unwrapped (Untyped (ReprFor a) 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 :: forall a b (sz :: DataSz) bp.
(IsStruct a, ReprFor b ~ 'Data sz, Parse b bp) =>
Field 'Slot a b -> Raw a 'Const -> bp
getField Field 'Slot a b
field Raw a 'Const
struct =
  forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT forall a. Bounded a => a
maxBound forall a b. (a -> b) -> a -> b
$
      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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 :: forall a b (m :: * -> *) s.
(IsStruct a, RWCtx m s) =>
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 ->
      forall (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
DataFieldLoc sz -> m ()
setDataField DataFieldLoc a
fieldLoc
    F.PtrField Word16
index ->
      forall (pr :: Maybe PtrRepr).
(ReprFor b ~ 'Ptr pr, IsPtrRepr pr) =>
Word16
-> Unwrapped (UntypedPtr pr ('Mut s)) -> Struct ('Mut s) -> m ()
setPtrField Word16
index Unwrapped (Untyped (ReprFor b) ('Mut s))
value Unwrapped (Untyped (ReprFor a) ('Mut s))
struct
    FieldLoc 'Slot (ReprFor b)
F.VoidField ->
      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 :: 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 pr ('Mut s))
value Struct ('Mut s)
struct =
      forall (m :: * -> *) s.
(ReadCtx m ('Mut s), WriteCtx m s) =>
Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
U.setPtr (forall (r :: Maybe PtrRepr) (mut :: Mutability).
IsPtrRepr r =>
Unwrapped (Untyped ('Ptr r) mut) -> Maybe (Ptr mut)
R.toPtr @pr Unwrapped (UntypedPtr pr ('Mut s))
value) (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 :: forall (sz :: DataSz).
(ReprFor b ~ 'Data sz, IsWord (UntypedData sz)) =>
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 <- forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
index) Unwrapped (Untyped (ReprFor a) ('Mut s))
struct
      let valueWord :: Word64
valueWord = forall a. IsWord a => a -> Word64
C.toWord Unwrapped (Untyped (ReprFor b) ('Mut s))
value forall a. Bits a => a -> a -> a
`xor` Word64
defaultValue
          newWord :: Word64
newWord =
            (Word64
oldWord forall a. Bits a => a -> a -> a
.&. forall a. Bits a => a -> a
complement Word64
mask)
              forall a. Bits a => a -> a -> a
.|. (Word64
valueWord forall a. Bits a => a -> Int -> a
`shiftL` forall a b. (Integral a, Num b) => a -> b
fromIntegral BitCount
shift)
      forall (m :: * -> *) s.
(ReadCtx m ('Mut s), WriteCtx m s) =>
Word64 -> Int -> Struct ('Mut s) -> m ()
U.setData Word64
newWord (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
index) Unwrapped (Untyped (ReprFor a) ('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 :: forall a b (m :: * -> *) s.
(IsStruct a, Allocate b, RWCtx m s) =>
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 <- 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 (forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @(R.Raw a) Raw a ('Mut s)
parent)
  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
  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 :: 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
parsed Raw a ('Mut s)
struct = do
  Raw b ('Mut s)
encoded <- forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw t ('Mut s))
C.encode (forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @(R.Raw a) Raw a ('Mut s)
struct) bp
parsed
  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 :: forall a b bp (m :: * -> *) (k :: FieldKind).
(IsStruct a, Parse b bp, ReadCtx m 'Const) =>
Field k a b -> Raw a 'Const -> m bp
parseField Field k a b
field Raw a 'Const
raw =
  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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 :: forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
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
  forall a b (m :: * -> *) s.
(IsStruct a, RWCtx m s) =>
Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
setField (forall a. HasUnion a => Field 'Slot a Word16
F.unionField @a) (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Word16
tagValue) Raw a ('Mut s)
struct
  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 :: forall a b (m :: * -> *) s bp.
(HasUnion a, Parse b bp, RWCtx m s) =>
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
  forall a b (m :: * -> *) s.
(IsStruct a, RWCtx m s) =>
Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
setField (forall a. HasUnion a => Field 'Slot a Word16
F.unionField @a) (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Word16
tagValue) Raw a ('Mut s)
struct
  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 :: forall a b (m :: * -> *) s.
(HasUnion a, RWCtx m s) =>
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
  forall a b (m :: * -> *) s.
(IsStruct a, RWCtx m s) =>
Field 'Slot a b -> Raw b ('Mut s) -> Raw a ('Mut s) -> m ()
setField (forall a. HasUnion a => Field 'Slot a Word16
F.unionField @a) (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Word16
tagValue) Raw a ('Mut s)
struct
  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 :: forall a (mut :: Mutability).
HasUnion a =>
Raw a mut -> Raw (Which a) mut
structUnion = coerce :: forall a b. Coercible a b => a -> b
coerce

-- | Get the struct enclosing an anonymous union.
unionStruct :: F.HasUnion a => R.Raw (F.Which a) mut -> R.Raw a mut
unionStruct :: forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
unionStruct = coerce :: forall a b. Coercible a b => a -> b
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 :: forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw a mut -> m (RawWhich a mut)
structWhich Raw a mut
struct = do
  R.Raw Unwrapped (Untyped (ReprFor Word16) mut)
tagValue <- 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 (forall a. HasUnion a => Field 'Slot a Word16
F.unionField @a) Raw a mut
struct
  forall a (m :: * -> *) (mut :: Mutability).
(HasUnion a, ReadCtx m mut) =>
Word16 -> Raw a mut -> m (RawWhich a mut)
F.internalWhich 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 :: forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw (Which a) mut -> m (RawWhich a mut)
unionWhich = forall a (mut :: Mutability) (m :: * -> *).
(ReadCtx m mut, HasUnion a) =>
Raw a mut -> m (RawWhich a mut)
structWhich forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
HasUnion a =>
Raw (Which a) mut -> Raw a mut
unionStruct