{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE EmptyDataDeriving     #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
-- |
-- Module: Capnp.New.Basics
-- Description: Handling of "basic" capnp datatypes.
--
-- This module contains phantom types for built-in Cap'n Proto
-- types, analogous to the phantom types generated for structs
-- by the code generator. It also defines applicable type class
-- instances.
module Capnp.New.Basics where

-- XXX: I(zenhack) don't know how to supply an explicit
-- export list here, since we have instances of data families
-- and I don't know what to call the instances to get all of the
-- constructors.

import qualified Capnp.Errors        as E
import qualified Capnp.Message       as M
import qualified Capnp.New.Classes   as C
import qualified Capnp.Repr          as R
import qualified Capnp.Untyped       as U
import           Control.Monad       (when)
import           Control.Monad.Catch (throwM)
import qualified Data.ByteString     as BS
import           Data.Foldable       (for_)
import qualified Data.Text           as T
import qualified Data.Text.Encoding  as TE
import qualified Data.Vector         as V
import           Data.Word
import           GHC.Prim            (coerce)

-- | The Cap'n Proto @Text@ type.
data Text

-- | The Cap'n Proto @Data@ type.
data Data

-- | A Cap'n Proto @AnyPointer@, i.e. an arbitrary pointer with unknown schema.
data AnyPointer

-- | A Cap'n Proto @List@ with unknown element type.
data AnyList

-- | A Cap'n Proto struct of unknown type.
data AnyStruct

-- | A Cap'n Proto capability with unknown interfaces.
data Capability

type instance R.ReprFor Data = R.ReprFor (R.List Word8)
type instance R.ReprFor Text = R.ReprFor (R.List Word8)
type instance R.ReprFor AnyPointer = 'R.Ptr 'Nothing
type instance R.ReprFor (Maybe AnyPointer) = 'R.Ptr 'Nothing
type instance R.ReprFor AnyList = 'R.Ptr ('Just ('R.List 'Nothing))
type instance R.ReprFor AnyStruct = 'R.Ptr ('Just 'R.Struct)
type instance R.ReprFor Capability = 'R.Ptr ('Just 'R.Cap)

data instance C.Parsed AnyPointer
    = PtrStruct (C.Parsed AnyStruct)
    | PtrList (C.Parsed AnyList)
    | PtrCap M.Client
    deriving(Int -> Parsed AnyPointer -> ShowS
[Parsed AnyPointer] -> ShowS
Parsed AnyPointer -> String
(Int -> Parsed AnyPointer -> ShowS)
-> (Parsed AnyPointer -> String)
-> ([Parsed AnyPointer] -> ShowS)
-> Show (Parsed AnyPointer)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parsed AnyPointer] -> ShowS
$cshowList :: [Parsed AnyPointer] -> ShowS
show :: Parsed AnyPointer -> String
$cshow :: Parsed AnyPointer -> String
showsPrec :: Int -> Parsed AnyPointer -> ShowS
$cshowsPrec :: Int -> Parsed AnyPointer -> ShowS
Show, Parsed AnyPointer -> Parsed AnyPointer -> Bool
(Parsed AnyPointer -> Parsed AnyPointer -> Bool)
-> (Parsed AnyPointer -> Parsed AnyPointer -> Bool)
-> Eq (Parsed AnyPointer)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parsed AnyPointer -> Parsed AnyPointer -> Bool
$c/= :: Parsed AnyPointer -> Parsed AnyPointer -> Bool
== :: Parsed AnyPointer -> Parsed AnyPointer -> Bool
$c== :: Parsed AnyPointer -> Parsed AnyPointer -> Bool
Eq)

instance C.Parse (Maybe AnyPointer) (Maybe (C.Parsed AnyPointer)) where
    parse :: Raw 'Const (Maybe AnyPointer) -> m (Maybe (Parsed AnyPointer))
parse (R.Raw Untyped 'Const (ReprFor (Maybe AnyPointer))
ptr) = case Untyped 'Const (ReprFor (Maybe AnyPointer))
ptr of
        Untyped 'Const (ReprFor (Maybe AnyPointer))
Nothing -> Maybe (Parsed AnyPointer) -> m (Maybe (Parsed AnyPointer))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Parsed AnyPointer)
forall a. Maybe a
Nothing
        Just _  -> Parsed AnyPointer -> Maybe (Parsed AnyPointer)
