{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE NamedFieldPuns        #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
module Capnp.GenHelpers.New
    ( dataField
    , ptrField
    , groupField
    , voidField
    , readVariant
    , Mutability(..)
    , TypeParam
    , newStruct
    , parseField
    , encodeField
    , encodeVariant
    , initVariant
    , unionWhich
    , readField
    , structUnion
    , unionStruct
    , parseEnum
    , encodeEnum
    , parseCap
    , encodeCap
    , getPtrConst
    , module F
    , module Capnp.Repr.Methods
    ) where

import           Capnp.Bits
import qualified Capnp.Classes      as C
import           Capnp.Fields       as F
import           Capnp.GenHelpers   (getPtrConst)
import           Capnp.Message      (Mutability(..))
import qualified Capnp.Message      as M
import           Capnp.New
    ( TypeParam
    , encodeField
    , encodeVariant
    , initVariant
    , parseField
    , readField
    , structUnion
    , unionStruct
    , unionWhich
    )
import qualified Capnp.New.Basics   as NB
import qualified Capnp.New.Classes  as NC
import qualified Capnp.Repr         as R
import           Capnp.Repr.Methods
import qualified Capnp.Untyped      as U
import           Data.Bits
import           Data.Word

dataField
    :: forall b a sz.
    ( R.ReprFor b ~ 'R.Data sz
    , C.IsWord (R.UntypedData sz)
    )
    => BitCount -> Word16 -> BitCount -> Word64 -> F.Field 'F.Slot a b
dataField :: BitCount -> Word16 -> BitCount -> Word64 -> Field 'Slot a b
dataField BitCount
shift Word16
index BitCount
nbits Word64
defaultValue = FieldLoc 'Slot (ReprFor b) -> Field 'Slot a b
forall (k :: FieldKind) a b. FieldLoc k (ReprFor b) -> Field k a b
F.Field (FieldLoc 'Slot (ReprFor b) -> Field 'Slot a b)
-> FieldLoc 'Slot (ReprFor b) -> Field 'Slot a b
forall a b. (a -> b) -> a -> b
$ DataFieldLoc sz -> FieldLoc 'Slot ('Data sz)
forall (a :: DataSz).
IsWord (UntypedData a) =>
DataFieldLoc a -> FieldLoc 'Slot ('Data a)
F.DataField @sz DataFieldLoc :: forall (sz :: DataSz).
BitCount -> Word16 -> Word64 -> Word64 -> DataFieldLoc sz
F.DataFieldLoc
    { BitCount
shift :: BitCount
shift :: BitCount
shift
    , Word16
index :: Word16
index :: Word16
index
    , mask :: Word64
mask = ((Word64
1 Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` BitCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral BitCount
nbits) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1) Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftL` BitCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral BitCount
shift
    , Word64
defaultValue :: Word64
defaultValue :: Word64
defaultValue
    }

ptrField :: forall a b. R.IsPtr b => Word16 -> F.Field 'F.Slot a b
ptrField :: Word16 -> Field 'Slot a b
ptrField = FieldLoc 'Slot ('Ptr (PtrReprFor (ReprFor b))) -> Field 'Slot a b
forall (k :: FieldKind) a b. FieldLoc k (ReprFor b) -> Field k a b
F.Field (FieldLoc 'Slot ('Ptr (PtrReprFor (ReprFor b))) -> Field 'Slot a b)
-> (Word16 -> FieldLoc 'Slot ('Ptr (PtrReprFor (ReprFor b))))
-> Word16
-> Field 'Slot a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IsPtrRepr (PtrReprFor (ReprFor b)) =>
Word16 -> FieldLoc 'Slot ('Ptr (PtrReprFor (ReprFor b)))
forall (a :: Maybe PtrRepr).
IsPtrRepr a =>
Word16 -> FieldLoc 'Slot ('Ptr a)
F.PtrField @(R.PtrReprFor (R.ReprFor b))

groupField :: (R.ReprFor b ~ 'R.Ptr ('Just 'R.Struct)) => F.Field 'F.Group a b
groupField :: Field 'Group a b
groupField = FieldLoc 'Group (ReprFor b) -> Field 'Group a b
forall (k :: FieldKind) a b. FieldLoc k (ReprFor b) -> Field k a b
F.Field FieldLoc 'Group (ReprFor b)
FieldLoc 'Group ('Ptr ('Just 'Struct))
F.GroupField

voidField :: (R.ReprFor b ~ 'R.Data 'R.Sz0) => F.Field 'F.Slot a b
voidField :: Field 'Slot a b
voidField = FieldLoc 'Slot (ReprFor b) -> Field 'Slot a b
forall (k :: FieldKind) a b. FieldLoc k (ReprFor b) -> Field k a b
F.Field FieldLoc 'Slot (ReprFor b)
FieldLoc 'Slot ('Data 'Sz0)
F.VoidField

