content: -- | This module contains a collection of some of the Internet Media or Mime types
  -- and class to serialize and deserialize them.
  -- At the moment we only support a small set but its possible to write own custom
  -- types and provide the required instances.
  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)
  
  -- * Provided Content types
  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
  
  -- | Instances of 'HasMediaType' are useful for matching against the @Accept@ HTTP header
  -- of the request and setting @Content-Type@ header of the response
  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
  
  -- * Helper functions
  
  -- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
  -- objects and arrays. This function is borrowed from @servant@
  --
  -- Will handle trailing whitespace, but not trailing junk. ie.
  --
  -- >>> eitherDecodeLenient "1 " :: Either String Int
  -- Right 1
  --
  -- >>> eitherDecodeLenient "1 junk" :: Either String Int
  -- Left "trailing junk after valid JSON: endOfInput"
  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")
  