forall a. a -> Maybe a
Just (Parsed AnyPointer -> Maybe (Parsed AnyPointer))
-> m (Parsed AnyPointer) -> m (Maybe (Parsed AnyPointer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const AnyPointer -> m (Parsed AnyPointer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor AnyPointer) -> Raw 'Const AnyPointer
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw Untyped 'Const (ReprFor (Maybe AnyPointer))
Untyped 'Const (ReprFor AnyPointer)
ptr :: R.Raw 'M.Const AnyPointer)

    encode :: Message ('Mut s)
-> Maybe (Parsed AnyPointer) -> m (Raw ('Mut s) (Maybe AnyPointer))
encode Message ('Mut s)
msg Maybe (Parsed AnyPointer)
value = Maybe (Ptr ('Mut s)) -> Raw ('Mut s) (Maybe AnyPointer)
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw (Maybe (Ptr ('Mut s)) -> Raw ('Mut s) (Maybe AnyPointer))
-> m (Maybe (Ptr ('Mut s))) -> m (Raw ('Mut s) (Maybe AnyPointer))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe (Parsed AnyPointer)
value of
        Maybe (Parsed AnyPointer)
Nothing -> Maybe (Ptr ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr ('Mut s))
forall a. Maybe a
Nothing
        Just Parsed AnyPointer
v  -> Raw ('Mut s) AnyPointer -> Maybe (Ptr ('Mut s))
coerce (Raw ('Mut s) AnyPointer -> Maybe (Ptr ('Mut s)))
-> m (Raw ('Mut s) AnyPointer) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> Parsed AnyPointer -> m (Raw ('Mut s) AnyPointer)
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg Parsed AnyPointer
v

instance C.Parse AnyPointer (C.Parsed AnyPointer) where
    parse :: Raw 'Const AnyPointer -> m (Parsed AnyPointer)
parse (R.Raw Untyped 'Const (ReprFor AnyPointer)
ptr) = case Untyped 'Const (ReprFor AnyPointer)
ptr of
        Just (U.PtrCap cap)       -> Client -> Parsed AnyPointer
PtrCap (Client -> Parsed AnyPointer) -> m Client -> m (Parsed AnyPointer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const Capability -> m Client
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor Capability) -> Raw 'Const Capability
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw Cap 'Const
Untyped 'Const (ReprFor Capability)
cap)
        Just (U.PtrList list)     -> Parsed AnyList -> Parsed AnyPointer
PtrList (Parsed AnyList -> Parsed AnyPointer)
-> m (Parsed AnyList) -> m (Parsed AnyPointer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const AnyList -> m (Parsed AnyList)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor AnyList) -> Raw 'Const AnyList
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw List 'Const
Untyped 'Const (ReprFor AnyList)
list)
        Just (U.PtrStruct struct) -> Parsed AnyStruct -> Parsed AnyPointer
PtrStruct (Parsed AnyStruct -> Parsed AnyPointer)
-> m (Parsed AnyStruct) -> m (Parsed AnyPointer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const AnyStruct -> m (Parsed AnyStruct)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor AnyStruct) -> Raw 'Const AnyStruct
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw Struct 'Const
Untyped 'Const (ReprFor AnyStruct)
struct)
        Untyped 'Const (ReprFor AnyPointer)
Nothing                   ->
            Error -> m (Parsed AnyPointer)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m (Parsed AnyPointer)) -> Error -> m (Parsed AnyPointer)
forall a b. (a -> b) -> a -> b
$ String -> Error
E.SchemaViolationError String
"Non-nullable AnyPointer was null"

    encode :: Message ('Mut s)
-> Parsed AnyPointer -> m (Raw ('Mut s) AnyPointer)
encode Message ('Mut s)
msg Parsed AnyPointer
value = Maybe (Ptr ('Mut s)) -> Raw ('Mut s) AnyPointer
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw (Maybe (Ptr ('Mut s)) -> Raw ('Mut s) AnyPointer)
-> m (Maybe (Ptr ('Mut s))) -> m (Raw ('Mut s) AnyPointer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Parsed AnyPointer
value of
        PtrCap cap       -> Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Raw ('Mut s) Capability -> Ptr ('Mut s))
-> Raw ('Mut s) Capability
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cap ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). Cap mut -> Ptr mut
U.PtrCap (Cap ('Mut s) -> Ptr ('Mut s))
-> (Raw ('Mut s) Capability -> Cap ('Mut s))
-> Raw ('Mut s) Capability
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) Capability -> Cap ('Mut s)
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) Capability -> Maybe (Ptr ('Mut s)))
-> m (Raw ('Mut s) Capability) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Client -> m (Raw ('Mut s) Capability)
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg Client
cap
        PtrList list     -> Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Raw ('Mut s) AnyList -> Ptr ('Mut s))
-> Raw ('Mut s) AnyList
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). List mut -> Ptr mut
U.PtrList (List ('Mut s) -> Ptr ('Mut s))
-> (Raw ('Mut s) AnyList -> List ('Mut s))
-> Raw ('Mut s) AnyList
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) AnyList -> List ('Mut s)
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) AnyList -> Maybe (Ptr ('Mut s)))
-> m (Raw ('Mut s) AnyList) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Parsed AnyList -> m (Raw ('Mut s) AnyList)
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg Parsed AnyList
list
        PtrStruct struct -> Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Raw ('Mut s) AnyStruct -> Ptr ('Mut s))
-> Raw ('Mut s) AnyStruct
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). Struct mut -> Ptr mut
U.PtrStruct (Struct ('Mut s) -> Ptr ('Mut s))
-> (Raw ('Mut s) AnyStruct -> Struct ('Mut s))
-> Raw ('Mut s) AnyStruct
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) AnyStruct -> Struct ('Mut s)
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) AnyStruct -> Maybe (Ptr ('Mut s)))
-> m (Raw ('Mut s) AnyStruct) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Parsed AnyStruct -> m (Raw ('Mut s) AnyStruct)
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg Parsed AnyStruct
struct

instance C.AllocateList AnyPointer where
    type ListAllocHint AnyPointer = Int

instance C.EstimateListAlloc AnyPointer (C.Parsed AnyPointer)

instance C.AllocateList (Maybe AnyPointer) where
    type ListAllocHint (Maybe AnyPointer) = Int

instance C.EstimateListAlloc (Maybe AnyPointer) (Maybe (C.Parsed AnyPointer))

data instance C.Parsed AnyStruct = Struct
    { Parsed AnyStruct -> Vector Word64
structData :: V.Vector Word64
    , Parsed AnyStruct -> Vector (Maybe (Parsed AnyPointer))
structPtrs :: V.Vector (Maybe (C.Parsed AnyPointer))
    }
    deriving(Int -> Parsed AnyStruct -> ShowS
[Parsed AnyStruct] -> ShowS
Parsed AnyStruct -> String
(Int -> Parsed AnyStruct -> ShowS)
-> (Parsed AnyStruct -> String)
-> ([Parsed AnyStruct] -> ShowS)
-> Show (Parsed AnyStruct)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parsed AnyStruct] -> ShowS
$cshowList :: [Parsed AnyStruct] -> ShowS
show :: Parsed AnyStruct -> String
$cshow :: Parsed AnyStruct -> String
showsPrec :: Int -> Parsed AnyStruct -> ShowS
$cshowsPrec :: Int -> Parsed AnyStruct -> ShowS
Show, Parsed AnyStruct -> Parsed AnyStruct -> Bool
(Parsed AnyStruct -> Parsed AnyStruct -> Bool)
-> (Parsed AnyStruct -> Parsed AnyStruct -> Bool)
-> Eq (Parsed AnyStruct)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parsed AnyStruct -> Parsed AnyStruct -> Bool
$c/= :: Parsed AnyStruct -> Parsed AnyStruct -> Bool
== :: Parsed AnyStruct -> Parsed AnyStruct -> Bool
$c== :: Parsed AnyStruct -> Parsed AnyStruct -> Bool
Eq)

instance C.Parse AnyStruct (C.Parsed AnyStruct) where
    parse :: Raw 'Const AnyStruct -> m (Parsed AnyStruct)
parse (R.Raw Untyped 'Const (ReprFor AnyStruct)
s) = Vector Word64
-> Vector (Maybe (Parsed AnyPointer)) -> Parsed AnyStruct
Struct
        (Vector Word64
 -> Vector (Maybe (Parsed AnyPointer)) -> Parsed AnyStruct)
-> m (Vector Word64)
-> m (Vector (Maybe (Parsed AnyPointer)) -> Parsed AnyStruct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> (Int -> m Word64) -> m (Vector Word64)
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM
                (WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount -> Int) -> WordCount -> Int
forall a b. (a -> b) -> a -> b
$ Struct 'Const -> WordCount
forall (msg :: Mutability). Struct msg -> WordCount
U.structWordCount Struct 'Const
Untyped 'Const (ReprFor AnyStruct)
s)
                (Int -> Struct 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
`U.getData` Struct 'Const
Untyped 'Const (ReprFor AnyStruct)
s)
        m (Vector (Maybe (Parsed AnyPointer)) -> Parsed AnyStruct)
-> m (Vector (Maybe (Parsed AnyPointer))) -> m (Parsed AnyStruct)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int
-> (Int -> m (Maybe (Parsed AnyPointer)))
-> m (Vector (Maybe (Parsed AnyPointer)))
forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM
                (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Struct 'Const -> Word16
forall (msg :: Mutability). Struct msg -> Word16
U.structPtrCount Struct 'Const
Untyped 'Const (ReprFor AnyStruct)
s)
                (\Int
i -> Int -> Struct 'Const -> m (Maybe (Ptr 'Const))
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr Int
i Struct 'Const
Untyped 'Const (ReprFor AnyStruct)
s m (Maybe (Ptr 'Const))
-> (Maybe (Ptr 'Const) -> m (Maybe (Parsed AnyPointer)))
-> m (Maybe (Parsed AnyPointer))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Raw 'Const (Maybe AnyPointer) -> m (Maybe (Parsed AnyPointer))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Raw 'Const (Maybe AnyPointer) -> m (Maybe (Parsed AnyPointer)))
-> (Maybe (Ptr 'Const) -> Raw 'Const (Maybe AnyPointer))
-> Maybe (Ptr 'Const)
-> m (Maybe (Parsed AnyPointer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Ptr 'Const) -> Raw 'Const (Maybe AnyPointer)
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw)

instance C.AllocateList AnyStruct where
    type ListAllocHint AnyStruct = (Int, R.AllocHint 'R.Struct)

instance C.EstimateListAlloc AnyStruct (C.Parsed AnyStruct) where
    estimateListAlloc :: Vector (Parsed AnyStruct) -> AllocHint (List AnyStruct)
estimateListAlloc Vector (Parsed AnyStruct)
structs =
        let len :: Int
len = Vector (Parsed AnyStruct) -> Int
forall a. Vector a -> Int
V.length Vector (Parsed AnyStruct)
structs
            nWords :: Int
nWords = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Parsed AnyStruct -> Int) -> [Parsed AnyStruct] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Vector Word64 -> Int
forall a. Vector a -> Int
V.length (Vector Word64 -> Int)
-> (Parsed AnyStruct -> Vector Word64) -> Parsed AnyStruct -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsed AnyStruct -> Vector Word64
structData) ([Parsed AnyStruct] -> [Int]) -> [Parsed AnyStruct] -> [Int]
forall a b. (a -> b) -> a -> b
$ Vector (Parsed AnyStruct) -> [Parsed AnyStruct]
forall a. Vector a -> [a]
V.toList Vector (Parsed AnyStruct)
structs
            nPtrs :: Int
nPtrs = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (Parsed AnyStruct -> Int) -> [Parsed AnyStruct] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Vector (Maybe (Parsed AnyPointer)) -> Int
forall a. Vector a -> Int
V.length (Vector (Maybe (Parsed AnyPointer)) -> Int)
-> (Parsed AnyStruct -> Vector (Maybe (Parsed AnyPointer)))
-> Parsed AnyStruct
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsed AnyStruct -> Vector (Maybe (Parsed AnyPointer))
structPtrs) ([Parsed AnyStruct] -> [Int]) -> [Parsed AnyStruct] -> [Int]
forall a b. (a -> b) -> a -> b
$ Vector (Parsed AnyStruct) -> [Parsed AnyStruct]
forall a. Vector a -> [a]
V.toList Vector (Parsed AnyStruct)
structs
        in
        (Int
len, (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nWords, Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nPtrs))

instance C.EstimateAlloc AnyStruct (C.Parsed AnyStruct) where
    estimateAlloc :: Parsed AnyStruct -> AllocHint AnyStruct
estimateAlloc Parsed AnyStruct
s =
        ( Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Vector Word64 -> Int
forall a. Vector a -> Int
V.length (Vector Word64 -> Int) -> Vector Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Parsed AnyStruct -> Vector Word64
structData Parsed AnyStruct
s
        , Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ Vector (Maybe (Parsed AnyPointer)) -> Int
forall a. Vector a -> Int
V.length (Vector (Maybe (Parsed AnyPointer)) -> Int)
-> Vector (Maybe (Parsed AnyPointer)) -> Int
forall a b. (a -> b) -> a -> b
$ Parsed AnyStruct -> Vector (Maybe (Parsed AnyPointer))
structPtrs Parsed AnyStruct
s
        )

instance C.Marshal AnyStruct (C.Parsed AnyStruct) where
    marshalInto :: Raw ('Mut s) AnyStruct -> Parsed AnyStruct -> m ()
marshalInto (R.Raw Untyped ('Mut s) (ReprFor AnyStruct)
raw) Parsed AnyStruct
s = do
        Vector Word64 -> (Int -> Word64 -> m ()) -> m ()
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (Int -> a -> m b) -> m ()
V.iforM_ (Parsed AnyStruct -> Vector Word64
structData Parsed AnyStruct
s) ((Int -> Word64 -> m ()) -> m ())
-> (Int -> Word64 -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i Word64
value -> do
            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
value Int
i Struct ('Mut s)
Untyped ('Mut s) (ReprFor AnyStruct)
raw
        Vector (Maybe (Parsed AnyPointer))
-> (Int -> Maybe (Parsed AnyPointer) -> m ()) -> m ()
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (Int -> a -> m b) -> m ()
V.iforM_ (Parsed AnyStruct -> Vector (Maybe (Parsed AnyPointer))
structPtrs Parsed AnyStruct
s) ((Int -> Maybe (Parsed AnyPointer) -> m ()) -> m ())
-> (Int -> Maybe (Parsed AnyPointer) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i Maybe (Parsed AnyPointer)
value -> do
            R.Raw Untyped ('Mut s) (ReprFor (Maybe AnyPointer))
ptr <- Message ('Mut s)
-> Maybe (Parsed AnyPointer) -> m (Raw ('Mut s) (Maybe AnyPointer))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode (Struct ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
U.message Struct ('Mut s)
Untyped ('Mut s) (ReprFor AnyStruct)
raw) Maybe (Parsed AnyPointer)
value
            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 Maybe (Ptr ('Mut s))
Untyped ('Mut s) (ReprFor (Maybe AnyPointer))
ptr Int
i Struct ('Mut s)
Untyped ('Mut s) (ReprFor AnyStruct)
raw

-- TODO(cleanup): It would be nice if we could reuse Capnp.Repr.Parsed.Parsed
-- here, but that would cause a circular import dependency.
type ParsedList a = V.Vector a

data instance C.Parsed AnyList
    = ListPtr (ParsedList (Maybe (C.Parsed AnyPointer)))
    | ListStruct (ParsedList (C.Parsed AnyStruct))
    | List0 (ParsedList ())
    | List1 (ParsedList Bool)
    | List8 (ParsedList Word8)
    | List16 (ParsedList Word16)
    | List32 (ParsedList Word32)
    | List64 (ParsedList Word64)
    deriving(Int -> Parsed AnyList -> ShowS
[Parsed AnyList] -> ShowS
Parsed AnyList -> String
(Int -> Parsed AnyList -> ShowS)
-> (Parsed AnyList -> String)
-> ([Parsed AnyList] -> ShowS)
-> Show (Parsed AnyList)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Parsed AnyList] -> ShowS
$cshowList :: [Parsed AnyList] -> ShowS
show :: Parsed AnyList -> String
$cshow :: Parsed AnyList -> String
showsPrec :: Int -> Parsed AnyList -> ShowS
$cshowsPrec :: Int -> Parsed AnyList -> ShowS
Show, Parsed AnyList -> Parsed AnyList -> Bool
(Parsed AnyList -> Parsed AnyList -> Bool)
-> (Parsed AnyList -> Parsed AnyList -> Bool)
-> Eq (Parsed AnyList)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parsed AnyList -> Parsed AnyList -> Bool
$c/= :: Parsed AnyList -> Parsed AnyList -> Bool
== :: Parsed AnyList -> Parsed AnyList -> Bool
$c== :: Parsed AnyList -> Parsed AnyList -> Bool
Eq)

instance C.Parse AnyList (C.Parsed AnyList) where
    parse :: Raw 'Const AnyList -> m (Parsed AnyList)
parse (R.Raw Untyped 'Const (ReprFor AnyList)
list) = case Untyped 'Const (ReprFor AnyList)
list of
        U.List0 l      -> ParsedList () -> Parsed AnyList
List0 (ParsedList () -> Parsed AnyList)
-> m (ParsedList ()) -> m (Parsed AnyList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const (List ()) -> m (ParsedList ())
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor (List ())) -> Raw 'Const (List ())
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw ListOf 'Const ()
Untyped 'Const (ReprFor (List ()))
l)
        U.List1 l      -> ParsedList Bool -> Parsed AnyList
List1 (ParsedList Bool -> Parsed AnyList)
-> m (ParsedList Bool) -> m (Parsed AnyList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const (List Bool) -> m (ParsedList Bool)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor (List Bool)) -> Raw 'Const (List Bool)
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw ListOf 'Const Bool
Untyped 'Const (ReprFor (List Bool))
l)
        U.List8 l      -> ParsedList Word8 -> Parsed AnyList
List8 (ParsedList Word8 -> Parsed AnyList)
-> m (ParsedList Word8) -> m (Parsed AnyList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const (List Word8) -> m (ParsedList Word8)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor (List Word8)) -> Raw 'Const (List Word8)
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw ListOf 'Const Word8
Untyped 'Const (ReprFor (List Word8))
l)
        U.List16 l     -> ParsedList Word16 -> Parsed AnyList
List16 (ParsedList Word16 -> Parsed AnyList)
-> m (ParsedList Word16) -> m (Parsed AnyList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const (List Word16) -> m (ParsedList Word16)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor (List Word16)) -> Raw 'Const (List Word16)
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw ListOf 'Const Word16
Untyped 'Const (ReprFor (List Word16))
l)
        U.List32 l     -> ParsedList Word32 -> Parsed AnyList
List32 (ParsedList Word32 -> Parsed AnyList)
-> m (ParsedList Word32) -> m (Parsed AnyList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const (List Word32) -> m (ParsedList Word32)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor (List Word32)) -> Raw 'Const (List Word32)
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw ListOf 'Const Word32
Untyped 'Const (ReprFor (List Word32))
l)
        U.List64 l     -> Vector Word64 -> Parsed AnyList
List64 (Vector Word64 -> Parsed AnyList)
-> m (Vector Word64) -> m (Parsed AnyList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const (List Word64) -> m (Vector Word64)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor (List Word64)) -> Raw 'Const (List Word64)
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw ListOf 'Const Word64
Untyped 'Const (ReprFor (List Word64))
l)
        U.ListPtr l    -> Vector (Maybe (Parsed AnyPointer)) -> Parsed AnyList
ListPtr (Vector (Maybe (Parsed AnyPointer)) -> Parsed AnyList)
-> m (Vector (Maybe (Parsed AnyPointer))) -> m (Parsed AnyList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const (List (Maybe AnyPointer))
-> m (Vector (Maybe (Parsed AnyPointer)))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor (List (Maybe AnyPointer)))
-> Raw 'Const (List (Maybe AnyPointer))
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw ListOf 'Const (Maybe (Ptr 'Const))
Untyped 'Const (ReprFor (List (Maybe AnyPointer)))
l)
        U.ListStruct l -> Vector (Parsed AnyStruct) -> Parsed AnyList
ListStruct (Vector (Parsed AnyStruct) -> Parsed AnyList)
-> m (Vector (Parsed AnyStruct)) -> m (Parsed AnyList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Raw 'Const (List AnyStruct) -> m (Vector (Parsed AnyStruct))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw 'Const t -> m p
C.parse (Untyped 'Const (ReprFor (List AnyStruct))
-> Raw 'Const (List AnyStruct)
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw ListOf 'Const (Struct 'Const)
Untyped 'Const (ReprFor (List AnyStruct))
l)

    encode :: Message ('Mut s) -> Parsed AnyList -> m (Raw ('Mut s) AnyList)
encode Message ('Mut s)
msg Parsed AnyList
list = List ('Mut s) -> Raw ('Mut s) AnyList
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw (List ('Mut s) -> Raw ('Mut s) AnyList)
-> m (List ('Mut s)) -> m (Raw ('Mut s) AnyList)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Parsed AnyList
list of
        List0 l      -> ListOf ('Mut s) () -> List ('Mut s)
forall (mut :: Mutability). ListOf mut () -> List mut
U.List0 (ListOf ('Mut s) () -> List ('Mut s))
-> (Raw ('Mut s) (List ()) -> ListOf ('Mut s) ())
-> Raw ('Mut s) (List ())
-> List ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) (List ()) -> ListOf ('Mut s) ()
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) (List ()) -> List ('Mut s))
-> m (Raw ('Mut s) (List ())) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> ParsedList () -> m (Raw ('Mut s) (List ()))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg ParsedList ()
l
        List1 l      -> ListOf ('Mut s) Bool -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Bool -> List mut
U.List1 (ListOf ('Mut s) Bool -> List ('Mut s))
-> (Raw ('Mut s) (List Bool) -> ListOf ('Mut s) Bool)
-> Raw ('Mut s) (List Bool)
-> List ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) (List Bool) -> ListOf ('Mut s) Bool
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) (List Bool) -> List ('Mut s))
-> m (Raw ('Mut s) (List Bool)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> ParsedList Bool -> m (Raw ('Mut s) (List Bool))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg ParsedList Bool
l
        List8 l      -> ListOf ('Mut s) Word8 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word8 -> List mut
U.List8 (ListOf ('Mut s) Word8 -> List ('Mut s))
-> (Raw ('Mut s) (List Word8) -> ListOf ('Mut s) Word8)
-> Raw ('Mut s) (List Word8)
-> List ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) (List Word8) -> ListOf ('Mut s) Word8
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) (List Word8) -> List ('Mut s))
-> m (Raw ('Mut s) (List Word8)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ParsedList Word8 -> m (Raw ('Mut s) (List Word8))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg ParsedList Word8
l
        List16 l     -> ListOf ('Mut s) Word16 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word16 -> List mut
U.List16 (ListOf ('Mut s) Word16 -> List ('Mut s))
-> (Raw ('Mut s) (List Word16) -> ListOf ('Mut s) Word16)
-> Raw ('Mut s) (List Word16)
-> List ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) (List Word16) -> ListOf ('Mut s) Word16
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) (List Word16) -> List ('Mut s))
-> m (Raw ('Mut s) (List Word16)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ParsedList Word16 -> m (Raw ('Mut s) (List Word16))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg ParsedList Word16
l
        List32 l     -> ListOf ('Mut s) Word32 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word32 -> List mut
U.List32 (ListOf ('Mut s) Word32 -> List ('Mut s))
-> (Raw ('Mut s) (List Word32) -> ListOf ('Mut s) Word32)
-> Raw ('Mut s) (List Word32)
-> List ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) (List Word32) -> ListOf ('Mut s) Word32
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) (List Word32) -> List ('Mut s))
-> m (Raw ('Mut s) (List Word32)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> ParsedList Word32 -> m (Raw ('Mut s) (List Word32))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg ParsedList Word32
l
        List64 l     -> ListOf ('Mut s) Word64 -> List ('Mut s)
forall (mut :: Mutability). ListOf mut Word64 -> List mut
U.List64 (ListOf ('Mut s) Word64 -> List ('Mut s))
-> (Raw ('Mut s) (List Word64) -> ListOf ('Mut s) Word64)
-> Raw ('Mut s) (List Word64)
-> List ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) (List Word64) -> ListOf ('Mut s) Word64
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) (List Word64) -> List ('Mut s))
-> m (Raw ('Mut s) (List Word64)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Vector Word64 -> m (Raw ('Mut s) (List Word64))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg Vector Word64
l
        ListPtr l    -> ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> List ('Mut s)
forall (mut :: Mutability).
ListOf mut (Maybe (Ptr mut)) -> List mut
U.ListPtr (ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> List ('Mut s))
-> (Raw ('Mut s) (List (Maybe AnyPointer))
    -> ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
-> Raw ('Mut s) (List (Maybe AnyPointer))
-> List ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) (List (Maybe AnyPointer))
-> ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) (List (Maybe AnyPointer)) -> List ('Mut s))
-> m (Raw ('Mut s) (List (Maybe AnyPointer))) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> Vector (Maybe (Parsed AnyPointer))
-> m (Raw ('Mut s) (List (Maybe AnyPointer)))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg Vector (Maybe (Parsed AnyPointer))
l
        ListStruct l -> ListOf ('Mut s) (Struct ('Mut s)) -> List ('Mut s)
forall (mut :: Mutability). ListOf mut (Struct mut) -> List mut
U.ListStruct (ListOf ('Mut s) (Struct ('Mut s)) -> List ('Mut s))
-> (Raw ('Mut s) (List AnyStruct)
    -> ListOf ('Mut s) (Struct ('Mut s)))
-> Raw ('Mut s) (List AnyStruct)
-> List ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) (List AnyStruct) -> ListOf ('Mut s) (Struct ('Mut s))
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) (List AnyStruct) -> List ('Mut s))
-> m (Raw ('Mut s) (List AnyStruct)) -> m (List ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> Vector (Parsed AnyStruct) -> m (Raw ('Mut s) (List AnyStruct))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw ('Mut s) t)
C.encode Message ('Mut s)
msg Vector (Parsed AnyStruct)
l

instance C.Parse Capability M.Client where
    parse :: Raw 'Const Capability -> m Client
parse (R.Raw Untyped 'Const (ReprFor Capability)
cap) = Cap 'Const -> m Client
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Cap mut -> m Client
U.getClient Cap 'Const
Untyped 'Const (ReprFor Capability)
cap
    encode :: Message ('Mut s) -> Client -> m (Raw ('Mut s) Capability)
encode Message ('Mut s)
msg Client
client = Cap ('Mut s) -> Raw ('Mut s) Capability
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw (Cap ('Mut s) -> Raw ('Mut s) Capability)
-> m (Cap ('Mut s)) -> m (Raw ('Mut s) Capability)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Client -> m (Cap ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Client -> m (Cap ('Mut s))
U.appendCap Message ('Mut s)
msg Client
client

instance C.Allocate Text where
    type AllocHint Text = Int
    new :: AllocHint Text -> Message ('Mut s) -> m (Raw ('Mut s) Text)
new AllocHint Text
len Message ('Mut s)
msg = ListOf ('Mut s) Word8 -> Raw ('Mut s) Text
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw (ListOf ('Mut s) Word8 -> Raw ('Mut s) Text)
-> m (ListOf ('Mut s) Word8) -> m (Raw ('Mut s) Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word8)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word8)
U.allocList8 Message ('Mut s)
msg (Int
AllocHint Text
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

instance C.AllocateList Text where
    type ListAllocHint Text = Int
instance C.EstimateListAlloc Text T.Text

instance C.Parse Text T.Text where
    parse :: Raw 'Const Text -> m Text
parse (R.Raw Untyped 'Const (ReprFor Text)
list) =
        let len :: Int
len = ListOf 'Const Word8 -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf 'Const Word8
Untyped 'Const (ReprFor Text)
list in
        if Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
            -- We are somewhat lenient here; technically this is invalid, as there is
            -- no null terminator (see logic below, which is dead code because of
            -- this check. But to avoid this we really need to expose nullability
            -- in the API, so for now we just fudge it.
            Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
        else (do
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Error -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m ()) -> Error -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Error
E.SchemaViolationError
                String
"Text is not NUL-terminated (list of bytes has length 0)"
            Word8
lastByte <- Int -> ListOf 'Const Word8 -> m Word8
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ListOf 'Const Word8
Untyped 'Const (ReprFor Text)
list
            Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
lastByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Error -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m ()) -> Error -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Error
E.SchemaViolationError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$
                String
"Text is not NUL-terminated (last byte is " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
lastByte String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
            ByteString
bytes <- Int -> ByteString -> ByteString
BS.take (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListOf 'Const Word8 -> m ByteString
forall (m :: * -> *).
ReadCtx m 'Const =>
ListOf 'Const Word8 -> m ByteString
U.rawBytes ListOf 'Const Word8
Untyped 'Const (ReprFor Text)
list
            case ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
bytes of
                Left UnicodeException
e  -> Error -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m Text) -> Error -> m Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> Error
E.InvalidUtf8Error UnicodeException
e
                Right Text
v -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v)
    encode :: Message ('Mut s) -> Text -> m (Raw ('Mut s) Text)
encode Message ('Mut s)
msg Text
value = do
        let bytes :: ByteString
bytes = Text -> ByteString
TE.encodeUtf8 Text
value
        raw :: Raw ('Mut s) Text
raw@(R.Raw Untyped ('Mut s) (ReprFor Text)
untyped)  <- AllocHint Text -> Message ('Mut s) -> m (Raw ('Mut s) Text)
forall a (m :: * -> *) s.
(Allocate a, RWCtx m s) =>
AllocHint a -> Message ('Mut s) -> m (Raw ('Mut s) a)
C.new @Text (ByteString -> Int
BS.length ByteString
bytes) Message ('Mut s)
msg
        Raw ('Mut s) Data -> ByteString -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw ('Mut s) t -> p -> m ()
C.marshalInto @Data (Untyped ('Mut s) (ReprFor Data) -> Raw ('Mut s) Data
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw Untyped ('Mut s) (ReprFor Data)
Untyped ('Mut s) (ReprFor Text)
untyped) ByteString
bytes
        Raw ('Mut s) Text -> m (Raw ('Mut s) Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Raw ('Mut s) Text
raw

-- Instances for Data
instance C.Parse Data BS.ByteString where
    parse :: Raw 'Const Data -> m ByteString
parse = ListOf 'Const Word8 -> m ByteString
forall (m :: * -> *).
ReadCtx m 'Const =>
ListOf 'Const Word8 -> m ByteString
U.rawBytes (ListOf 'Const Word8 -> m ByteString)
-> (Raw 'Const Data -> ListOf 'Const Word8)
-> Raw 'Const Data
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw 'Const Data -> ListOf 'Const Word8
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw

instance C.Allocate Data where
    type AllocHint Data = Int
    new :: AllocHint Data -> Message ('Mut s) -> m (Raw ('Mut s) Data)
new AllocHint Data
len Message ('Mut s)
msg = ListOf ('Mut s) Word8 -> Raw ('Mut s) Data
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw (ListOf ('Mut s) Word8 -> Raw ('Mut s) Data)
-> m (ListOf ('Mut s) Word8) -> m (Raw ('Mut s) Data)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word8)
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Mut s) Word8)
U.allocList8 Message ('Mut s)
msg Int
AllocHint Data
len

instance C.EstimateAlloc Data BS.ByteString where
    estimateAlloc :: ByteString -> AllocHint Data
estimateAlloc = ByteString -> Int
ByteString -> AllocHint Data
BS.length

instance C.AllocateList Data where
    type ListAllocHint Data = Int
instance C.EstimateListAlloc Data BS.ByteString

instance C.Marshal Data BS.ByteString where
    marshalInto :: Raw ('Mut s) Data -> ByteString -> m ()
marshalInto (R.Raw Untyped ('Mut s) (ReprFor Data)
list) ByteString
bytes =
        [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> m ()) -> m ()) -> (Int -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Int
i ->
            Word8 -> Int -> ListOf ('Mut s) Word8 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf ('Mut s) a -> m ()
U.setIndex (ByteString -> Int -> Word8
BS.index ByteString
bytes Int
i) Int
i ListOf ('Mut s) Word8
Untyped ('Mut s) (ReprFor Data)
list

-- Instances for AnyStruct
instance C.Allocate AnyStruct where
    type AllocHint AnyStruct = (Word16, Word16)
    new :: AllocHint AnyStruct
-> Message ('Mut s) -> m (Raw ('Mut s) AnyStruct)
new (nWords, nPtrs) Message ('Mut s)
msg = Struct ('Mut s) -> Raw ('Mut s) AnyStruct
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw (Struct ('Mut s) -> Raw ('Mut s) AnyStruct)
-> m (Struct ('Mut s)) -> m (Raw ('Mut s) AnyStruct)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Word16 -> Word16 -> m (Struct ('Mut s))
U.allocStruct Message ('Mut s)
msg Word16
nWords Word16
nPtrs