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

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

import Servant.API.ContentTypes
import Data.Binary

-- | Content-type for instances of the 'Binary' class in the package "binary".
-- Trailing garbage is ignored.
data BinaryFmt

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

-- |
--
-- >>> mimeRender (Proxy :: Proxy BinaryFmt) (3.14 :: Float)
-- "\NUL\NUL\200\245\195\255\255\255\255\255\255\255\234"
instance Binary a => MimeRender BinaryFmt a where
    mimeRender :: Proxy BinaryFmt -> a -> ByteString
mimeRender Proxy BinaryFmt
Proxy = forall a. Binary a => a -> ByteString
encode

-- |
--
-- >>> let bsl = mimeRender (Proxy :: Proxy BinaryFmt) (3.14 :: Float)
-- >>> mimeUnrender (Proxy :: Proxy BinaryFmt) bsl :: Either String Float
-- Right 3.14
--
-- >>> mimeUnrender (Proxy :: Proxy BinaryFmt) (bsl <> "trailing garbage") :: Either String Float
-- Right 3.14
--
-- >>> mimeUnrender (Proxy :: Proxy BinaryFmt) ("preceding garbage" <> bsl) :: Either String Float
-- Left "Data.Binary.decodeOrFail: not enough bytes at byte-offset 30"
instance Binary a => MimeUnrender BinaryFmt a where
    mimeUnrender :: Proxy BinaryFmt -> ByteString -> Either String a
mimeUnrender Proxy BinaryFmt
Proxy ByteString
bsl =
        case forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
decodeOrFail ByteString
bsl of
            Left (ByteString
_unconsumedInput, ByteOffset
consumedByteCt, String
err) -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Data.Binary.decodeOrFail: " 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
consumedByteCt
            Right (ByteString
_unconsumedInput, ByteOffset
_consumedByteCt, a
val) -> forall a b. b -> Either a b
Right a
val