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

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

import Control.Monad ((<=<))
import Data.Text.Lazy (pack, unpack)
import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8')
import Data.Text.Encoding.Error (UnicodeException(..))
import Text.Read (readEither)

import Servant.API.ContentTypes

-- | Content-type for instances of the 'Show' and 'Read' classes encoded as
-- UTF-8 data. This is probably slow.
data ShowRead

-- | Mime-type using the phrases "haskell" and "showread".
instance Accept ShowRead where
    contentTypes :: Proxy ShowRead -> NonEmpty MediaType
contentTypes Proxy ShowRead
Proxy = forall a. [a] -> NonEmpty a
NonEmpty.fromList
        [ ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"x-haskell-showread"
        , ByteString
"application" ByteString -> ByteString -> MediaType
// ByteString
"vnd.haskell.showread"
        ]

instance Show a => MimeRender ShowRead a where
    mimeRender :: Proxy ShowRead -> a -> ByteString
mimeRender Proxy ShowRead
Proxy = Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

-- $setup
-- >>> :set -XOverloadedStrings

-- | Decode UTF-8 data and then with 'Read' instance.
--
-- >>> mimeUnrender (Proxy :: Proxy ShowRead) "1e5" :: Either String Double
-- Right 100000.0
--
-- >>> mimeUnrender (Proxy :: Proxy ShowRead) "hello" :: Either String Double
-- Left "Prelude.read: no parse"
--
-- >>> mimeUnrender (Proxy :: Proxy ShowRead) "hello\xc3\x28" :: Either String Double
-- Left "Data.Text.Internal.Encoding.streamDecodeUtf8With: Invalid UTF-8 stream: invalid byte-value: 195"
instance Read a => MimeUnrender ShowRead a where
    mimeUnrender :: Proxy ShowRead -> ByteString -> Either String a
mimeUnrender Proxy ShowRead
Proxy = forall a. Read a => String -> Either String a
readEither forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall {a} {b} {b}. (a -> b) -> Either a b -> Either b b
mapLeft UnicodeException -> String
prettyErr forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
decodeUtf8'
      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 :: UnicodeException -> String
prettyErr (DecodeError String
err Maybe Word8
byteVal) =
            String
err forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ((String
": invalid byte-value: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) Maybe Word8
byteVal
        prettyErr UnicodeException
_ = String
"unknown error" -- TODO: when 'text' removes deprecated 'EncodeError' constructor, remove this case