{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
{- |
Module: Capnp.Basics.Pure
Description: Handling of "basic" capnp datatypes (high-level API).

Analogous to 'Capnp.Basics' in the low-level API, this module deals
with capnproto's @Text@ and @Data@ types. These are simply aliases for
'BS.ByteString' and the text package's 'T.Text'; mostly this module provides
helper functions and type class instances.

Unlike with the low-level API, typed lists do not require special
treatment -- they're just Vectors.
-}
module Capnp.Basics.Pure
    ( Data
    , Text
    ) where

import Prelude hiding (length)

import Control.Monad       (forM_)
import Control.Monad.Catch (MonadThrow(throwM))
import Data.Text.Encoding  (decodeUtf8', encodeUtf8)

import qualified Data.ByteString as BS
import qualified Data.Text       as T
import qualified Data.Vector     as V

import Capnp.Classes

import Capnp.Errors  (Error(InvalidUtf8Error))
import Capnp.Message (Mutability(..))
import Capnp.Untyped (rawBytes)

import qualified Capnp.Basics  as Basics
import qualified Capnp.Untyped as Untyped

-- | A capnproto @Data@ value. This is just an alias for 'BS.ByteString'.
type Data = BS.ByteString

-- | A capnproto @Text@. This  is just an alias for the text package's 'T.Text'.
type Text = T.Text

instance Decerialize Data where
    type Cerial msg Data = Basics.Data msg
    decerialize :: Cerial 'Const Data -> m Data
decerialize (Basics.Data list) = ListOf 'Const Word8 -> m Data
forall (m :: * -> *).
ReadCtx m 'Const =>
ListOf 'Const Word8 -> m Data
rawBytes ListOf 'Const Word8
list

instance Marshal s Data where
    marshalInto :: Cerial ('Mut s) Data -> Data -> m ()
marshalInto (Basics.Data list) Data
bytes =
        [Int] -> (Int -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
0..Data -> Int
BS.length Data
bytes 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 ->
            Word8 -> Int -> ListOf ('Mut s) Word8 -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf ('Mut s) a -> m ()
Untyped.setIndex (Data -> Int -> Word8
BS.index Data
bytes Int
i) Int
i ListOf ('Mut s) Word8
list

instance Cerialize s Data where
    cerialize :: Message ('Mut s) -> Data -> m (Cerial ('Mut s) Data)
cerialize Message ('Mut s)
msg Data
bytes = do
        Data ('Mut s)
dest <- Message ('Mut s) -> Int -> m (Data ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (Data ('Mut s))
Basics.newData Message ('Mut s)
msg (Data -> Int
BS.length Data
bytes)
        Cerial ('Mut s) Data -> Data -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
marshalInto Cerial ('Mut s) Data
Data ('Mut s)
dest Data
bytes
        Data ('Mut s) -> m (Data ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Data ('Mut s)
dest

instance Decerialize Text where
    type Cerial msg Text = Basics.Text msg
    decerialize :: Cerial 'Const Text -> m Text
decerialize Cerial 'Const Text
text = do
            Data
bytes <- Text 'Const -> m Data
forall (m :: * -> *). ReadCtx m 'Const => Text 'Const -> m Data
Basics.textBytes Cerial 'Const Text
Text 'Const
text
            case Data -> Either UnicodeException Text
decodeUtf8' Data
bytes of
                Left UnicodeException
e    -> Error -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m Text) -> Error -> m Text
forall a b. (a -> b) -> a -> b
$ UnicodeException -> Error
InvalidUtf8Error UnicodeException
e
                Right Text
txt -> Text -> m Text
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
txt

instance Marshal s Text where
    marshalInto :: Cerial ('Mut s) Text -> Text -> m ()
marshalInto Cerial ('Mut s) Text
dest Text
text = Data -> Text ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Data -> Text ('Mut s) -> m ()
marshalTextBytes (Text -> Data
encodeUtf8 Text
text) Cerial ('Mut s) Text
Text ('Mut s)
dest

instance Cerialize s Text where
    cerialize :: Message ('Mut s) -> Text -> m (Cerial ('Mut s) Text)
cerialize Message ('Mut s)
msg Text
text = do
        let bytes :: Data
bytes = Text -> Data
encodeUtf8 Text
text
        Text ('Mut s)
ret <- Message ('Mut s) -> Int -> m (Text ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Int -> m (Text ('Mut s))
Basics.newText Message ('Mut s)
msg (Data -> Int
BS.length Data
bytes)
        Data -> Text ('Mut s) -> m ()
forall (m :: * -> *) s. RWCtx m s => Data -> Text ('Mut s) -> m ()
marshalTextBytes Data
bytes Text ('Mut s)
ret
        Text ('Mut s) -> m (Text ('Mut s))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text ('Mut s)
ret

marshalTextBytes :: Untyped.RWCtx m s => BS.ByteString -> Basics.Text ('Mut s) -> m ()
marshalTextBytes :: Data -> Text ('Mut s) -> m ()
marshalTextBytes Data
bytes Text ('Mut s)
text = do
    ListOf ('Mut s) Word8
buffer <- Text ('Mut s) -> m (ListOf ('Mut s) Word8)
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Text mut -> m (ListOf mut Word8)
Basics.textBuffer Text ('Mut s)
text
    Cerial ('Mut s) Data -> Data -> m ()
forall s a (m :: * -> *).
(Marshal s a, RWCtx m s) =>
Cerial ('Mut s) a -> a -> m ()
marshalInto (ListOf ('Mut s) Word8 -> Data ('Mut s)
forall (mut :: Mutability). ListOf mut Word8 -> Data mut
Basics.Data ListOf ('Mut s) Word8
buffer) Data
bytes

instance Cerialize s (V.Vector Text) where cerialize :: Message ('Mut s)
-> Vector Text -> m (Cerial ('Mut s) (Vector Text))
cerialize = Message ('Mut s)
-> Vector Text -> m (Cerial ('Mut s) (Vector Text))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec
instance Cerialize s (V.Vector Data) where cerialize :: Message ('Mut s)
-> Vector Data -> m (Cerial ('Mut s) (Vector Data))
cerialize = Message ('Mut s)
-> Vector Data -> m (Cerial ('Mut s) (Vector Data))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Text)) where cerialize :: Message ('Mut s)
-> Vector (Vector Text)
-> m (Cerial ('Mut s) (Vector (Vector Text)))
cerialize = Message ('Mut s)
-> Vector (Vector Text)
-> m (Cerial ('Mut s) (Vector (Vector Text)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector Data)) where cerialize :: Message ('Mut s)
-> Vector (Vector Data)
-> m (Cerial ('Mut s) (Vector (Vector Data)))
cerialize = Message ('Mut s)
-> Vector (Vector Data)
-> m (Cerial ('Mut s) (Vector (Vector Data)))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Text))) where cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Text))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Text))))
cerialize = Message ('Mut s)
-> Vector (Vector (Vector Text))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Text))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector Data))) where cerialize :: Message ('Mut s)
-> Vector (Vector (Vector Data))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Data))))
cerialize = Message ('Mut s)
-> Vector (Vector (Vector Data))
-> m (Cerial ('Mut s) (Vector (Vector (Vector Data))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Text)))) where cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Text)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Text)))))
cerialize = Message ('Mut s)
-> Vector (Vector (Vector (Vector Text)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Text)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector Data)))) where cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector Data)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Data)))))
cerialize = Message ('Mut s)
-> Vector (Vector (Vector (Vector Data)))
-> m (Cerial ('Mut s) (Vector (Vector (Vector (Vector Data)))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Text))))) where cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Text))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Text))))))
cerialize = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Text))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Text))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec
instance Cerialize s (V.Vector (V.Vector (V.Vector (V.Vector (V.Vector Data))))) where cerialize :: Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Data))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Data))))))
cerialize = Message ('Mut s)
-> Vector (Vector (Vector (Vector (Vector Data))))
-> m (Cerial
        ('Mut s) (Vector (Vector (Vector (Vector (Vector Data))))))
forall (m :: * -> *) s a.
(RWCtx m s, MutListElem s (Cerial ('Mut s) a), Cerialize s a) =>
Message ('Mut s)
-> Vector a -> m (List ('Mut s) (Cerial ('Mut s) a))
cerializeBasicVec