{-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE EmptyDataDeriving     #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# 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 (MonadThrow, throwM)
import qualified Data.ByteString     as BS
import           Data.Default        (Default(..))
import           Data.Foldable       (foldl', 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.Generics        (Generic)
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, (forall x. Parsed AnyPointer -> Rep (Parsed AnyPointer) x)
-> (forall x. Rep (Parsed AnyPointer) x -> Parsed AnyPointer)
-> Generic (Parsed AnyPointer)
forall x. Rep (Parsed AnyPointer) x -> Parsed AnyPointer
forall x. Parsed AnyPointer -> Rep (Parsed AnyPointer) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed AnyPointer) x -> Parsed AnyPointer
$cfrom :: forall x. Parsed AnyPointer -> Rep (Parsed AnyPointer) x
Generic)

instance C.Parse (Maybe AnyPointer) (Maybe (C.Parsed AnyPointer)) where
    parse :: Raw (Maybe AnyPointer) 'Const -> m (Maybe (Parsed AnyPointer))
parse (R.Raw Unwrapped (Untyped (ReprFor (Maybe AnyPointer)) 'Const)
ptr) = case Unwrapped (Untyped (ReprFor (Maybe AnyPointer)) 'Const)
ptr of
        Unwrapped (Untyped (ReprFor (Maybe AnyPointer)) 'Const)
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 AnyPointer 'Const -> m (Parsed AnyPointer)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor AnyPointer) 'Const)
-> Raw AnyPointer 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor (Maybe AnyPointer)) 'Const)
Unwrapped (Untyped (ReprFor AnyPointer) 'Const)
ptr :: R.Raw AnyPointer 'M.Const)

    encode :: Message ('Mut s)
-> Maybe (Parsed AnyPointer) -> m (Raw (Maybe AnyPointer) ('Mut s))
encode Message ('Mut s)
msg Maybe (Parsed AnyPointer)
value = Maybe (Ptr ('Mut s)) -> Raw (Maybe AnyPointer) ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw (Maybe (Ptr ('Mut s)) -> Raw (Maybe AnyPointer) ('Mut s))
-> m (Maybe (Ptr ('Mut s))) -> m (Raw (Maybe AnyPointer) ('Mut s))
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 AnyPointer ('Mut s) -> Maybe (Ptr ('Mut s))
coerce (Raw AnyPointer ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (Raw AnyPointer ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s)
-> Parsed AnyPointer -> m (Raw AnyPointer ('Mut s))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw t ('Mut s))
C.encode Message ('Mut s)
msg Parsed AnyPointer
v

instance C.Parse AnyPointer (C.Parsed AnyPointer) where
    parse :: Raw AnyPointer 'Const -> m (Parsed AnyPointer)
parse (R.Raw Unwrapped (Untyped (ReprFor AnyPointer) 'Const)
ptr) = case Unwrapped (Untyped (ReprFor AnyPointer) 'Const)
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 Capability 'Const -> m Client
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor Capability) 'Const)
-> Raw Capability 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor Capability) 'Const)
Cap 'Const
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 AnyList 'Const -> m (Parsed AnyList)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor AnyList) 'Const) -> Raw AnyList 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor AnyList) 'Const)
List 'Const
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 AnyStruct 'Const -> m (Parsed AnyStruct)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
-> Raw AnyStruct 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
Struct 'Const
struct)
        Unwrapped (Untyped (ReprFor AnyPointer) 'Const)
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 AnyPointer ('Mut s))
encode Message ('Mut s)
msg Parsed AnyPointer
value = Maybe (Ptr ('Mut s)) -> Raw AnyPointer ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw (Maybe (Ptr ('Mut s)) -> Raw AnyPointer ('Mut s))
-> m (Maybe (Ptr ('Mut s))) -> m (Raw AnyPointer ('Mut s))
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 Capability ('Mut s) -> Ptr ('Mut s))
-> Raw Capability ('Mut s)
-> 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 Capability ('Mut s) -> Cap ('Mut s))
-> Raw Capability ('Mut s)
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw Capability ('Mut s) -> Cap ('Mut s)
forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw (Raw Capability ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (Raw Capability ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Client -> m (Raw Capability ('Mut s))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw t ('Mut s))
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 AnyList ('Mut s) -> Ptr ('Mut s))
-> Raw AnyList ('Mut s)
-> 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 AnyList ('Mut s) -> List ('Mut s))
-> Raw AnyList ('Mut s)
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw AnyList ('Mut s) -> List ('Mut s)
forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw (Raw AnyList ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (Raw AnyList ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Parsed AnyList -> m (Raw AnyList ('Mut s))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw t ('Mut s))
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 AnyStruct ('Mut s) -> Ptr ('Mut s))
-> Raw AnyStruct ('Mut s)
-> 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 AnyStruct ('Mut s) -> Struct ('Mut s))
-> Raw AnyStruct ('Mut s)
-> Ptr ('Mut s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw AnyStruct ('Mut s) -> Struct ('Mut s)
forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw (Raw AnyStruct ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (Raw AnyStruct ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Parsed AnyStruct -> m (Raw AnyStruct ('Mut s))
forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw t ('Mut s))
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, (forall x. Parsed AnyStruct -> Rep (Parsed AnyStruct) x)
-> (forall x. Rep (Parsed AnyStruct) x -> Parsed AnyStruct)
-> Generic (Parsed AnyStruct)
forall x. Rep (Parsed AnyStruct) x -> Parsed AnyStruct
forall x. Parsed AnyStruct -> Rep (Parsed AnyStruct) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed AnyStruct) x -> Parsed AnyStruct
$cfrom :: forall x. Parsed AnyStruct -> Rep (Parsed AnyStruct) x
Generic)

instance Eq (C.Parsed AnyStruct) where
    -- We define equality specially (rather than just deriving), such that
    -- slices are padded out with the default values of their elements.
    (Struct dl pl) == :: Parsed AnyStruct -> Parsed AnyStruct -> Bool
== (Struct dr pr) = Vector Word64 -> Vector Word64 -> Bool
forall a. (Eq a, Default a) => Vector a -> Vector a -> Bool
sectionEq Vector Word64
dl Vector Word64
dr Bool -> Bool -> Bool
&& Vector (Maybe (Parsed AnyPointer))
-> Vector (Maybe (Parsed AnyPointer)) -> Bool
forall a. (Eq a, Default a) => Vector a -> Vector a -> Bool
sectionEq Vector (Maybe (Parsed AnyPointer))
pl Vector (Maybe (Parsed AnyPointer))
pr
      where
        sectionEq :: (Eq a, Default a) => V.Vector a -> V.Vector a -> Bool
        sectionEq :: Vector a -> Vector a -> Bool
sectionEq Vector a
l Vector a
r = Int -> Bool
go Int
0
          where
            go :: Int -> Bool
go Int
i
                | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
length = Bool
True
                | Bool
otherwise  = Int -> Vector a -> a
forall p. Default p => Int -> Vector p -> p
indexDef Int
i Vector a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Vector a -> a
forall p. Default p => Int -> Vector p -> p
indexDef Int
i Vector a
r Bool -> Bool -> Bool
&& Int -> Bool
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
            length :: Int
length = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
l) (Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
r)
            indexDef :: Int -> Vector p -> p
indexDef Int
i Vector p
vec
                | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Vector p -> Int
forall a. Vector a -> Int
V.length Vector p
vec = Vector p
vec Vector p -> Int -> p
forall a. Vector a -> Int -> a
V.! Int
i
                | Bool
otherwise = p
forall a. Default a => a
def

instance C.Parse AnyStruct (C.Parsed AnyStruct) where
    parse :: Raw AnyStruct 'Const -> m (Parsed AnyStruct)
parse (R.Raw Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
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 (mut :: Mutability). Struct mut -> WordCount
U.structWordCount Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
Struct 'Const
s)
                (Int -> Struct 'Const -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
`U.getData` Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
Struct 'Const
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 (mut :: Mutability). Struct mut -> Word16
U.structPtrCount Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
Struct 'Const
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 Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
Struct 'Const
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 (Maybe AnyPointer) 'Const -> m (Maybe (Parsed AnyPointer))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Raw (Maybe AnyPointer) 'Const -> m (Maybe (Parsed AnyPointer)))
-> (Maybe (Ptr 'Const) -> Raw (Maybe AnyPointer) 'Const)
-> Maybe (Ptr 'Const)
-> m (Maybe (Parsed AnyPointer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Ptr 'Const) -> Raw (Maybe AnyPointer) 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
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 -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([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 -> Int) -> Int -> [Int] -> Int
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 ([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 AnyStruct ('Mut s) -> Parsed AnyStruct -> m ()
marshalInto (R.Raw Unwrapped (Untyped (ReprFor AnyStruct) ('Mut s))
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 Unwrapped (Untyped (ReprFor AnyStruct) ('Mut s))
Struct ('Mut s)
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 Unwrapped (Untyped (ReprFor (Maybe AnyPointer)) ('Mut s))
ptr <- Message ('Mut s)
-> Maybe (Parsed AnyPointer) -> m (Raw (Maybe AnyPointer) ('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 (Struct ('Mut s)) -> Message ('Mut s)
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @U.Struct Unwrapped (Untyped (ReprFor AnyStruct) ('Mut s))
Unwrapped (Struct ('Mut s))
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))
Unwrapped (Untyped (ReprFor (Maybe AnyPointer)) ('Mut s))
ptr Int
i Unwrapped (Untyped (ReprFor AnyStruct) ('Mut s))
Struct ('Mut s)
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, (forall x. Parsed AnyList -> Rep (Parsed AnyList) x)
-> (forall x. Rep (Parsed AnyList) x -> Parsed AnyList)
-> Generic (Parsed AnyList)
forall x. Rep (Parsed AnyList) x -> Parsed AnyList
forall x. Parsed AnyList -> Rep (Parsed AnyList) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (Parsed AnyList) x -> Parsed AnyList
$cfrom :: forall x. Parsed AnyList -> Rep (Parsed AnyList) x
Generic)

instance C.Parse AnyList (C.Parsed AnyList) where
    parse :: Raw AnyList 'Const -> m (Parsed AnyList)
parse (R.Raw Unwrapped (Untyped (ReprFor AnyList) 'Const)
list) = case Unwrapped (Untyped (ReprFor AnyList) 'Const)
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 (List ()) 'Const -> m (ParsedList ())
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor (List ())) 'Const)
-> Raw (List ()) 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor (List ())) 'Const)
ListOf ('Data 'Sz0) 'Const
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 (List Bool) 'Const -> m (ParsedList Bool)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor (List Bool)) 'Const)
-> Raw (List Bool) 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor (List Bool)) 'Const)
ListOf ('Data 'Sz1) 'Const
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 (List Word8) 'Const -> m (ParsedList Word8)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor (List Word8)) 'Const)
-> Raw (List Word8) 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor (List Word8)) 'Const)
ListOf ('Data 'Sz8) 'Const
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 (List Word16) 'Const -> m (ParsedList Word16)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor (List Word16)) 'Const)
-> Raw (List Word16) 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor (List Word16)) 'Const)
ListOf ('Data 'Sz16) 'Const
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 (List Word32) 'Const -> m (ParsedList Word32)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor (List Word32)) 'Const)
-> Raw (List Word32) 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor (List Word32)) 'Const)
ListOf ('Data 'Sz32) 'Const
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 (List Word64) 'Const -> m (Vector Word64)
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor (List Word64)) 'Const)
-> Raw (List Word64) 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor (List Word64)) 'Const)
ListOf ('Data 'Sz64) 'Const
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 (List (Maybe AnyPointer)) 'Const
-> m (Vector (Maybe (Parsed AnyPointer)))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor (List (Maybe AnyPointer))) 'Const)
-> Raw (List (Maybe AnyPointer)) 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor (List (Maybe AnyPointer))) 'Const)
ListOf ('Ptr 'Nothing) 'Const
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 (List AnyStruct) 'Const -> m (Vector (Parsed AnyStruct))
forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (Unwrapped (Untyped (ReprFor (List AnyStruct)) 'Const)
-> Raw (List AnyStruct) 'Const
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor (List AnyStruct)) 'Const)
ListOf ('Ptr ('Just 'Struct)) 'Const
l)

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

instance C.Parse Capability M.Client where
    parse :: Raw Capability 'Const -> m Client
parse (R.Raw Unwrapped (Untyped (ReprFor Capability) 'Const)
cap) = Cap 'Const -> m Client
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Cap mut -> m Client
U.getClient Unwrapped (Untyped (ReprFor Capability) 'Const)
Cap 'Const
cap
    encode :: Message ('Mut s) -> Client -> m (Raw Capability ('Mut s))
encode Message ('Mut s)
msg Client
client = Cap ('Mut s) -> Raw Capability ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw (Cap ('Mut s) -> Raw Capability ('Mut s))
-> m (Cap ('Mut s)) -> m (Raw Capability ('Mut s))
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 Text ('Mut s))
new AllocHint Text
len Message ('Mut s)
msg = ListOf ('Data 'Sz8) ('Mut s) -> Raw Text ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw (ListOf ('Data 'Sz8) ('Mut s) -> Raw Text ('Mut s))
-> m (ListOf ('Data 'Sz8) ('Mut s)) -> m (Raw Text ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
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 Text 'Const -> m Text
parse (R.Raw Unwrapped (Untyped (ReprFor Text) 'Const)
list) =
        let len :: Int
len = ListOf ('Data 'Sz8) 'Const -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length Unwrapped (Untyped (ReprFor Text) 'Const)
ListOf ('Data 'Sz8) 'Const
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 ('Data 'Sz8) 'Const
-> m (Unwrapped (Untyped ('Data 'Sz8) 'Const))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
U.index (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Unwrapped (Untyped (ReprFor Text) 'Const)
ListOf ('Data 'Sz8) 'Const
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 ('Data 'Sz8) 'Const -> m ByteString
forall (m :: * -> *).
ReadCtx m 'Const =>
ListOf ('Data 'Sz8) 'Const -> m ByteString
U.rawBytes Unwrapped (Untyped (ReprFor Text) 'Const)
ListOf ('Data 'Sz8) 'Const
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 Text ('Mut s))
encode Message ('Mut s)
msg Text
value = do
        let bytes :: ByteString
bytes = Text -> ByteString
TE.encodeUtf8 Text
value
        raw :: Raw Text ('Mut s)
raw@(R.Raw Unwrapped (Untyped (ReprFor Text) ('Mut s))
untyped)  <- AllocHint Text -> Message ('Mut s) -> m (Raw Text ('Mut s))
forall a (m :: * -> *) s.
(Allocate a, RWCtx m s) =>
AllocHint a -> Message ('Mut s) -> m (Raw a ('Mut s))
C.new @Text (ByteString -> Int
BS.length ByteString
bytes) Message ('Mut s)
msg
        Raw Data ('Mut s) -> ByteString -> m ()
forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto @Data (Unwrapped (Untyped (ReprFor Data) ('Mut s)) -> Raw Data ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor Data) ('Mut s))
Unwrapped (Untyped (ReprFor Text) ('Mut s))
untyped) ByteString
bytes
        Raw Text ('Mut s) -> m (Raw Text ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Raw Text ('Mut s)
raw

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

instance C.Allocate Data where
    type AllocHint Data = Int
    new :: AllocHint Data -> Message ('Mut s) -> m (Raw Data ('Mut s))
new AllocHint Data
len Message ('Mut s)
msg = ListOf ('Data 'Sz8) ('Mut s) -> Raw Data ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw (ListOf ('Data 'Sz8) ('Mut s) -> Raw Data ('Mut s))
-> m (ListOf ('Data 'Sz8) ('Mut s)) -> m (Raw Data ('Mut s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
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 Data ('Mut s) -> ByteString -> m ()
marshalInto (R.Raw Unwrapped (Untyped (ReprFor Data) ('Mut s))
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 ->
            Unwrapped (Untyped ('Data 'Sz8) ('Mut s))
-> Int -> ListOf ('Data 'Sz8) ('Mut s) -> m ()
forall (m :: * -> *) s (r :: Repr).
(RWCtx m s, ListItem r) =>
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
U.setIndex (ByteString -> Int -> Word8
BS.index ByteString
bytes Int
i) Int
i Unwrapped (Untyped (ReprFor Data) ('Mut s))
ListOf ('Data 'Sz8) ('Mut s)
list

-- Instances for AnyStruct
instance C.Allocate AnyStruct where
    type AllocHint AnyStruct = (Word16, Word16)
    new :: AllocHint AnyStruct
-> Message ('Mut s) -> m (Raw AnyStruct ('Mut s))
new (nWords, nPtrs) Message ('Mut s)
msg = Struct ('Mut s) -> Raw AnyStruct ('Mut s)
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw (Struct ('Mut s) -> Raw AnyStruct ('Mut s))
-> m (Struct ('Mut s)) -> m (Raw AnyStruct ('Mut s))
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

-- | Return the underlying buffer containing the text. This does not include the
-- null terminator.
textBuffer :: MonadThrow m => R.Raw Text mut -> m (R.Raw Data mut)
textBuffer :: Raw Text mut -> m (Raw Data mut)
textBuffer (R.Raw Unwrapped (Untyped (ReprFor Text) mut)
list) = ListOf ('Data 'Sz8) mut -> Raw Data mut
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw (ListOf ('Data 'Sz8) mut -> Raw Data mut)
-> m (ListOf ('Data 'Sz8) mut) -> m (Raw Data mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ListOf ('Data 'Sz8) mut -> m (ListOf ('Data 'Sz8) mut)
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, MonadThrow m) =>
Int -> ListOf r mut -> m (ListOf r mut)
U.take (ListOf ('Data 'Sz8) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length Unwrapped (Untyped (ReprFor Text) mut)
ListOf ('Data 'Sz8) mut
list Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Unwrapped (Untyped (ReprFor Text) mut)
ListOf ('Data 'Sz8) mut
list

-- | Convert a 'Text' to a 'BS.ByteString', comprising the raw bytes of the text
-- (not counting the NUL terminator).
textBytes :: U.ReadCtx m 'M.Const => R.Raw Text 'M.Const -> m BS.ByteString
textBytes :: Raw Text 'Const -> m ByteString
textBytes Raw Text 'Const
text = do
    R.Raw Unwrapped (Untyped (ReprFor Data) 'Const)
raw <- Raw Text 'Const -> m (Raw Data 'Const)
forall (m :: * -> *) (mut :: Mutability).
MonadThrow m =>
Raw Text mut -> m (Raw Data mut)
textBuffer Raw Text 'Const
text
    ListOf ('Data 'Sz8) 'Const -> m ByteString
forall (m :: * -> *).
ReadCtx m 'Const =>
ListOf ('Data 'Sz8) 'Const -> m ByteString
U.rawBytes Unwrapped (Untyped (ReprFor Data) 'Const)
ListOf ('Data 'Sz8) 'Const
raw