-- | Capnproto message canonicalization, per:
--
-- https://capnproto.org/encoding.html#canonicalization
{-# LANGUAGE BangPatterns     #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies     #-}
module Capnp.Canonicalize
    ( canonicalize
    ) where

-- Note [Allocation strategy]
--
-- The implementation makes use of knowledge of how we allocate values inside
-- a message; in particular, we assume objects are allocated sequentially,
-- and that if the first segment is big enough we will never allocate a second
-- segment.
--
-- If we ever make the allocator plugable, we will have to revisit this and
-- ensure that our assumptions still hold.

-- Note [Other assumptions]
--
-- This code relies on the fact that Capnp.Pointer.serializePointer does the
-- canonicalization of zero-sized struct pointers for us; see the comments there
-- for more details.

import Data.Word

import Data.Foldable    (for_)
import Data.Maybe       (isNothing)
import Data.Traversable (for)

import           Capnp.Bits    (WordCount)
import qualified Capnp.Message as M
import qualified Capnp.Untyped as U

-- | Return a canonicalized message with a copy of the given struct as its
-- root. returns a (message, segment) pair, where the segment is the first
-- and only segment of the returned message.
--
-- In addition to the usual reasons for failure when reading a message (traversal limit,
-- malformed messages), this can fail if the message does not fit in a single segment,
-- as the canonical form requires single-segment messages.
canonicalize :: (U.RWCtx m s, M.Message m msgIn) => U.Struct msgIn -> m (M.MutMsg s, M.Segment (M.MutMsg s))
canonicalize :: Struct msgIn -> m (MutMsg s, Segment (MutMsg s))
canonicalize Struct msgIn
rootStructIn = do
    let msgIn :: InMessage (Struct msgIn)
msgIn = Struct msgIn -> InMessage (Struct msgIn)
forall a. HasMessage a => a -> InMessage a
U.message Struct msgIn
rootStructIn
    -- Note [Allocation strategy]
    WordCount
words <- msgIn -> m WordCount
forall (m :: * -> *) msg. ReadCtx m msg => msg -> m WordCount
totalWords msgIn
InMessage (Struct msgIn)
msgIn
    MutMsg s
msgOut <- Maybe WordCount -> m (MutMsg s)
forall (m :: * -> *) s.
WriteCtx m s =>
Maybe WordCount -> m (MutMsg s)
M.newMessage (Maybe WordCount -> m (MutMsg s))
-> Maybe WordCount -> m (MutMsg s)
forall a b. (a -> b) -> a -> b
$ WordCount -> Maybe WordCount
forall a. a -> Maybe a
Just WordCount
words
    Struct (MutMsg s)
rootStructOut <- Struct msgIn -> MutMsg s -> m (Struct (MutMsg s))
forall (m :: * -> *) s msgIn.
(RWCtx m s, Message m msgIn) =>
Struct msgIn -> MutMsg s -> m (Struct (MutMsg s))
cloneCanonicalStruct Struct msgIn
rootStructIn MutMsg s
msgOut
    Struct (MutMsg s) -> m ()
forall (m :: * -> *) s. WriteCtx m s => Struct (MutMsg s) -> m ()
U.setRoot Struct (MutMsg s)
rootStructOut
    Segment (MutMsg s)
segOut <- MutMsg s -> Int -> m (Segment (MutMsg s))
forall (m :: * -> *) msg.
(MonadThrow m, Message m msg) =>
msg -> Int -> m (Segment msg)
M.getSegment MutMsg s
msgOut Int
0
    (MutMsg s, Segment (MutMsg s)) -> m (MutMsg s, Segment (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (MutMsg s
msgOut, Segment (MutMsg s)
segOut)

totalWords :: U.ReadCtx m msg => msg -> m WordCount
totalWords :: msg -> m WordCount
totalWords msg
msg = do
    -- Note [Allocation strategy]
    Int
segCount <- msg -> m Int
forall (m :: * -> *) msg. Message m msg => msg -> m Int
M.numSegs msg
msg
    [WordCount]
sizes <- [Int] -> (Int -> m WordCount) -> m [WordCount]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Int
0..Int
segCount Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1] ((Int -> m WordCount) -> m [WordCount])
-> (Int -> m WordCount) -> m [WordCount]
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
        Segment msg
seg <- msg -> Int -> m (Segment msg)
forall (m :: * -> *) msg.
(MonadThrow m, Message m msg) =>
msg -> Int -> m (Segment msg)
M.getSegment msg
msg Int
i
        Segment msg -> m WordCount
forall (m :: * -> *) msg.
Message m msg =>
Segment msg -> m WordCount
M.numWords Segment msg
seg
    WordCount -> m WordCount
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WordCount -> m WordCount) -> WordCount -> m WordCount
forall a b. (a -> b) -> a -> b
$ [WordCount] -> WordCount
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [WordCount]
sizes

cloneCanonicalStruct :: (U.RWCtx m s, M.Message m msgIn) => U.Struct msgIn -> M.MutMsg s -> m (U.Struct (M.MutMsg s))
cloneCanonicalStruct :: Struct msgIn -> MutMsg s -> m (Struct (MutMsg s))
cloneCanonicalStruct Struct msgIn
structIn MutMsg s
msgOut = do
    (Word16
nWords, Word16
nPtrs) <- Struct msgIn -> m (Word16, Word16)
forall (m :: * -> *) msg.
ReadCtx m msg =>
Struct msg -> m (Word16, Word16)
findCanonicalSectionCounts Struct msgIn
structIn
    Struct (MutMsg s)
structOut <- MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Word16 -> Word16 -> m (Struct (MutMsg s))
U.allocStruct MutMsg s
msgOut (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
nWords) (Word16 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
nPtrs)
    Struct msgIn -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s msgIn.
(RWCtx m s, Message m msgIn) =>
Struct msgIn -> Struct (MutMsg s) -> m ()
copyCanonicalStruct Struct msgIn
structIn Struct (MutMsg s)
structOut
    Struct (MutMsg s) -> m (Struct (MutMsg s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Struct (MutMsg s)
structOut

copyCanonicalStruct :: (U.RWCtx m s, M.Message m msgIn) => U.Struct msgIn -> U.Struct (M.MutMsg s) -> m ()
copyCanonicalStruct :: Struct msgIn -> Struct (MutMsg s) -> m ()
copyCanonicalStruct Struct msgIn
structIn Struct (MutMsg s)
structOut = do
    let nWords :: Int
nWords = WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount -> Int) -> WordCount -> Int
forall a b. (a -> b) -> a -> b
$ Struct (MutMsg s) -> WordCount
forall msg. Struct msg -> WordCount
U.structWordCount Struct (MutMsg s)
structOut
        nPtrs :: Int
nPtrs = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Struct (MutMsg s) -> Word16
forall msg. Struct msg -> Word16
U.structPtrCount Struct (MutMsg s)
structOut
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..Int
nWords 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 -> do
        Word64
word <- Int -> Struct msgIn -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData Int
i Struct msgIn
structIn
        Word64 -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Word64 -> Int -> Struct (MutMsg s) -> m ()
U.setData Word64
word Int
i Struct (MutMsg s)
structOut
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..Int
nPtrs 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 -> do
        Maybe (Ptr msgIn)
ptrIn <- Int -> Struct msgIn -> m (Maybe (Ptr msgIn))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr Int
i Struct msgIn
structIn
        Maybe (Ptr (MutMsg s))
ptrOut <- Maybe (Ptr msgIn) -> MutMsg s -> m (Maybe (Ptr (MutMsg s)))
forall (m :: * -> *) s msgIn.
(RWCtx m s, Message m msgIn) =>
Maybe (Ptr msgIn) -> MutMsg s -> m (Maybe (Ptr (MutMsg s)))
cloneCanonicalPtr Maybe (Ptr msgIn)
ptrIn (Struct (MutMsg s) -> InMessage (Struct (MutMsg s))
forall a. HasMessage a => a -> InMessage a
U.message Struct (MutMsg s)
structOut)
        Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Maybe (Ptr (MutMsg s)) -> Int -> Struct (MutMsg s) -> m ()
U.setPtr Maybe (Ptr (MutMsg s))
ptrOut Int
i Struct (MutMsg s)
structOut

findCanonicalSectionCounts :: U.ReadCtx m msg => U.Struct msg -> m (Word16, Word16)
findCanonicalSectionCounts :: Struct msg -> m (Word16, Word16)
findCanonicalSectionCounts Struct msg
struct = do
    Word16
nWords <- (Word64 -> Bool) -> (Int -> m Word64) -> Int -> m Word16
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (Int -> m a) -> Int -> m Word16
canonicalSectionCount (Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0) (Int -> Struct msg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m Word64
`U.getData` Struct msg
struct) (WordCount -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (WordCount -> Int) -> WordCount -> Int
forall a b. (a -> b) -> a -> b
$ Struct msg -> WordCount
forall msg. Struct msg -> WordCount
U.structWordCount Struct msg
struct)
    Word16
nPtrs <- (Maybe (Ptr msg) -> Bool)
-> (Int -> m (Maybe (Ptr msg))) -> Int -> m Word16
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (Int -> m a) -> Int -> m Word16
canonicalSectionCount Maybe (Ptr msg) -> Bool
forall a. Maybe a -> Bool
isNothing (Int -> Struct msg -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
`U.getPtr` Struct msg
struct) (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Struct msg -> Word16
forall msg. Struct msg -> Word16
U.structPtrCount Struct msg
struct)
    (Word16, Word16) -> m (Word16, Word16)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16
nWords, Word16
nPtrs)

canonicalSectionCount :: Monad m => (a -> Bool) -> (Int -> m a) -> Int -> m Word16
canonicalSectionCount :: (a -> Bool) -> (Int -> m a) -> Int -> m Word16
canonicalSectionCount a -> Bool
_ Int -> m a
_ Int
0 = Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word16
0
canonicalSectionCount a -> Bool
isDefault Int -> m a
getIndex Int
total = do
    a
value <- Int -> m a
getIndex (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    if a -> Bool
isDefault a
value
        then (a -> Bool) -> (Int -> m a) -> Int -> m Word16
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> (Int -> m a) -> Int -> m Word16
canonicalSectionCount a -> Bool
isDefault Int -> m a
getIndex (Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
        else Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> m Word16) -> Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
total

cloneCanonicalPtr :: (U.RWCtx m s, M.Message m msgIn) => Maybe (U.Ptr msgIn) -> M.MutMsg s -> m (Maybe (U.Ptr (M.MutMsg s)))
cloneCanonicalPtr :: Maybe (Ptr msgIn) -> MutMsg s -> m (Maybe (Ptr (MutMsg s)))
cloneCanonicalPtr Maybe (Ptr msgIn)
ptrIn MutMsg s
msgOut =
    case Maybe (Ptr msgIn)
ptrIn of
        Maybe (Ptr msgIn)
Nothing ->
            Maybe (Ptr (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Ptr (MutMsg s))
forall a. Maybe a
Nothing
        Just (U.PtrCap Cap msgIn
cap) -> do
            Client
client <- Cap msgIn -> m Client
forall (m :: * -> *) msg. ReadCtx m msg => Cap msg -> m Client
U.getClient Cap msgIn
cap
            Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> (Cap (MutMsg s) -> Ptr (MutMsg s))
-> Cap (MutMsg s)
-> Maybe (Ptr (MutMsg s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cap (MutMsg s) -> Ptr (MutMsg s)
forall msg. Cap msg -> Ptr msg
U.PtrCap (Cap (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> m (Cap (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> Client -> m (Cap (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Client -> m (Cap (MutMsg s))
U.appendCap MutMsg s
msgOut Client
client
        Just (U.PtrStruct Struct msgIn
struct) ->
            Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> (Struct (MutMsg s) -> Ptr (MutMsg s))
-> Struct (MutMsg s)
-> Maybe (Ptr (MutMsg s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Struct (MutMsg s) -> Ptr (MutMsg s)
forall msg. Struct msg -> Ptr msg
U.PtrStruct (Struct (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> m (Struct (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Struct msgIn -> MutMsg s -> m (Struct (MutMsg s))
forall (m :: * -> *) s msgIn.
(RWCtx m s, Message m msgIn) =>
Struct msgIn -> MutMsg s -> m (Struct (MutMsg s))
cloneCanonicalStruct Struct msgIn
struct MutMsg s
msgOut
        Just (U.PtrList List msgIn
list) ->
            Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> (List (MutMsg s) -> Ptr (MutMsg s))
-> List (MutMsg s)
-> Maybe (Ptr (MutMsg s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List (MutMsg s) -> Ptr (MutMsg s)
forall msg. List msg -> Ptr msg
U.PtrList (List (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> m (List (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List msgIn -> MutMsg s -> m (List (MutMsg s))
forall (m :: * -> *) s msgIn.
(RWCtx m s, Message m msgIn) =>
List msgIn -> MutMsg s -> m (List (MutMsg s))
cloneCanonicalList List msgIn
list MutMsg s
msgOut

cloneCanonicalList :: (U.RWCtx m s, M.Message m msgIn) => U.List msgIn -> M.MutMsg s -> m (U.List (M.MutMsg s))
cloneCanonicalList :: List msgIn -> MutMsg s -> m (List (MutMsg s))
cloneCanonicalList List msgIn
listIn MutMsg s
msgOut =
    case List msgIn
listIn of
        U.List0 ListOf msgIn ()
l -> ListOf (MutMsg s) () -> List (MutMsg s)
forall msg. ListOf msg () -> List msg
U.List0 (ListOf (MutMsg s) () -> List (MutMsg s))
-> m (ListOf (MutMsg s) ()) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> Int -> m (ListOf (MutMsg s) ())
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) ())
U.allocList0 MutMsg s
msgOut (ListOf msgIn () -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msgIn ()
l)
        U.List1 ListOf msgIn Bool
l -> ListOf (MutMsg s) Bool -> List (MutMsg s)
forall msg. ListOf msg Bool -> List msg
U.List1 (ListOf (MutMsg s) Bool -> List (MutMsg s))
-> m (ListOf (MutMsg s) Bool) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Int -> m (ListOf (MutMsg s) Bool)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Bool)
U.allocList1 MutMsg s
msgOut (ListOf msgIn Bool -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msgIn Bool
l) m (ListOf (MutMsg s) Bool)
-> (ListOf (MutMsg s) Bool -> m (ListOf (MutMsg s) Bool))
-> m (ListOf (MutMsg s) Bool)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf msgIn Bool
-> ListOf (MutMsg s) Bool -> m (ListOf (MutMsg s) Bool)
forall (m :: * -> *) s msgIn a.
(RWCtx m s, Message m msgIn) =>
ListOf msgIn a -> ListOf (MutMsg s) a -> m (ListOf (MutMsg s) a)
copyCanonicalDataList ListOf msgIn Bool
l)
        U.List8 ListOf msgIn Word8
l -> ListOf (MutMsg s) Word8 -> List (MutMsg s)
forall msg. ListOf msg Word8 -> List msg
U.List8 (ListOf (MutMsg s) Word8 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word8) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Int -> m (ListOf (MutMsg s) Word8)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word8)
U.allocList8 MutMsg s
msgOut (ListOf msgIn Word8 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msgIn Word8
l) m (ListOf (MutMsg s) Word8)
-> (ListOf (MutMsg s) Word8 -> m (ListOf (MutMsg s) Word8))
-> m (ListOf (MutMsg s) Word8)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf msgIn Word8
-> ListOf (MutMsg s) Word8 -> m (ListOf (MutMsg s) Word8)
forall (m :: * -> *) s msgIn a.
(RWCtx m s, Message m msgIn) =>
ListOf msgIn a -> ListOf (MutMsg s) a -> m (ListOf (MutMsg s) a)
copyCanonicalDataList ListOf msgIn Word8
l)
        U.List16 ListOf msgIn Word16
l -> ListOf (MutMsg s) Word16 -> List (MutMsg s)
forall msg. ListOf msg Word16 -> List msg
U.List16 (ListOf (MutMsg s) Word16 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word16) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Int -> m (ListOf (MutMsg s) Word16)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word16)
U.allocList16 MutMsg s
msgOut (ListOf msgIn Word16 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msgIn Word16
l) m (ListOf (MutMsg s) Word16)
-> (ListOf (MutMsg s) Word16 -> m (ListOf (MutMsg s) Word16))
-> m (ListOf (MutMsg s) Word16)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf msgIn Word16
-> ListOf (MutMsg s) Word16 -> m (ListOf (MutMsg s) Word16)
forall (m :: * -> *) s msgIn a.
(RWCtx m s, Message m msgIn) =>
ListOf msgIn a -> ListOf (MutMsg s) a -> m (ListOf (MutMsg s) a)
copyCanonicalDataList ListOf msgIn Word16
l)
        U.List32 ListOf msgIn Word32
l -> ListOf (MutMsg s) Word32 -> List (MutMsg s)
forall msg. ListOf msg Word32 -> List msg
U.List32 (ListOf (MutMsg s) Word32 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word32) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Int -> m (ListOf (MutMsg s) Word32)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word32)
U.allocList32 MutMsg s
msgOut (ListOf msgIn Word32 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msgIn Word32
l) m (ListOf (MutMsg s) Word32)
-> (ListOf (MutMsg s) Word32 -> m (ListOf (MutMsg s) Word32))
-> m (ListOf (MutMsg s) Word32)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf msgIn Word32
-> ListOf (MutMsg s) Word32 -> m (ListOf (MutMsg s) Word32)
forall (m :: * -> *) s msgIn a.
(RWCtx m s, Message m msgIn) =>
ListOf msgIn a -> ListOf (MutMsg s) a -> m (ListOf (MutMsg s) a)
copyCanonicalDataList ListOf msgIn Word32
l)
        U.List64 ListOf msgIn Word64
l -> ListOf (MutMsg s) Word64 -> List (MutMsg s)
forall msg. ListOf msg Word64 -> List msg
U.List64 (ListOf (MutMsg s) Word64 -> List (MutMsg s))
-> m (ListOf (MutMsg s) Word64) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Int -> m (ListOf (MutMsg s) Word64)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word64)
U.allocList64 MutMsg s
msgOut (ListOf msgIn Word64 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msgIn Word64
l) m (ListOf (MutMsg s) Word64)
-> (ListOf (MutMsg s) Word64 -> m (ListOf (MutMsg s) Word64))
-> m (ListOf (MutMsg s) Word64)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf msgIn Word64
-> ListOf (MutMsg s) Word64 -> m (ListOf (MutMsg s) Word64)
forall (m :: * -> *) s msgIn a.
(RWCtx m s, Message m msgIn) =>
ListOf msgIn a -> ListOf (MutMsg s) a -> m (ListOf (MutMsg s) a)
copyCanonicalDataList ListOf msgIn Word64
l)
        U.ListPtr ListOf msgIn (Maybe (Ptr msgIn))
l -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))) -> List (MutMsg s)
forall msg. ListOf msg (Maybe (Ptr msg)) -> List msg
U.ListPtr (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))) -> List (MutMsg s))
-> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
-> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MutMsg s -> Int -> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
U.allocListPtr MutMsg s
msgOut (ListOf msgIn (Maybe (Ptr msgIn)) -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msgIn (Maybe (Ptr msgIn))
l) m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
-> (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
    -> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))))
-> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf msgIn (Maybe (Ptr msgIn))
-> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
-> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
forall (m :: * -> *) s msgIn.
(RWCtx m s, Message m msgIn) =>
ListOf msgIn (Maybe (Ptr msgIn))
-> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
-> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
copyCanonicalPtrList ListOf msgIn (Maybe (Ptr msgIn))
l)
        U.ListStruct ListOf msgIn (Struct msgIn)
l -> ListOf (MutMsg s) (Struct (MutMsg s)) -> List (MutMsg s)
forall msg. ListOf msg (Struct msg) -> List msg
U.ListStruct (ListOf (MutMsg s) (Struct (MutMsg s)) -> List (MutMsg s))
-> m (ListOf (MutMsg s) (Struct (MutMsg s))) -> m (List (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ListOf msgIn (Struct msgIn)
-> MutMsg s -> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s msgIn.
(RWCtx m s, Message m msgIn) =>
ListOf msgIn (Struct msgIn)
-> MutMsg s -> m (ListOf (MutMsg s) (Struct (MutMsg s)))
cloneCanonicalStructList ListOf msgIn (Struct msgIn)
l MutMsg s
msgOut

copyCanonicalDataList :: (U.RWCtx m s, M.Message m msgIn) => U.ListOf msgIn a -> U.ListOf (M.MutMsg s) a -> m (U.ListOf (M.MutMsg s) a)
copyCanonicalDataList :: ListOf msgIn a -> ListOf (MutMsg s) a -> m (ListOf (MutMsg s) a)
copyCanonicalDataList ListOf msgIn a
listIn ListOf (MutMsg s) a
listOut = do
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..ListOf msgIn a -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msgIn a
listIn 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 -> do
        a
value <- Int -> ListOf msgIn a -> m a
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msgIn a
listIn
        a -> Int -> ListOf (MutMsg s) a -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex a
value Int
i ListOf (MutMsg s) a
listOut
    ListOf (MutMsg s) a -> m (ListOf (MutMsg s) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf (MutMsg s) a
listOut

copyCanonicalPtrList
    :: (U.RWCtx m s, M.Message m msgIn)
    => U.ListOf msgIn (Maybe (U.Ptr msgIn))
    -> U.ListOf (M.MutMsg s) (Maybe (U.Ptr (M.MutMsg s)))
    -> m (U.ListOf (M.MutMsg s) (Maybe (U.Ptr (M.MutMsg s))))
copyCanonicalPtrList :: ListOf msgIn (Maybe (Ptr msgIn))
-> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
-> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
copyCanonicalPtrList ListOf msgIn (Maybe (Ptr msgIn))
listIn ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
listOut = do
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..ListOf msgIn (Maybe (Ptr msgIn)) -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msgIn (Maybe (Ptr msgIn))
listIn 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 -> do
        Maybe (Ptr msgIn)
ptrIn <- Int -> ListOf msgIn (Maybe (Ptr msgIn)) -> m (Maybe (Ptr msgIn))
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msgIn (Maybe (Ptr msgIn))
listIn
        Maybe (Ptr (MutMsg s))
ptrOut <- Maybe (Ptr msgIn) -> MutMsg s -> m (Maybe (Ptr (MutMsg s)))
forall (m :: * -> *) s msgIn.
(RWCtx m s, Message m msgIn) =>
Maybe (Ptr msgIn) -> MutMsg s -> m (Maybe (Ptr (MutMsg s)))
cloneCanonicalPtr Maybe (Ptr msgIn)
ptrIn (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
-> InMessage (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
forall a. HasMessage a => a -> InMessage a
U.message ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
listOut)
        Maybe (Ptr (MutMsg s))
-> Int -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex Maybe (Ptr (MutMsg s))
ptrOut Int
i ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
listOut
    ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
-> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
listOut

cloneCanonicalStructList
    :: (U.RWCtx m s, M.Message m msgIn)
    => U.ListOf msgIn (U.Struct msgIn)
    -> M.MutMsg s
    -> m (U.ListOf (M.MutMsg s) (U.Struct (M.MutMsg s)))
cloneCanonicalStructList :: ListOf msgIn (Struct msgIn)
-> MutMsg s -> m (ListOf (MutMsg s) (Struct (MutMsg s)))
cloneCanonicalStructList ListOf msgIn (Struct msgIn)
listIn MutMsg s
msgOut = do
    (Word16
nWords, Word16
nPtrs) <- ListOf msgIn (Struct msgIn) -> m (Word16, Word16)
forall (m :: * -> *) msg.
ReadCtx m msg =>
ListOf msg (Struct msg) -> m (Word16, Word16)
findCanonicalListSectionCounts ListOf msgIn (Struct msgIn)
listIn
    ListOf (MutMsg s) (Struct (MutMsg s))
listOut <- MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s
-> Word16
-> Word16
-> Int
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
U.allocCompositeList MutMsg s
msgOut Word16
nWords Word16
nPtrs (ListOf msgIn (Struct msgIn) -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msgIn (Struct msgIn)
listIn)
    ListOf msgIn (Struct msgIn)
-> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
forall (m :: * -> *) s msgIn.
(RWCtx m s, Message m msgIn) =>
ListOf msgIn (Struct msgIn)
-> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
copyCanonicalStructList ListOf msgIn (Struct msgIn)
listIn ListOf (MutMsg s) (Struct (MutMsg s))
listOut
    ListOf (MutMsg s) (Struct (MutMsg s))
-> m (ListOf (MutMsg s) (Struct (MutMsg s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf (MutMsg s) (Struct (MutMsg s))
listOut

copyCanonicalStructList
    :: (U.RWCtx m s, M.Message m msgIn)
    => U.ListOf msgIn (U.Struct msgIn)
    -> U.ListOf (M.MutMsg s) (U.Struct (M.MutMsg s))
    -> m ()
copyCanonicalStructList :: ListOf msgIn (Struct msgIn)
-> ListOf (MutMsg s) (Struct (MutMsg s)) -> m ()
copyCanonicalStructList ListOf msgIn (Struct msgIn)
listIn ListOf (MutMsg s) (Struct (MutMsg s))
listOut =
    [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [Int
0..ListOf msgIn (Struct msgIn) -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msgIn (Struct msgIn)
listIn 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 -> do
        Struct msgIn
structIn <- Int -> ListOf msgIn (Struct msgIn) -> m (Struct msgIn)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msgIn (Struct msgIn)
listIn
        Struct (MutMsg s)
structOut <- Int
-> ListOf (MutMsg s) (Struct (MutMsg s)) -> m (Struct (MutMsg s))
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf (MutMsg s) (Struct (MutMsg s))
listOut
        Struct msgIn -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s msgIn.
(RWCtx m s, Message m msgIn) =>
Struct msgIn -> Struct (MutMsg s) -> m ()
copyCanonicalStruct Struct msgIn
structIn Struct (MutMsg s)
structOut

findCanonicalListSectionCounts :: U.ReadCtx m msg => U.ListOf msg (U.Struct msg) -> m (Word16, Word16)
findCanonicalListSectionCounts :: ListOf msg (Struct msg) -> m (Word16, Word16)
findCanonicalListSectionCounts ListOf msg (Struct msg)
list = Int -> Word16 -> Word16 -> m (Word16, Word16)
go Int
0 Word16
0 Word16
0 where
    go :: Int -> Word16 -> Word16 -> m (Word16, Word16)
go Int
i !Word16
nWords !Word16
nPtrs
        | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= ListOf msg (Struct msg) -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg (Struct msg)
list =
            (Word16, Word16) -> m (Word16, Word16)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16
nWords, Word16
nPtrs)
        | Bool
otherwise = do
            Struct msg
struct <- Int -> ListOf msg (Struct msg) -> m (Struct msg)
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg (Struct msg)
list
            (Word16
nWords', Word16
nPtrs') <- Struct msg -> m (Word16, Word16)
forall (m :: * -> *) msg.
ReadCtx m msg =>
Struct msg -> m (Word16, Word16)
findCanonicalSectionCounts Struct msg
struct
            Int -> Word16 -> Word16 -> m (Word16, Word16)
go (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
max Word16
nWords Word16
nWords') (Word16 -> Word16 -> Word16
forall a. Ord a => a -> a -> a
max Word16
nPtrs Word16
nPtrs')