-- | Capnproto message canonicalization, per:
--
-- https://capnproto.org/encoding.html#canonicalization
{-# LANGUAGE BangPatterns     #-}
{-# LANGUAGE DataKinds        #-}
{-# 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           Capnp.Message (Mutability (..))
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.MonadReadMessage mutIn m)
    => U.Struct mutIn -> m (M.Message ('Mut s), M.Segment ('Mut s))
canonicalize :: Struct mutIn -> m (Message ('Mut s), Segment ('Mut s))
canonicalize Struct mutIn
rootStructIn = do
    let msgIn :: Message mutIn
msgIn = Struct mutIn -> Message mutIn
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
U.message Struct mutIn
rootStructIn
    -- Note [Allocation strategy]
    WordCount
words <- Message mutIn -> m WordCount
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Message mut -> m WordCount
totalWords Message mutIn
msgIn
    Message ('Mut s)
msgOut <- Maybe WordCount -> m (Message ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Maybe WordCount -> m (Message ('Mut s))
M.newMessage (Maybe WordCount -> m (Message ('Mut s)))
-> Maybe WordCount -> m (Message ('Mut s))
forall a b. (a -> b) -> a -> b
$ WordCount -> Maybe WordCount
forall a. a -> Maybe a
Just WordCount
words
    Struct ('Mut s)
rootStructOut <- Struct mutIn -> Message ('Mut s) -> m (Struct ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Struct mutIn -> Message ('Mut s) -> m (Struct ('Mut s))
cloneCanonicalStruct Struct mutIn
rootStructIn Message ('Mut s)
msgOut
    Struct ('Mut s) -> m ()
forall (m :: * -> *) s. WriteCtx m s => Struct ('Mut s) -> m ()
U.setRoot Struct ('Mut s)
rootStructOut
    Segment ('Mut s)
segOut <- Message ('Mut s) -> Int -> m (Segment ('Mut s))
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message ('Mut s)
msgOut Int
0
    (Message ('Mut s), Segment ('Mut s))
-> m (Message ('Mut s), Segment ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Message ('Mut s)
msgOut, Segment ('Mut s)
segOut)

totalWords :: U.ReadCtx m mut => M.Message mut -> m WordCount
totalWords :: Message mut -> m WordCount
totalWords Message mut
msg = do
    -- Note [Allocation strategy]
    Int
segCount <- Message mut -> m Int
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Message mut -> m Int
M.numSegs Message mut
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 mut
seg <- Message mut -> Int -> m (Segment mut)
forall (m :: * -> *) (mut :: Mutability).
(MonadThrow m, MonadReadMessage mut m) =>
Message mut -> Int -> m (Segment mut)
M.getSegment Message mut
msg Int
i
        Segment mut -> m WordCount
forall (mut :: Mutability) (m :: * -> *).
MonadReadMessage mut m =>
Segment mut -> m WordCount
M.numWords Segment mut
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.MonadReadMessage mutIn m)
    => U.Struct mutIn -> M.Message ('Mut s) -> m (U.Struct ('Mut s))
cloneCanonicalStruct :: Struct mutIn -> Message ('Mut s) -> m (Struct ('Mut s))
cloneCanonicalStruct Struct mutIn
structIn Message ('Mut s)
msgOut = do
    (Word16
nWords, Word16
nPtrs) <- Struct mutIn -> m (Word16, Word16)
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Struct msg -> m (Word16, Word16)
findCanonicalSectionCounts Struct mutIn
structIn
    Struct ('Mut s)
structOut <- 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)
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 mutIn -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Struct mutIn -> Struct ('Mut s) -> m ()
copyCanonicalStruct Struct mutIn
structIn Struct ('Mut s)
structOut
    Struct ('Mut s) -> m (Struct ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Struct ('Mut s)
structOut

copyCanonicalStruct
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.Struct mutIn -> U.Struct ('Mut s) -> m ()
copyCanonicalStruct :: Struct mutIn -> Struct ('Mut s) -> m ()
copyCanonicalStruct Struct mutIn
structIn Struct ('Mut 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 ('Mut s) -> WordCount
forall (msg :: Mutability). Struct msg -> WordCount
U.structWordCount Struct ('Mut 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 ('Mut s) -> Word16
forall (msg :: Mutability). Struct msg -> Word16
U.structPtrCount Struct ('Mut 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 mutIn -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData Int
i Struct mutIn
structIn
        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
word Int
i Struct ('Mut 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 mutIn)
ptrIn <- Int -> Struct mutIn -> m (Maybe (Ptr mutIn))
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr Int
i Struct mutIn
structIn
        Maybe (Ptr ('Mut s))
ptrOut <- Maybe (Ptr mutIn) -> Message ('Mut s) -> m (Maybe (Ptr ('Mut s)))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Maybe (Ptr mutIn) -> Message ('Mut s) -> m (Maybe (Ptr ('Mut s)))
cloneCanonicalPtr Maybe (Ptr mutIn)
ptrIn (Struct ('Mut s) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
U.message Struct ('Mut s)
structOut)
        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))
ptrOut Int
i Struct ('Mut 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 :: Mutability).
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 :: Mutability). 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 :: Mutability).
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 :: Mutability). 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.MonadReadMessage mutIn m)
    => Maybe (U.Ptr mutIn) -> M.Message ('Mut s) -> m (Maybe (U.Ptr ('Mut s)))
cloneCanonicalPtr :: Maybe (Ptr mutIn) -> Message ('Mut s) -> m (Maybe (Ptr ('Mut s)))
cloneCanonicalPtr Maybe (Ptr mutIn)
ptrIn Message ('Mut s)
msgOut =
    case Maybe (Ptr mutIn)
ptrIn of
        Maybe (Ptr mutIn)
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 (U.PtrCap Cap mutIn
cap) -> do
            Client
client <- Cap mutIn -> m Client
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Cap mut -> m Client
U.getClient Cap mutIn
cap
            Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Cap ('Mut s) -> Ptr ('Mut s))
-> Cap ('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) -> Maybe (Ptr ('Mut s)))
-> m (Cap ('Mut s)) -> m (Maybe (Ptr ('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)
msgOut Client
client
        Just (U.PtrStruct Struct mutIn
struct) ->
            Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Struct ('Mut s) -> Ptr ('Mut s))
-> Struct ('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) -> Maybe (Ptr ('Mut s)))
-> m (Struct ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Struct mutIn -> Message ('Mut s) -> m (Struct ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Struct mutIn -> Message ('Mut s) -> m (Struct ('Mut s))
cloneCanonicalStruct Struct mutIn
struct Message ('Mut s)
msgOut
        Just (U.PtrList List mutIn
list) ->
            Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (List ('Mut s) -> Ptr ('Mut s))
-> List ('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) -> Maybe (Ptr ('Mut s)))
-> m (List ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> List mutIn -> Message ('Mut s) -> m (List ('Mut s))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
List mutIn -> Message ('Mut s) -> m (List ('Mut s))
cloneCanonicalList List mutIn
list Message ('Mut s)
msgOut

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

copyCanonicalDataList
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.ListOf mutIn a -> U.ListOf ('Mut s) a -> m (U.ListOf ('Mut s) a)
copyCanonicalDataList :: ListOf mutIn a -> ListOf ('Mut s) a -> m (ListOf ('Mut s) a)
copyCanonicalDataList ListOf mutIn a
listIn ListOf ('Mut 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 mutIn a -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn 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 mutIn a -> m a
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf mutIn a
listIn
        a -> Int -> ListOf ('Mut s) a -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf ('Mut s) a -> m ()
U.setIndex a
value Int
i ListOf ('Mut s) a
listOut
    ListOf ('Mut s) a -> m (ListOf ('Mut s) a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf ('Mut s) a
listOut

copyCanonicalPtrList
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.ListOf mutIn (Maybe (U.Ptr mutIn))
    -> U.ListOf ('Mut s) (Maybe (U.Ptr ('Mut s)))
    -> m (U.ListOf ('Mut s) (Maybe (U.Ptr ('Mut s))))
copyCanonicalPtrList :: ListOf mutIn (Maybe (Ptr mutIn))
-> ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
-> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
copyCanonicalPtrList ListOf mutIn (Maybe (Ptr mutIn))
listIn ListOf ('Mut s) (Maybe (Ptr ('Mut 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 mutIn (Maybe (Ptr mutIn)) -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn (Maybe (Ptr mutIn))
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 mutIn)
ptrIn <- Int -> ListOf mutIn (Maybe (Ptr mutIn)) -> m (Maybe (Ptr mutIn))
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf mutIn (Maybe (Ptr mutIn))
listIn
        Maybe (Ptr ('Mut s))
ptrOut <- Maybe (Ptr mutIn) -> Message ('Mut s) -> m (Maybe (Ptr ('Mut s)))
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Maybe (Ptr mutIn) -> Message ('Mut s) -> m (Maybe (Ptr ('Mut s)))
cloneCanonicalPtr Maybe (Ptr mutIn)
ptrIn (ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> Message ('Mut s)
forall a (mut :: Mutability). HasMessage a mut => a -> Message mut
U.message ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
listOut)
        Maybe (Ptr ('Mut s))
-> Int -> ListOf ('Mut s) (Maybe (Ptr ('Mut s))) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf ('Mut s) a -> m ()
U.setIndex Maybe (Ptr ('Mut s))
ptrOut Int
i ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
listOut
    ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
-> m (ListOf ('Mut s) (Maybe (Ptr ('Mut s))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ListOf ('Mut s) (Maybe (Ptr ('Mut s)))
listOut

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

copyCanonicalStructList
    :: (U.RWCtx m s, M.MonadReadMessage mutIn m)
    => U.ListOf mutIn (U.Struct mutIn)
    -> U.ListOf ('Mut s) (U.Struct ('Mut s))
    -> m ()
copyCanonicalStructList :: ListOf mutIn (Struct mutIn)
-> ListOf ('Mut s) (Struct ('Mut s)) -> m ()
copyCanonicalStructList ListOf mutIn (Struct mutIn)
listIn ListOf ('Mut s) (Struct ('Mut 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 mutIn (Struct mutIn) -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mutIn (Struct mutIn)
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 mutIn
structIn <- Int -> ListOf mutIn (Struct mutIn) -> m (Struct mutIn)
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf mutIn (Struct mutIn)
listIn
        Struct ('Mut s)
structOut <- Int -> ListOf ('Mut s) (Struct ('Mut s)) -> m (Struct ('Mut s))
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf ('Mut s) (Struct ('Mut s))
listOut
        Struct mutIn -> Struct ('Mut s) -> m ()
forall (m :: * -> *) s (mutIn :: Mutability).
(RWCtx m s, MonadReadMessage mutIn m) =>
Struct mutIn -> Struct ('Mut s) -> m ()
copyCanonicalStruct Struct mutIn
structIn Struct ('Mut s)
structOut

findCanonicalListSectionCounts
    :: U.ReadCtx m mut
    => U.ListOf mut (U.Struct mut) -> m (Word16, Word16)
findCanonicalListSectionCounts :: ListOf mut (Struct mut) -> m (Word16, Word16)
findCanonicalListSectionCounts ListOf mut (Struct mut)
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 mut (Struct mut) -> Int
forall (msg :: Mutability) a. ListOf msg a -> Int
U.length ListOf mut (Struct mut)
list =
            (Word16, Word16) -> m (Word16, Word16)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16
nWords, Word16
nPtrs)
        | Bool
otherwise = do
            Struct mut
struct <- Int -> ListOf mut (Struct mut) -> m (Struct mut)
forall (m :: * -> *) (mut :: Mutability) a.
ReadCtx m mut =>
Int -> ListOf mut a -> m a
U.index Int
i ListOf mut (Struct mut)
list
            (Word16
nWords', Word16
nPtrs') <- Struct mut -> m (Word16, Word16)
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Struct msg -> m (Word16, Word16)
findCanonicalSectionCounts Struct mut
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')