{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Servant.API.ContentTypes.SerialiseCBOR where

import Data.Proxy (Proxy(..))
import Network.HTTP.Media ((//))
import qualified Data.List.NonEmpty as NonEmpty

import Servant.API.ContentTypes
import Codec.Serialise

-- | Content-type for instances of the 'Serialise' class in the package
-- "serialise". Trailing garbage is ignored.
data CBOR

-- | Mime-type for CBOR and additional ones using the word "hackage" and the
-- name of the package "serialise".
instance Accept CBOR where
    contentTypes :: Proxy CBOR -> NonEmpty MediaType
contentTypes Proxy CBOR
Proxy = forall a. [a] -> NonEmpty a
NonEmpty.fromList
        [ ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"cbor"
        , ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"x-hackage-binary"
        , ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"vnd.hackage.binary"
        ]

-- |
--
-- >>> mimeRender (Proxy :: Proxy CBOR) (3.14 :: Float)
-- "\250@H\245\195"
instance Serialise a => MimeRender CBOR a where
    mimeRender :: Proxy CBOR -> a -> ByteString
mimeRender Proxy CBOR
Proxy = forall a. Serialise a => a -> ByteString
serialise

-- |
--
-- >>> let bsl = mimeRender (Proxy :: Proxy CBOR) (3.14 :: Float)
-- >>> mimeUnrender (Proxy :: Proxy CBOR) bsl :: Either String Float
-- Right 3.14
--
-- >>> mimeUnrender (Proxy :: Proxy CBOR) (bsl <> "trailing garbage") :: Either String Float
-- Right 3.14
--
-- >>> mimeUnrender (Proxy :: Proxy CBOR) ("preceding garbage" <> bsl) :: Either String Float
-- Left "Codec.Serialise.deserialiseOrFail: expected float at byte-offset 0"
instance Serialise a => MimeUnrender CBOR a where
    mimeUnrender :: Proxy CBOR -> ByteString -> Either String a
mimeUnrender Proxy CBOR
Proxy = forall {a} {b} {b}. (a -> b) -> Either a b -> Either b b
mapLeft DeserialiseFailure -> String
prettyErr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Serialise a => ByteString -> Either DeserialiseFailure a
deserialiseOrFail
      where
        mapLeft :: (a -> b) -> Either a b -> Either b b
mapLeft a -> b
f = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall a b. b -> Either a b
Right
        prettyErr :: DeserialiseFailure -> String
prettyErr (DeserialiseFailure ByteOffset
offset String
err) =
            String
"Codec.Serialise.deserialiseOrFail: " forall a. [a] -> [a] -> [a]
++ String
err forall a. [a] -> [a] -> [a]
++ String
" at byte-offset " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ByteOffset
offset