-- | Like 'readField', but accepts a variant. Warning: *DOES NOT CHECK* that the
-- variant is the one that is set. This should only be used by generated code.
readVariant
    ::  forall k a b mut m.
        ( R.IsStruct a
        , U.ReadCtx m mut
        )
    => F.Variant k a b -> R.Raw mut a -> m (R.Raw mut b)
readVariant :: Variant k a b -> Raw mut a -> m (Raw mut b)
readVariant F.Variant{Field k a b
field :: forall (k :: FieldKind) a b. Variant k a b -> Field k a b
field :: Field k a b
field} = Field k a b -> Raw mut a -> m (Raw mut b)
forall (k :: FieldKind) a b (mut :: Mutability) (m :: * -> *).
(IsStruct a, ReadCtx m mut) =>
Field k a b -> Raw mut a -> m (Raw mut b)
readField Field k a b
field

newStruct :: forall a m s. (U.RWCtx m s, NC.TypedStruct a) => () -> M.Message ('Mut s) -> m (R.Raw ('Mut s) a)
newStruct :: () -> Message ('Mut s) -> m (Raw ('Mut s) a)
newStruct () Message ('Mut s)
msg = Struct ('Mut s) -> Raw ('Mut s) a
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw (Struct ('Mut s) -> Raw ('Mut s) a)
-> (Raw ('Mut s) AnyStruct -> Struct ('Mut s))
-> Raw ('Mut s) AnyStruct
-> Raw ('Mut s) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Raw ('Mut s) AnyStruct -> Struct ('Mut s)
forall (mut :: Mutability) a. Raw mut a -> Untyped mut (ReprFor a)
R.fromRaw (Raw ('Mut s) AnyStruct -> Raw ('Mut s) a)
-> m (Raw ('Mut s) AnyStruct) -> m (Raw ('Mut s) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AllocHint AnyStruct
-> Message ('Mut s) -> m (Raw ('Mut s) AnyStruct)
forall a (m :: * -> *) s.
(Allocate a, RWCtx m s) =>
AllocHint a -> Message ('Mut s) -> m (Raw ('Mut s) a)
NC.new @NB.AnyStruct (TypedStruct a => Word16
forall a. TypedStruct a => Word16
NC.numStructWords @a, TypedStruct a => Word16
forall a. TypedStruct a => Word16
NC.numStructPtrs @a) Message ('Mut s)
msg


parseEnum :: (R.ReprFor a ~ 'R.Data 'R.Sz16, Enum a, Applicative m)
    => R.Raw 'Const a -> m a
parseEnum :: Raw 'Const a -> m a
parseEnum (R.Raw Untyped 'Const (ReprFor a)
n) = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$ Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
Untyped 'Const (ReprFor a)
n

encodeEnum :: forall a m s. (R.ReprFor a ~ 'R.Data 'R.Sz16, Enum a, U.RWCtx m s)
    => M.Message ('Mut s) -> a -> m (R.Raw ('Mut s) a)
encodeEnum :: Message ('Mut s) -> a -> m (Raw ('Mut s) a)
encodeEnum Message ('Mut s)
_msg a
value = Raw ('Mut s) a -> m (Raw ('Mut s) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Raw ('Mut s) a -> m (Raw ('Mut s) a))
-> Raw ('Mut s) a -> m (Raw ('Mut s) a)
forall a b. (a -> b) -> a -> b
$ Untyped ('Mut s) (ReprFor a) -> Raw ('Mut s) a
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw (Untyped ('Mut s) (ReprFor a) -> Raw ('Mut s) a)
-> Untyped ('Mut s) (ReprFor a) -> Raw ('Mut s) a
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> Int -> Word16
forall a b. (a -> b) -> a -> b
$ a -> Int
forall a. Enum a => a -> Int
fromEnum @a a
value

parseCap :: (R.IsCap a, U.ReadCtx m 'Const) => R.Raw 'Const a -> m (Client a)
parseCap :: Raw 'Const a -> m (Client a)
parseCap (R.Raw Untyped 'Const (ReprFor a)
cap) = Client -> Client a
forall a. Client -> Client a
Client (Client -> Client a) -> m Client -> m (Client a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cap 'Const -> m Client
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Cap mut -> m Client
U.getClient Cap 'Const
Untyped 'Const (ReprFor a)
cap

encodeCap :: (R.IsCap a, U.RWCtx m s) => M.Message ('Mut s) -> Client a -> m (R.Raw ('Mut s) a)
encodeCap :: Message ('Mut s) -> Client a -> m (Raw ('Mut s) a)
encodeCap Message ('Mut s)
msg (Client Client
c) = Cap ('Mut s) -> Raw ('Mut s) a
forall (mut :: Mutability) a. Untyped mut (ReprFor a) -> Raw mut a
R.Raw (Cap ('Mut s) -> Raw ('Mut s) a)
-> m (Cap ('Mut s)) -> m (Raw ('Mut s) a)
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
c