{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | Module with binary instances for data types defined in fixed
--   vector
module Data.Vector.Fixed.Instances.CBOR where

import           Codec.Serialise
import           Codec.CBOR.Encoding           (Encoding,encodeListLen,encodeNull)
import           Codec.CBOR.Decoding           (Decoder,decodeListLenOf,decodeNull)
import           Data.Monoid                   ((<>))
import           Data.Typeable                 (Proxy(..))

import           Data.Vector.Fixed             (Arity)
import qualified Data.Vector.Fixed           as F
import           Data.Vector.Fixed.Cont        (arity,Dim)
import qualified Data.Vector.Fixed.Boxed     as B
import qualified Data.Vector.Fixed.Unboxed   as U
import qualified Data.Vector.Fixed.Primitive as P
import qualified Data.Vector.Fixed.Storable  as S



instance (Arity n, Serialise a) => Serialise (B.Vec n a) where
  encode :: Vec n a -> Encoding
encode = Vec n a -> Encoding
forall (v :: * -> *) a.
(Vector v a, Serialise a) =>
v a -> Encoding
encodeFixedVector
  decode :: Decoder s (Vec n a)
decode = Decoder s (Vec n a)
forall (v :: * -> *) s a.
(Vector v a, Serialise a) =>
Decoder s (v a)
decodeFixedVector

instance (Arity n, P.Prim a, Serialise a) => Serialise (P.Vec n a) where
  encode :: Vec n a -> Encoding
encode = Vec n a -> Encoding
forall (v :: * -> *) a.
(Vector v a, Serialise a) =>
v a -> Encoding
encodeFixedVector
  decode :: Decoder s (Vec n a)
decode = Decoder s (Vec n a)
forall (v :: * -> *) s a.
(Vector v a, Serialise a) =>
Decoder s (v a)
decodeFixedVector

instance (Arity n, S.Storable a, Serialise a) => Serialise (S.Vec n a) where
  encode :: Vec n a -> Encoding
encode = Vec n a -> Encoding
forall (v :: * -> *) a.
(Vector v a, Serialise a) =>
v a -> Encoding
encodeFixedVector
  decode :: Decoder s (Vec n a)
decode = Decoder s (Vec n a)
forall (v :: * -> *) s a.
(Vector v a, Serialise a) =>
Decoder s (v a)
decodeFixedVector

instance (U.Unbox n a, Serialise a) => Serialise (U.Vec n a) where
  encode :: Vec n a -> Encoding
encode = Vec n a -> Encoding
forall (v :: * -> *) a.
(Vector v a, Serialise a) =>
v a -> Encoding
encodeFixedVector
  decode :: Decoder s (Vec n a)
decode = Decoder s (Vec n a)
forall (v :: * -> *) s a.
(Vector v a, Serialise a) =>
Decoder s (v a)
decodeFixedVector

instance (Arity n, Serialise a) => Serialise (F.VecList n a) where
  encode :: VecList n a -> Encoding
encode = VecList n a -> Encoding
forall (v :: * -> *) a.
(Vector v a, Serialise a) =>
v a -> Encoding
encodeFixedVector
  decode :: Decoder s (VecList n a)
decode = Decoder s (VecList n a)
forall (v :: * -> *) s a.
(Vector v a, Serialise a) =>
Decoder s (v a)
decodeFixedVector

instance (Serialise a) => Serialise (F.Only a) where
  encode :: Only a -> Encoding
encode = Only a -> Encoding
forall (v :: * -> *) a.
(Vector v a, Serialise a) =>
v a -> Encoding
encodeFixedVector
  decode :: Decoder s (Only a)
decode = Decoder s (Only a)
forall (v :: * -> *) s a.
(Vector v a, Serialise a) =>
Decoder s (v a)
decodeFixedVector

instance Serialise (F.Empty a) where
  encode :: Empty a -> Encoding
encode = Encoding -> Empty a -> Encoding
forall a b. a -> b -> a
const Encoding
encodeNull
  decode :: Decoder s (Empty a)
decode = Empty a
forall k (a :: k). Empty a
F.Empty Empty a -> Decoder s () -> Decoder s (Empty a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Decoder s ()
forall s. Decoder s ()
decodeNull

-- | Encode vector with statically known size as CBOR list. There's no
--   type tag
encodeFixedVector :: (F.Vector v a, Serialise a) => v a -> Encoding
{-# INLINE encodeFixedVector #-}
encodeFixedVector :: v a -> Encoding
encodeFixedVector v a
v = Word -> Encoding
encodeListLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word) -> Int -> Word
forall a b. (a -> b) -> a -> b
$ v a -> Int
forall (v :: * -> *) a. KnownNat (Dim v) => v a -> Int
F.length v a
v)
                   Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (a -> Encoding) -> v a -> Encoding
forall (v :: * -> *) a m.
(Vector v a, Monoid m) =>
(a -> m) -> v a -> m
F.foldMap a -> Encoding
forall a. Serialise a => a -> Encoding
encode v a
v

-- | Decode vector with statically known size as CBOR list. There's no
--   type tag
decodeFixedVector :: forall v s a. (F.Vector v a, Serialise a) => Decoder s (v a)
{-# INLINE decodeFixedVector #-}
decodeFixedVector :: Decoder s (v a)
decodeFixedVector = do
  Int -> Decoder s ()
forall s. Int -> Decoder s ()
decodeListLenOf (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Proxy (Dim v) -> Int
forall (n :: Nat) (proxy :: Nat -> *). KnownNat n => proxy n -> Int
arity (Proxy (Dim v)
forall k (t :: k). Proxy t
Proxy :: Proxy (Dim v)))
  Decoder s a -> Decoder s (v a)
forall (v :: * -> *) a (f :: * -> *).
(Vector v a, Applicative f) =>
f a -> f (v a)
F.replicateM Decoder s a
forall a s. Serialise a => Decoder s a
decode