module Hreq.Core.API.MediaType
( module Hreq.Core.API.MediaType
, MediaType
, (//)
, matches
, parseAccept
)where
import Prelude ()
import Prelude.Compat
import Control.Exception (Exception)
import Data.Aeson (FromJSON, ToJSON, encode, parseJSON)
import Data.Aeson.Parser (value)
import Data.Aeson.Types (parseEither)
import Data.Attoparsec.ByteString.Char8 (endOfInput, parseOnly, skipSpace, (<?>))
import Data.Bifunctor (first)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.List.NonEmpty as NE
import Data.String.Conversions (cs)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Network.HTTP.Media (MediaType, matches, parseAccept, (//), (/:))
import Text.Read (readMaybe)
import Web.FormUrlEncoded (FromForm, ToForm, urlDecodeAsForm, urlEncodeAsForm)
data JSON deriving Typeable
data PlainText deriving Typeable
data OctetStream deriving Typeable
data FormUrlEncoded deriving Typeable
newtype DecodeError = DecodeError { unDecodeError :: Text }
deriving (Show, Eq)
instance Exception DecodeError
class HasMediaType ctyp where
mediaType :: sing ctyp -> MediaType
mediaType = NE.head . mediaTypes
mediaTypes :: sing ctyp -> NE.NonEmpty MediaType
mediaTypes = (NE.:| []) . mediaType
{-# MINIMAL mediaType | mediaTypes #-}
instance HasMediaType JSON where
mediaTypes _ =
"application" // "json" /: ("charset", "utf-8") NE.:|
[ "application" // "json" ]
instance HasMediaType PlainText where
mediaType _ = "text" // "plain" /: ("charset", "utf-8")
instance HasMediaType FormUrlEncoded where
mediaType _ = "application" // "x-www-form-urlencoded"
instance HasMediaType OctetStream where
mediaType _ = "application" // "octet-stream"
class HasMediaType ctyp => MediaDecode ctyp a where
mediaDecode :: sing ctyp -> LBS.ByteString -> Either DecodeError a
class HasMediaType ctyp => MediaEncode ctyp a where
mediaEncode :: sing ctyp -> a -> LBS.ByteString
instance FromJSON a => MediaDecode JSON a where
mediaDecode _ = first (DecodeError . cs) . eitherDecodeLenient
instance ToJSON a => MediaEncode JSON a where
mediaEncode _ = cs . encode
instance MediaDecode OctetStream ByteString where
mediaDecode _ = Right . cs
instance MediaDecode OctetStream LBS.ByteString where
mediaDecode _ = Right . id
instance MediaEncode OctetStream ByteString where
mediaEncode _ = cs
instance MediaEncode OctetStream LBS.ByteString where
mediaEncode _ = id
instance MediaDecode PlainText Text where
mediaDecode _ = Right . cs
instance Read a => MediaDecode PlainText a where
mediaDecode _ bs =
maybe (Left $ DecodeError $ "Failed to decode: " <> cs bs) Right . readMaybe $ cs bs
instance Show a => MediaEncode PlainText a where
mediaEncode _ = cs . show
instance ToForm a => MediaEncode FormUrlEncoded a where
mediaEncode _ = cs . urlEncodeAsForm
instance FromForm a => MediaDecode FormUrlEncoded a where
mediaDecode _ = first DecodeError . urlDecodeAsForm . cs
eitherDecodeLenient :: FromJSON a => LBS.ByteString -> Either String a
eitherDecodeLenient input =
parseOnly parser (cs input) >>= parseEither parseJSON
where
parser = skipSpace
*> Data.Aeson.Parser.value
<* skipSpace
<* (endOfInput <?> "trailing junk after valid JSON")