{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module: Capnp.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.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.Classes as C
import qualified Capnp.Errors as E
import qualified Capnp.Message as M
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
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
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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
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
    Maybe (Ptr 'Const)
Unwrapped (Untyped (ReprFor (Maybe AnyPointer)) 'Const)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
    Just Ptr 'Const
_ -> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor (Maybe AnyPointer)) 'Const)
ptr :: R.Raw AnyPointer 'M.Const)

  encode :: forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s)
-> Maybe (Parsed AnyPointer) -> m (Raw (Maybe AnyPointer) ('Mut s))
encode Message ('Mut s)
msg Maybe (Parsed AnyPointer)
value =
    forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe (Parsed AnyPointer)
value of
      Maybe (Parsed AnyPointer)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
      Just Parsed AnyPointer
v -> coerce :: forall a b. Coercible a b => a -> b
coerce forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
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 'Const
cap) -> Client -> Parsed AnyPointer
PtrCap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Cap 'Const
cap)
    Just (U.PtrList List 'Const
list) -> Parsed AnyList -> Parsed AnyPointer
PtrList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw List 'Const
list)
    Just (U.PtrStruct Struct 'Const
struct) -> Parsed AnyStruct -> Parsed AnyPointer
PtrStruct forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Struct 'Const
struct)
    Maybe (Ptr 'Const)
Unwrapped (Untyped (ReprFor AnyPointer) 'Const)
Nothing ->
      forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ String -> Error
E.SchemaViolationError String
"Non-nullable AnyPointer was null"

  encode :: forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s)
-> Parsed AnyPointer -> m (Raw AnyPointer ('Mut s))
encode Message ('Mut s)
msg Parsed AnyPointer
value =
    forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Parsed AnyPointer
value of
      PtrCap Client
cap -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (mut :: Mutability). Cap mut -> Ptr mut
U.PtrCap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Parsed AnyList
list -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (mut :: Mutability). List mut -> Ptr mut
U.PtrList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Parsed AnyStruct
struct -> forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (mut :: Mutability). Struct mut -> Ptr mut
U.PtrStruct forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
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. 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 Vector Word64
dl Vector (Maybe (Parsed AnyPointer))
pl) == :: Parsed AnyStruct -> Parsed AnyStruct -> Bool
== (Struct Vector Word64
dr Vector (Maybe (Parsed AnyPointer))
pr) = forall a. (Eq a, Default a) => Vector a -> Vector a -> Bool
sectionEq Vector Word64
dl Vector Word64
dr Bool -> Bool -> 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 :: forall a. (Eq a, Default a) => 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 forall a. Ord a => a -> a -> Bool
>= Int
length = Bool
True
            | Bool
otherwise = forall {a}. Default a => Int -> Vector a -> a
indexDef Int
i Vector a
l forall a. Eq a => a -> a -> Bool
== forall {a}. Default a => Int -> Vector a -> a
indexDef Int
i Vector a
r Bool -> Bool -> Bool
&& Int -> Bool
go (Int
i forall a. Num a => a -> a -> a
+ Int
1)
          length :: Int
length = forall a. Ord a => a -> a -> a
max (forall a. Vector a -> Int
V.length Vector a
l) (forall a. Vector a -> Int
V.length Vector a
r)
          indexDef :: Int -> Vector a -> a
indexDef Int
i Vector a
vec
            | Int
i forall a. Ord a => a -> a -> Bool
< forall a. Vector a -> Int
V.length Vector a
vec = Vector a
vec forall a. Vector a -> Int -> a
V.! Int
i
            | Bool
otherwise = forall a. Default a => a
def

instance C.Parse AnyStruct (C.Parsed AnyStruct) where
  parse :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw AnyStruct 'Const -> m (Parsed AnyStruct)
parse (R.Raw Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
s) =
    Vector Word64
-> Vector (Maybe (Parsed AnyPointer)) -> Parsed AnyStruct
Struct
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (mut :: Mutability). Struct mut -> WordCount
U.structWordCount Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
s)
        (forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
`U.getData` Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
s)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a.
Monad m =>
Int -> (Int -> m a) -> m (Vector a)
V.generateM
        (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (mut :: Mutability). Struct mut -> Word16
U.structPtrCount Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
s)
        (\Int
i -> forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr Int
i Unwrapped (Untyped (ReprFor AnyStruct) 'Const)
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Vector a -> Int
V.length Vector (Parsed AnyStruct)
structs
        !nWords :: Int
nWords = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Vector a -> Int
V.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsed AnyStruct -> Vector Word64
structData) forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Vector (Parsed AnyStruct)
structs
        !nPtrs :: Int
nPtrs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Vector a -> Int
V.length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsed AnyStruct -> Vector (Maybe (Parsed AnyPointer))
structPtrs) forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Vector (Parsed AnyStruct)
structs
     in (Int
len, (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nWords, 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 =
    ( forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int
V.length forall a b. (a -> b) -> a -> b
$ Parsed AnyStruct -> Vector Word64
structData Parsed AnyStruct
s,
      forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> Int
V.length 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 :: forall (m :: * -> *) s.
RWCtx m s =>
Raw AnyStruct ('Mut s) -> Parsed AnyStruct -> m ()
marshalInto (R.Raw Unwrapped (Untyped (ReprFor AnyStruct) ('Mut s))
raw) Parsed AnyStruct
s = do
    forall (m :: * -> *) a b.
Monad m =>
Vector a -> (Int -> a -> m b) -> m ()
V.iforM_ (Parsed AnyStruct -> Vector Word64
structData Parsed AnyStruct
s) forall a b. (a -> b) -> a -> b
$ \Int
i Word64
value -> do
      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))
raw
    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) forall a b. (a -> b) -> a -> b
$ \Int
i Maybe (Parsed AnyPointer)
value -> do
      R.Raw Unwrapped (Untyped (ReprFor (Maybe AnyPointer)) ('Mut s))
ptr <- forall t p (m :: * -> *) s.
(Parse t p, RWCtx m s) =>
Message ('Mut s) -> p -> m (Raw t ('Mut s))
C.encode (forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @U.Struct Unwrapped (Untyped (ReprFor AnyStruct) ('Mut s))
raw) Maybe (Parsed AnyPointer)
value
      forall (m :: * -> *) s.
(ReadCtx m ('Mut s), WriteCtx m s) =>
Maybe (Ptr ('Mut s)) -> Int -> Struct ('Mut s) -> m ()
U.setPtr Unwrapped (Untyped (ReprFor (Maybe AnyPointer)) ('Mut s))
ptr Int
i Unwrapped (Untyped (ReprFor AnyStruct) ('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
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
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. 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
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 ListOf ('Data 'Sz0) 'Const
l -> ParsedList () -> Parsed AnyList
List0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw ListOf ('Data 'Sz0) 'Const
l)
    U.List1 ListOf ('Data 'Sz1) 'Const
l -> ParsedList Bool -> Parsed AnyList
List1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw ListOf ('Data 'Sz1) 'Const
l)
    U.List8 ListOf ('Data 'Sz8) 'Const
l -> ParsedList Word8 -> Parsed AnyList
List8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw ListOf ('Data 'Sz8) 'Const
l)
    U.List16 ListOf ('Data 'Sz16) 'Const
l -> ParsedList Word16 -> Parsed AnyList
List16 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw ListOf ('Data 'Sz16) 'Const
l)
    U.List32 ListOf ('Data 'Sz32) 'Const
l -> ParsedList Word32 -> Parsed AnyList
List32 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw ListOf ('Data 'Sz32) 'Const
l)
    U.List64 ListOf ('Data 'Sz64) 'Const
l -> Vector Word64 -> Parsed AnyList
List64 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw ListOf ('Data 'Sz64) 'Const
l)
    U.ListPtr ListOf ('Ptr 'Nothing) 'Const
l -> Vector (Maybe (Parsed AnyPointer)) -> Parsed AnyList
ListPtr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw ListOf ('Ptr 'Nothing) 'Const
l)
    U.ListStruct ListOf ('Ptr ('Just 'Struct)) 'Const
l -> Vector (Parsed AnyStruct) -> Parsed AnyList
ListStruct forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t p (m :: * -> *).
(Parse t p, ReadCtx m 'Const) =>
Raw t 'Const -> m p
C.parse (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw ListOf ('Ptr ('Just 'Struct)) 'Const
l)

  encode :: forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s) -> Parsed AnyList -> m (Raw AnyList ('Mut s))
encode Message ('Mut s)
msg Parsed AnyList
list =
    forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Parsed AnyList
list of
      List0 ParsedList ()
l -> forall (mut :: Mutability). ListOf ('Data 'Sz0) mut -> List mut
U.List0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 ParsedList Bool
l -> forall (mut :: Mutability). ListOf ('Data 'Sz1) mut -> List mut
U.List1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 ParsedList Word8
l -> forall (mut :: Mutability). ListOf ('Data 'Sz8) mut -> List mut
U.List8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 ParsedList Word16
l -> forall (mut :: Mutability). ListOf ('Data 'Sz16) mut -> List mut
U.List16 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 ParsedList Word32
l -> forall (mut :: Mutability). ListOf ('Data 'Sz32) mut -> List mut
U.List32 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Vector Word64
l -> forall (mut :: Mutability). ListOf ('Data 'Sz64) mut -> List mut
U.List64 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Vector (Maybe (Parsed AnyPointer))
l -> forall (mut :: Mutability). ListOf ('Ptr 'Nothing) mut -> List mut
U.ListPtr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Vector (Parsed AnyStruct)
l -> forall (mut :: Mutability).
ListOf ('Ptr ('Just 'Struct)) mut -> List mut
U.ListStruct forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Capability 'Const -> m Client
parse (R.Raw Unwrapped (Untyped (ReprFor Capability) 'Const)
cap) = forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Cap mut -> m Client
U.getClient Unwrapped (Untyped (ReprFor Capability) 'Const)
cap
  encode :: forall (m :: * -> *) s.
RWCtx m s =>
Message ('Mut s) -> Client -> m (Raw Capability ('Mut s))
encode Message ('Mut s)
msg Client
client = forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (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 :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint Text -> Message ('Mut s) -> m (Raw Text ('Mut s))
new AllocHint Text
len Message ('Mut s)
msg = forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (ListOf ('Data 'Sz8) ('Mut s))
U.allocList8 Message ('Mut s)
msg (AllocHint Text
len 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 :: forall (m :: * -> *). ReadCtx m 'Const => Raw Text 'Const -> m Text
parse (R.Raw Unwrapped (Untyped (ReprFor Text) 'Const)
list) =
    let len :: Int
len = forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length Unwrapped (Untyped (ReprFor Text) 'Const)
list
     in if Int
len 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.
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
""
          else
            ( do
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Eq a => a -> a -> Bool
== Int
0) forall a b. (a -> b) -> a -> b
$
                  forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                    String -> Error
E.SchemaViolationError
                      String
"Text is not NUL-terminated (list of bytes has length 0)"
                Unwrapped (Untyped ('Data 'Sz8) 'Const)
lastByte <- forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
U.index (Int
len forall a. Num a => a -> a -> a
- Int
1) Unwrapped (Untyped (ReprFor Text) 'Const)
list
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Unwrapped (Untyped ('Data 'Sz8) 'Const)
lastByte forall a. Eq a => a -> a -> Bool
/= Unwrapped (Untyped ('Data 'Sz8) 'Const)
0) forall a b. (a -> b) -> a -> b
$
                  forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$
                    String -> Error
E.SchemaViolationError forall a b. (a -> b) -> a -> b
$
                      String
"Text is not NUL-terminated (last byte is " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Unwrapped (Untyped ('Data 'Sz8) 'Const)
lastByte forall a. [a] -> [a] -> [a]
++ String
")"
                ByteString
bytes <- Int -> ByteString -> ByteString
BS.take (Int
len forall a. Num a => a -> a -> a
- Int
1) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
ReadCtx m 'Const =>
ListOf ('Data 'Sz8) 'Const -> m ByteString
U.rawBytes Unwrapped (Untyped (ReprFor Text) 'Const)
list
                case ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
bytes of
                  Left UnicodeException
e -> forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM forall a b. (a -> b) -> a -> b
$ UnicodeException -> Error
E.InvalidUtf8Error UnicodeException
e
                  Right Text
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
v
            )
  encode :: forall (m :: * -> *) s.
RWCtx m s =>
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) <- 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
    forall t p (m :: * -> *) s.
(Marshal t p, RWCtx m s) =>
Raw t ('Mut s) -> p -> m ()
C.marshalInto @Data (forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw Unwrapped (Untyped (ReprFor Text) ('Mut s))
untyped) ByteString
bytes
    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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Data 'Const -> m ByteString
parse = forall (m :: * -> *).
ReadCtx m 'Const =>
ListOf ('Data 'Sz8) 'Const -> m ByteString
U.rawBytes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (mut :: Mutability).
Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
R.fromRaw

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

instance C.EstimateAlloc Data BS.ByteString where
  estimateAlloc :: ByteString -> AllocHint Data
estimateAlloc = ByteString -> Int
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 :: forall (m :: * -> *) s.
RWCtx m s =>
Raw Data ('Mut s) -> ByteString -> m ()
marshalInto (R.Raw Unwrapped (Untyped (ReprFor Data) ('Mut s))
list) ByteString
bytes =
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0 .. ByteString -> Int
BS.length ByteString
bytes forall a. Num a => a -> a -> a
- Int
1] forall a b. (a -> b) -> a -> b
$ \Int
i ->
      forall (m :: * -> *) s (r :: Repr).
(RWCtx m s, ListItem r) =>
Unwrapped (Untyped r ('Mut s)) -> Int -> ListOf r ('Mut s) -> m ()
U.setIndex (HasCallStack => ByteString -> Int -> Word8
BS.index ByteString
bytes Int
i) Int
i Unwrapped (Untyped (ReprFor Data) ('Mut s))
list

-- Instances for AnyStruct
instance C.Allocate AnyStruct where
  type AllocHint AnyStruct = (Word16, Word16)
  new :: forall (m :: * -> *) s.
RWCtx m s =>
AllocHint AnyStruct
-> Message ('Mut s) -> m (Raw AnyStruct ('Mut s))
new (Word16
nWords, Word16
nPtrs) Message ('Mut s)
msg = forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (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 :: forall (m :: * -> *) (mut :: Mutability).
MonadThrow m =>
Raw Text mut -> m (Raw Data mut)
textBuffer (R.Raw Unwrapped (Untyped (ReprFor Text) mut)
list) = forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
R.Raw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(ListItem r, MonadThrow m) =>
Int -> ListOf r mut -> m (ListOf r mut)
U.take (forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length Unwrapped (Untyped (ReprFor Text) mut)
list forall a. Num a => a -> a -> a
- Int
1) Unwrapped (Untyped (ReprFor Text) 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 :: forall (m :: * -> *).
ReadCtx m 'Const =>
Raw Text 'Const -> m ByteString
textBytes Raw Text 'Const
text = do
  R.Raw Unwrapped (Untyped (ReprFor Data) 'Const)
raw <- forall (m :: * -> *) (mut :: Mutability).
MonadThrow m =>
Raw Text mut -> m (Raw Data mut)
textBuffer Raw Text 'Const
text
  forall (m :: * -> *).
ReadCtx m 'Const =>
ListOf ('Data 'Sz8) 'Const -> m ByteString
U.rawBytes Unwrapped (Untyped (ReprFor Data) 'Const)
raw