module Network.IPFS.MIME.RawPlainText.Types (RawPlainText) where

import           Network.HTTP.Media
import qualified Servant.API        as API

import           RIO
import qualified RIO.ByteString.Lazy as Lazy

-- Built-in version includes charset
-- https://github.com/haskell-servant/servant/issues/1002
data RawPlainText

instance API.Accept RawPlainText where
  contentType :: Proxy RawPlainText -> MediaType
contentType Proxy RawPlainText
_ = ByteString
"text" ByteString -> ByteString -> MediaType
// ByteString
"plain"

instance API.MimeRender RawPlainText Text where
  mimeRender :: Proxy RawPlainText -> Text -> ByteString
mimeRender Proxy RawPlainText
_ = ByteString -> ByteString
Lazy.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance API.MimeRender RawPlainText ByteString where
  mimeRender :: Proxy RawPlainText -> ByteString -> ByteString
mimeRender Proxy RawPlainText
_ = ByteString -> ByteString
Lazy.fromStrict

instance API.MimeRender RawPlainText Lazy.ByteString where
  mimeRender :: Proxy RawPlainText -> ByteString -> ByteString
mimeRender Proxy RawPlainText
_ = forall a. a -> a
id

instance API.MimeUnrender RawPlainText Text where
  mimeUnrender :: Proxy RawPlainText -> ByteString -> Either String Text
mimeUnrender Proxy RawPlainText
_ ByteString
bs =
    case ByteString -> Either UnicodeException Text
decodeUtf8' forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Lazy.toStrict ByteString
bs of
      Left  UnicodeException
err -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show UnicodeException
err
      Right Text
txt -> forall a b. b -> Either a b
Right Text
txt

instance API.MimeUnrender RawPlainText ByteString where
  mimeUnrender :: Proxy RawPlainText -> ByteString -> Either String ByteString
mimeUnrender Proxy RawPlainText
_ = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.toStrict

instance API.MimeUnrender RawPlainText Lazy.ByteString where
  mimeUnrender :: Proxy RawPlainText -> ByteString -> Either String ByteString
mimeUnrender Proxy RawPlainText
_ = forall a b. b -> Either a b
Right