-- | MIME types for HTTP bodies
module WebGear.Core.MIMETypes (
  MIMEType (..),
  FormURLEncoded (..),
  HTML (..),
  JSON (..),
  FormData (..),
  FormDataResult (..),
  OctetStream (..),
  PlainText (..),
) where

import Data.String (IsString (fromString))
import Data.Text (Text, unpack)
import qualified Network.HTTP.Media as HTTP
import qualified Network.Wai.Parse as Wai.Parse

-- | MIME types used in the Accept and Content-Type headers
class MIMEType mt where
  mimeType :: mt -> HTTP.MediaType

--------------------------------------------------------------------------------

-- | The application/x-www-form-urlencoded MIME type
data FormURLEncoded = FormURLEncoded

instance MIMEType FormURLEncoded where
  mimeType :: FormURLEncoded -> HTTP.MediaType
  mimeType :: FormURLEncoded -> MediaType
mimeType FormURLEncoded
FormURLEncoded = MediaType
"application/x-www-form-urlencoded"
  {-# INLINE mimeType #-}

--------------------------------------------------------------------------------

-- | The text/html MIME type
data HTML = HTML

instance MIMEType HTML where
  mimeType :: HTML -> HTTP.MediaType
  mimeType :: HTML -> MediaType
mimeType HTML
HTML = MediaType
"text/html"
  {-# INLINE mimeType #-}

--------------------------------------------------------------------------------

-- | A JSON MIME type with customizable media type
data JSON
  = -- | JSON with a specific media type
    JSONMedia Text
  | -- | application/json media type
    JSON

instance MIMEType JSON where
  mimeType :: JSON -> HTTP.MediaType
  mimeType :: JSON -> MediaType
mimeType =
    \case
      JSONMedia Text
mt -> String -> MediaType
forall a. IsString a => String -> a
fromString (Text -> String
unpack Text
mt)
      JSON
JSON -> MediaType
"application/json"
  {-# INLINE mimeType #-}

--------------------------------------------------------------------------------

-- | The multipart/form-data MIME type
data FormData a = FormData
  { forall a. FormData a -> ParseRequestBodyOptions
parseOptions :: Wai.Parse.ParseRequestBodyOptions
  , forall a. FormData a -> BackEnd a
backendOptions :: Wai.Parse.BackEnd a
  }

{- | Result of parsing a multipart/form-data body from a request.
The body can contain both parameters and files.
-}
data FormDataResult a = FormDataResult
  { forall a. FormDataResult a -> [Param]
formDataParams :: [Wai.Parse.Param]
  , forall a. FormDataResult a -> [File a]
formDataFiles :: [Wai.Parse.File a]
  }

instance MIMEType (FormData a) where
  mimeType :: FormData a -> HTTP.MediaType
  mimeType :: FormData a -> MediaType
mimeType FormData a
_ = MediaType
"multipart/form-data"
  {-# INLINE mimeType #-}

--------------------------------------------------------------------------------

-- | The application/octet-stream MIME type
data OctetStream = OctetStream

instance MIMEType OctetStream where
  mimeType :: OctetStream -> HTTP.MediaType
  mimeType :: OctetStream -> MediaType
mimeType OctetStream
OctetStream = MediaType
"application/octet-stream"
  {-# INLINE mimeType #-}

--------------------------------------------------------------------------------

-- | The text/plain MIME type
data PlainText = PlainText

instance MIMEType PlainText where
  mimeType :: PlainText -> HTTP.MediaType
  mimeType :: PlainText -> MediaType
mimeType PlainText
PlainText = MediaType
"text/plain"
  {-# INLINE mimeType #-}