{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Capnp.Repr
(
Repr(..)
, PtrRepr(..)
, ListRepr(..)
, NormalListRepr(..)
, DataSz(..)
, Untyped
, UntypedData
, UntypedPtr
, UntypedSomePtr
, UntypedList
, UntypedSomeList
, ReprFor
, PtrReprFor
, Element(..)
, ElemRepr
, ListReprFor
, IsPtrRepr(..)
, IsListPtrRepr(..)
, Raw(..)
, List
, length
, index
, setIndex
, Allocate(..)
, IsStruct
, IsCap
, IsPtr
) where
import Prelude hiding (length)
import Capnp.Message (Mutability(..))
import qualified Capnp.Message as M
import Capnp.TraversalLimit (evalLimitT)
import Capnp.Untyped
( Allocate(..)
, DataSz(..)
, ElemRepr
, Element(..)
, IsListPtrRepr(..)
, IsPtrRepr(..)
, ListRepr(..)
, ListReprFor
, NormalListRepr(..)
, PtrRepr(..)
, Repr(..)
, Untyped
, UntypedData
, UntypedList
, UntypedPtr
, UntypedSomeList
, UntypedSomePtr
)
import qualified Capnp.Untyped as U
import Data.Default (Default(..))
import Data.Int
import Data.Kind (Type)
import Data.Maybe (fromJust)
import Data.Word
import GHC.Generics (Generic)
type family ReprFor (a :: Type) :: Repr
type instance ReprFor () = 'Data 'Sz0
type instance ReprFor Bool = 'Data 'Sz1
type instance ReprFor Word8 = 'Data 'Sz8
type instance ReprFor Word16 = 'Data 'Sz16
type instance ReprFor Word32 = 'Data 'Sz32
type instance ReprFor Word64 = 'Data 'Sz64
type instance ReprFor Int8 = 'Data 'Sz8
type instance ReprFor Int16 = 'Data 'Sz16
type instance ReprFor Int32 = 'Data 'Sz32
type instance ReprFor Int64 = 'Data 'Sz64
type instance ReprFor Float = 'Data 'Sz32
type instance ReprFor Double = 'Data 'Sz64
type instance ReprFor (U.Struct mut) = 'Ptr ('Just 'Struct)
type instance ReprFor (U.Cap mut) = 'Ptr ('Just 'Cap)
type instance ReprFor (U.Ptr mut) = 'Ptr 'Nothing
type instance ReprFor (U.List mut) = 'Ptr ('Just ('List 'Nothing))
type instance ReprFor (U.ListOf r mut) = 'Ptr ('Just ('List ('Just (ListReprFor r))))
type instance ReprFor (List a) = 'Ptr ('Just ('List ('Just (ListReprFor (ReprFor a)))))
type family PtrReprFor (r :: Repr) :: Maybe PtrRepr where
PtrReprFor ('Ptr pr) = pr
newtype Raw (a :: Type ) (mut :: Mutability)
= Raw { Raw a mut -> Unwrapped (Untyped (ReprFor a) mut)
fromRaw :: U.Unwrapped (Untyped (ReprFor a) mut) }
deriving instance Show (U.Unwrapped (Untyped (ReprFor a) mut)) => Show (Raw a mut)
deriving instance Read (U.Unwrapped (Untyped (ReprFor a) mut)) => Read (Raw a mut)
deriving instance Eq (U.Unwrapped (Untyped (ReprFor a) mut)) => Eq (Raw a mut)
deriving instance Generic (U.Unwrapped (Untyped (ReprFor a) mut)) => Generic (Raw a mut)
data List a
type ListElem a =
( U.Element (ReprFor a)
, U.ListItem (ElemRepr (ListReprFor (ReprFor a)))
)
length :: ListElem a => Raw (List a) mut -> Int
{-# INLINE length #-}
length :: Raw (List a) mut -> Int
length (Raw Unwrapped (Untyped (ReprFor (List a)) mut)
l) = ListOf (ElemRepr (ListReprFor (ReprFor a))) mut -> Int
forall (r :: Repr) (mut :: Mutability).
ListItem r =>
ListOf r mut -> Int
U.length Unwrapped (Untyped (ReprFor (List a)) mut)
ListOf (ElemRepr (ListReprFor (ReprFor a))) mut
l
index :: forall a m mut.
( U.ReadCtx m mut
, U.HasMessage (U.ListOf (ElemRepr (ListReprFor (ReprFor a))))
, ListElem a
) => Int -> Raw (List a) mut -> m (Raw a mut)
{-# INLINE index #-}
index :: Int -> Raw (List a) mut -> m (Raw a mut)
index Int
i (Raw Unwrapped (Untyped (ReprFor (List a)) mut)
l) = Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
Raw (Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut)
-> m (Unwrapped (Untyped (ReprFor a) mut)) -> m (Raw a mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Unwrapped (Untyped (ElemRepr (ListReprFor (ReprFor a))) mut)
elt <- Int
-> ListOf (ElemRepr (ListReprFor (ReprFor a))) mut
-> m (Unwrapped (Untyped (ElemRepr (ListReprFor (ReprFor a))) mut))
forall (m :: * -> *) (mut :: Mutability) (r :: Repr).
(ReadCtx m mut, ListItem r) =>
Int -> ListOf r mut -> m (Unwrapped (Untyped r mut))
U.index Int
i Unwrapped (Untyped (ReprFor (List a)) mut)
ListOf (ElemRepr (ListReprFor (ReprFor a))) mut
l
Message mut
-> Unwrapped (Untyped (ElemRepr (ListReprFor (ReprFor a))) mut)
-> m (Unwrapped (Untyped (ReprFor a) mut))
forall (r :: Repr) (m :: * -> *) (mut :: Mutability).
(Element r, ReadCtx m mut) =>
Message mut
-> Unwrapped (Untyped (ElemRepr (ListReprFor r)) mut)
-> m (Unwrapped (Untyped r mut))
fromElement
@(ReprFor a)
@m
@mut
(Unwrapped (ListOf (ElemRepr (ListReprFor (ReprFor a))) mut)
-> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @(U.ListOf (ElemRepr (ListReprFor (ReprFor a)))) Unwrapped (Untyped (ReprFor (List a)) mut)
Unwrapped (ListOf (ElemRepr (ListReprFor (ReprFor a))) mut)
l)
Unwrapped (Untyped (ElemRepr (ListReprFor (ReprFor a))) mut)
elt
setIndex :: forall a m s.
( U.RWCtx m s
, U.ListItem (ElemRepr (ListReprFor (ReprFor a)))
, U.Element (ReprFor a)
) => Raw a ('Mut s) -> Int -> Raw (List a) ('Mut s) -> m ()
{-# INLINE setIndex #-}
setIndex :: Raw a ('Mut s) -> Int -> Raw (List a) ('Mut s) -> m ()
setIndex (Raw Unwrapped (Untyped (ReprFor a) ('Mut s))
v) Int
i (Raw Unwrapped (Untyped (ReprFor (List a)) ('Mut s))
l) = Unwrapped (Untyped (ElemRepr (ListReprFor (ReprFor a))) ('Mut s))
-> Int
-> ListOf (ElemRepr (ListReprFor (ReprFor a))) ('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 (Unwrapped (Untyped (ReprFor a) ('Mut s))
-> Unwrapped
(Untyped (ElemRepr (ListReprFor (ReprFor a))) ('Mut s))
forall (r :: Repr) (mut :: Mutability).
Element r =>
Unwrapped (Untyped r mut)
-> Unwrapped (Untyped (ElemRepr (ListReprFor r)) mut)
toElement @(ReprFor a) @('Mut s) Unwrapped (Untyped (ReprFor a) ('Mut s))
v) Int
i Unwrapped (Untyped (ReprFor (List a)) ('Mut s))
ListOf (ElemRepr (ListReprFor (ReprFor a))) ('Mut s)
l
instance U.HasMessage (Untyped (ReprFor a)) => U.HasMessage (Raw a) where
message :: Unwrapped (Raw a mut) -> Message mut
message (Raw r) = Unwrapped (Untyped (ReprFor a) mut) -> Message mut
forall (f :: Mutability -> *) (mut :: Mutability).
HasMessage f =>
Unwrapped (f mut) -> Message mut
U.message @(Untyped (ReprFor a)) Unwrapped (Untyped (ReprFor a) mut)
r
instance U.MessageDefault (Untyped (ReprFor a)) => U.MessageDefault (Raw a) where
messageDefault :: Message mut -> m (Unwrapped (Raw a mut))
messageDefault Message mut
msg = Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
forall a (mut :: Mutability).
Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut
Raw (Unwrapped (Untyped (ReprFor a) mut) -> Raw a mut)
-> m (Unwrapped (Untyped (ReprFor a) mut)) -> m (Raw a mut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message mut -> m (Unwrapped (Untyped (ReprFor a) mut))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
U.messageDefault @(Untyped (ReprFor a)) Message mut
msg
instance U.MessageDefault (Raw a) => Default (Raw a 'Const) where
def :: Raw a 'Const
def = Maybe (Raw a 'Const) -> Raw a 'Const
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Raw a 'Const) -> Raw a 'Const)
-> Maybe (Raw a 'Const) -> Raw a 'Const
forall a b. (a -> b) -> a -> b
$ WordCount -> LimitT Maybe (Raw a 'Const) -> Maybe (Raw a 'Const)
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
forall a. Bounded a => a
maxBound (LimitT Maybe (Raw a 'Const) -> Maybe (Raw a 'Const))
-> LimitT Maybe (Raw a 'Const) -> Maybe (Raw a 'Const)
forall a b. (a -> b) -> a -> b
$ Message 'Const -> LimitT Maybe (Unwrapped (Raw a 'Const))
forall (f :: Mutability -> *) (m :: * -> *) (mut :: Mutability).
(MessageDefault f, ReadCtx m mut) =>
Message mut -> m (Unwrapped (f mut))
U.messageDefault @(Raw a) Message 'Const
M.empty
type IsStruct a = ReprFor a ~ 'Ptr ('Just 'Struct)
type IsCap a = ReprFor a ~ 'Ptr ('Just 'Cap)
type IsPtr a =
( ReprFor a ~ 'Ptr (PtrReprFor (ReprFor a))
, IsPtrRepr (PtrReprFor (ReprFor a))
)