Safe Haskell | None |
---|---|
Language | Haskell2010 |
- Type-level descriptions of wire representations.
- Mapping representations to value types from Capnp.Untyped
- Mapping types to their wire representations.
- Relating the representations of lists & their elements.
- Working with wire-encoded values
- Working with lists
- Working with pointers
- Allocating values
- Shorthands for types
This module provides facilities for working with the wire
representations of capnproto objects at the type level. The most
central part of this module is the Repr
type.
Recommended reading: https://capnproto.org/encoding.html
Synopsis
- data Repr
- data PtrRepr
- data ListRepr where
- data NormalListRepr where
- data DataSz
- type family Untyped (mut :: Mutability) (r :: Repr) :: Type where ...
- type family UntypedData (sz :: DataSz) :: Type where ...
- type family UntypedPtr (mut :: Mutability) (r :: Maybe PtrRepr) :: Type where ...
- type family UntypedSomePtr (mut :: Mutability) (r :: PtrRepr) :: Type where ...
- type family UntypedList (mut :: Mutability) (r :: Maybe ListRepr) :: Type where ...
- type family UntypedSomeList (mut :: Mutability) (r :: ListRepr) :: Type where ...
- type family ReprFor (a :: Type) :: Repr
- type family PtrReprFor (r :: Repr) :: Maybe PtrRepr where ...
- type family ElemRepr (rl :: ListRepr) :: Repr where ...
- type family ListReprFor (e :: Repr) :: ListRepr where ...
- class Element (r :: Repr) where
- fromElement :: forall m mut. ReadCtx m mut => Message mut -> Untyped mut (ElemRepr (ListReprFor r)) -> m (Untyped mut r)
- toElement :: Untyped mut r -> Untyped mut (ElemRepr (ListReprFor r))
- newtype Raw (mut :: Mutability) (a :: Type) = Raw {}
- data List a
- length :: Raw mut (List a) -> Int
- index :: forall a m mut. (ReadCtx m mut, Element (ReprFor a)) => Int -> Raw mut (List a) -> m (Raw mut a)
- setIndex :: forall a m s. (RWCtx m s, Element (ReprFor a)) => Raw ('Mut s) a -> Int -> Raw ('Mut s) (List a) -> m ()
- class IsPtrRepr (r :: Maybe PtrRepr) where
- class IsListPtrRepr (r :: ListRepr) where
- rToList :: UntypedSomeList mut r -> List mut
- rFromList :: ReadCtx m mut => List mut -> m (UntypedSomeList mut r)
- rFromListMsg :: ReadCtx m mut => Message mut -> m (UntypedSomeList mut r)
- class Allocate (r :: PtrRepr) where
- type IsStruct a = ReprFor a ~ 'Ptr ('Just 'Struct)
- type IsCap a = ReprFor a ~ 'Ptr ('Just 'Cap)
- type IsPtr a = (ReprFor a ~ 'Ptr (PtrReprFor (ReprFor a)), IsPtrRepr (PtrReprFor (ReprFor a)))
Type-level descriptions of wire representations.
A Repr
describes a wire representation for a value. This is
mostly used at the type level (using DataKinds); types are
parametrized over representations.
Information about the representation of a pointer type
Cap | Capability pointer. |
List (Maybe ListRepr) | List pointer. |
Struct | A struct (or group). |
Instances
Information about the representation of a list type.
ListNormal :: NormalListRepr -> ListRepr | A "normal" list |
ListComposite :: ListRepr |
Instances
Show ListRepr Source # | |
AllocateNormalList r => Allocate ('List ('Just ('ListNormal r))) Source # | |
Defined in Capnp.Repr alloc :: RWCtx m s => Message ('Mut s) -> AllocHint ('List ('Just ('ListNormal r))) -> m (UntypedSomePtr ('Mut s) ('List ('Just ('ListNormal r)))) Source # | |
Allocate ('List ('Just 'ListComposite)) Source # | |
Defined in Capnp.Repr alloc :: RWCtx m s => Message ('Mut s) -> AllocHint ('List ('Just 'ListComposite)) -> m (UntypedSomePtr ('Mut s) ('List ('Just 'ListComposite))) Source # | |
IsPtrRepr ('Just ('List ('Nothing :: Maybe ListRepr))) Source # | |
IsListPtrRepr r => IsPtrRepr ('Just ('List ('Just r))) Source # | |
type AllocHint ('List ('Just ('ListNormal r))) Source # | |
Defined in Capnp.Repr | |
type AllocHint ('List ('Just 'ListComposite)) Source # | |
Defined in Capnp.Repr |
data NormalListRepr where Source #
Information about the representation of a normal (non-composite) list.
ListData :: DataSz -> NormalListRepr | |
ListPtr :: NormalListRepr |
Instances
Show NormalListRepr Source # | |
Defined in Capnp.Repr showsPrec :: Int -> NormalListRepr -> ShowS # show :: NormalListRepr -> String # showList :: [NormalListRepr] -> ShowS # |
The size of a non-pointer type. SzN
represents an N
-bit value.
Mapping representations to value types from Capnp.Untyped
type family Untyped (mut :: Mutability) (r :: Repr) :: Type where ... Source #
Untyped mut r
is an untyped value with representation r
stored in
a message with mutability mut
.
Untyped mut ('Data sz) = UntypedData sz | |
Untyped mut ('Ptr ptr) = UntypedPtr mut ptr |
type family UntypedData (sz :: DataSz) :: Type where ... Source #
UntypedData sz
is an untyped value with size sz
.
UntypedData 'Sz0 = () | |
UntypedData 'Sz1 = Bool | |
UntypedData 'Sz8 = Word8 | |
UntypedData 'Sz16 = Word16 | |
UntypedData 'Sz32 = Word32 | |
UntypedData 'Sz64 = Word64 |
type family UntypedPtr (mut :: Mutability) (r :: Maybe PtrRepr) :: Type where ... Source #
Like Untyped
, but for pointers only.
UntypedPtr mut 'Nothing = Maybe (Ptr mut) | |
UntypedPtr mut ('Just r) = UntypedSomePtr mut r |
type family UntypedSomePtr (mut :: Mutability) (r :: PtrRepr) :: Type where ... Source #
Like UntypedPtr
, but doesn't allow AnyPointers.
UntypedSomePtr mut 'Struct = Struct mut | |
UntypedSomePtr mut 'Cap = Cap mut | |
UntypedSomePtr mut ('List r) = UntypedList mut r |
type family UntypedList (mut :: Mutability) (r :: Maybe ListRepr) :: Type where ... Source #
Like Untyped
, but for lists only.
UntypedList mut 'Nothing = List mut | |
UntypedList mut ('Just r) = UntypedSomeList mut r |
type family UntypedSomeList (mut :: Mutability) (r :: ListRepr) :: Type where ... Source #
Like UntypedList
, but doesn't allow AnyLists.
UntypedSomeList mut r = ListOf mut (Untyped mut (ElemRepr r)) |
Mapping types to their wire representations.
type family ReprFor (a :: Type) :: Repr Source #
denotes the Cap'n Proto wire represent of the type ReprFor
aa
.
Instances
type family PtrReprFor (r :: Repr) :: Maybe PtrRepr where ... Source #
PtrReprFor r
extracts the pointer represnetation in r; undefined if
r is not a pointer representation.
PtrReprFor ('Ptr pr) = pr |
Relating the representations of lists & their elements.
type family ElemRepr (rl :: ListRepr) :: Repr where ... Source #
ElemRepr r
is the representation of elements of lists with
representation r
.
ElemRepr 'ListComposite = 'Ptr ('Just 'Struct) | |
ElemRepr ('ListNormal 'ListPtr) = 'Ptr 'Nothing | |
ElemRepr ('ListNormal ('ListData sz)) = 'Data sz |
type family ListReprFor (e :: Repr) :: ListRepr where ... Source #
ListReprFor e
is the representation of lists with elements
whose representation is e
.
ListReprFor ('Data sz) = 'ListNormal ('ListData sz) | |
ListReprFor ('Ptr ('Just 'Struct)) = 'ListComposite | |
ListReprFor ('Ptr a) = 'ListNormal 'ListPtr |
class Element (r :: Repr) where Source #
Element
supports converting between values of representation
and values of representation ElemRepr
(ListReprFor
r)r
.
At a glance, you might expect this to just be a no-op, but it is actually
*not* always the case that
; in the
case of pointer types, ElemRepr
(ListReprFor
r) ~ r
can contain arbitrary pointers,
so information is lost, and it is possible for the list to contain pointers
of the incorrect type. In this case, ListReprFor
rfromElement
will throw an error.
toElement
is more trivial.
fromElement :: forall m mut. ReadCtx m mut => Message mut -> Untyped mut (ElemRepr (ListReprFor r)) -> m (Untyped mut r) Source #
toElement :: Untyped mut r -> Untyped mut (ElemRepr (ListReprFor r)) Source #
Instances
Working with wire-encoded values
newtype Raw (mut :: Mutability) (a :: Type) Source #
A
is an Raw
mut aa
embedded in a capnproto message with mutability
mut
.
Instances
ReprFor a ~ 'Ptr ('Just 'Struct) => ToStruct mut (Raw mut a) Source # | |
ReprFor a ~ 'Ptr ('Just 'Struct) => FromStruct mut (Raw mut a) Source # | |
Defined in Capnp.Repr | |
(IsPtrRepr r, ReprFor a ~ 'Ptr r) => ToPtr s (Raw ('Mut s) a) Source # | |
(IsPtrRepr r, ReprFor a ~ 'Ptr r) => FromPtr mut (Raw mut a) Source # | |
Eq (Untyped mut (ReprFor a)) => Eq (Raw mut a) Source # | |
Read (Untyped mut (ReprFor a)) => Read (Raw mut a) Source # | |
Show (Untyped mut (ReprFor a)) => Show (Raw mut a) Source # | |
Generic (Untyped mut (ReprFor a)) => Generic (Raw mut a) Source # | |
MessageDefault (Raw 'Const a) 'Const => Default (Raw 'Const a) Source # | |
Defined in Capnp.Repr | |
MessageDefault (Untyped mut (ReprFor a)) mut => MessageDefault (Raw mut a) mut Source # | |
Defined in Capnp.Repr | |
HasMessage (Untyped mut (ReprFor a)) mut => HasMessage (Raw mut a) mut Source # | |
type Rep (Raw mut a) Source # | |
Defined in Capnp.Repr |
Working with lists
A phantom type denoting capnproto lists of type a
.
Instances
index :: forall a m mut. (ReadCtx m mut, Element (ReprFor a)) => Int -> Raw mut (List a) -> m (Raw mut a) Source #
gets the index
i listi
th element of the list.
setIndex :: forall a m s. (RWCtx m s, Element (ReprFor a)) => Raw ('Mut s) a -> Int -> Raw ('Mut s) (List a) -> m () Source #
sets the setIndex
value i listi
th element of list
to value
.
Working with pointers
class IsPtrRepr (r :: Maybe PtrRepr) where Source #
Operations on types with pointer representations.
toPtr :: Untyped mut ('Ptr r) -> Maybe (Ptr mut) Source #
Convert an untyped value of this representation to an AnyPointer.
fromPtr :: ReadCtx m mut => Message mut -> Maybe (Ptr mut) -> m (Untyped mut ('Ptr r)) Source #
Extract a value with this representation from an AnyPointer, failing if the pointer is the wrong type for this representation.
class IsListPtrRepr (r :: ListRepr) where Source #
Operations on types with list representations.
rToList :: UntypedSomeList mut r -> List mut Source #
Convert an untyped value of this representation to an AnyList.
rFromList :: ReadCtx m mut => List mut -> m (UntypedSomeList mut r) Source #
Extract a value with this representation from an AnyList, failing if the list is the wrong type for this representation.
rFromListMsg :: ReadCtx m mut => Message mut -> m (UntypedSomeList mut r) Source #
Create a zero-length value with this representation, living in the provided message.
Instances
Allocating values
class Allocate (r :: PtrRepr) where Source #
An instace of
specifies how to allocate a value with a given representation.
This only makes sense for pointers of course, so it is defined on PtrRepr. Of the well-kinded
types, only Allocate
'List 'Nothing
is missing an instance.
Extra information needed to allocate a value:
- For structs, the sizes of the sections.
- For capabilities, the client to attach to the messages.
- For lists, the length, and for composite lists, the struct sizes as well.
alloc :: RWCtx m s => Message ('Mut s) -> AllocHint r -> m (UntypedSomePtr ('Mut s) r) Source #
Allocate a value of the given type.
Instances
Allocate 'Cap Source # | |
Allocate 'Struct Source # | |
AllocateNormalList r => Allocate ('List ('Just ('ListNormal r))) Source # | |
Defined in Capnp.Repr alloc :: RWCtx m s => Message ('Mut s) -> AllocHint ('List ('Just ('ListNormal r))) -> m (UntypedSomePtr ('Mut s) ('List ('Just ('ListNormal r)))) Source # | |
Allocate ('List ('Just 'ListComposite)) Source # | |
Defined in Capnp.Repr alloc :: RWCtx m s => Message ('Mut s) -> AllocHint ('List ('Just 'ListComposite)) -> m (UntypedSomePtr ('Mut s) ('List ('Just 'ListComposite))) Source # |
Shorthands for types
type IsPtr a = (ReprFor a ~ 'Ptr (PtrReprFor (ReprFor a)), IsPtrRepr (PtrReprFor (ReprFor a))) Source #
Constraint that a
is a pointer type.