{-
   Neptune Backend API

   No description provided (generated by Openapi Generator https://github.com/openapitools/openapi-generator)

   OpenAPI Version: 3.0.1
   Neptune Backend API API version: 2.8
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : Neptune.Backend.MimeTypes
-}

{-# LANGUAGE ConstraintKinds           #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts          #-}
{-# LANGUAGE FlexibleInstances         #-}
{-# LANGUAGE MultiParamTypeClasses     #-}
{-# LANGUAGE OverloadedStrings         #-}
{-# LANGUAGE ScopedTypeVariables       #-}
{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}

module Neptune.Backend.MimeTypes where

import qualified Control.Arrow              as P (left)
import qualified Data.Aeson                 as A
import qualified Data.ByteString            as B
import qualified Data.ByteString.Builder    as BB
import qualified Data.ByteString.Char8      as BC
import qualified Data.ByteString.Lazy       as BL
import qualified Data.ByteString.Lazy.Char8 as BCL
import qualified Data.Data                  as P (Typeable)
import qualified Data.Proxy                 as P (Proxy (..))
import qualified Data.String                as P
import qualified Data.Text                  as T
import qualified Data.Text.Encoding         as T
import qualified Network.HTTP.Media         as ME
import qualified Web.FormUrlEncoded         as WH
import qualified Web.HttpApiData            as WH

import           Prelude                    (Bool (..), Char, Double, FilePath,
                                             Float, Int, Integer, Maybe (..),
                                             String, fmap, mempty, undefined,
                                             ($), (.), (<$>), (<*>))
import qualified Prelude                    as P

-- * ContentType MimeType

data ContentType a = MimeType a => ContentType { ContentType a -> a
unContentType :: a }

-- * Accept MimeType

data Accept a = MimeType a => Accept { Accept a -> a
unAccept :: a }

-- * Consumes Class

class MimeType mtype => Consumes req mtype where

-- * Produces Class

class MimeType mtype => Produces req mtype where

-- * Default Mime Types

data MimeJSON = MimeJSON deriving (P.Typeable)
data MimeXML = MimeXML deriving (P.Typeable)
data MimePlainText = MimePlainText deriving (P.Typeable)
data MimeFormUrlEncoded = MimeFormUrlEncoded deriving (P.Typeable)
data MimeMultipartFormData = MimeMultipartFormData deriving (P.Typeable)
data MimeOctetStream = MimeOctetStream deriving (P.Typeable)
data MimeNoContent = MimeNoContent deriving (P.Typeable)
data MimeAny = MimeAny deriving (P.Typeable)

-- | A type for responses without content-body.
data NoContent = NoContent
  deriving (Int -> NoContent -> ShowS
[NoContent] -> ShowS
NoContent -> String
(Int -> NoContent -> ShowS)
-> (NoContent -> String)
-> ([NoContent] -> ShowS)
-> Show NoContent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoContent] -> ShowS
$cshowList :: [NoContent] -> ShowS
show :: NoContent -> String
$cshow :: NoContent -> String
showsPrec :: Int -> NoContent -> ShowS
$cshowsPrec :: Int -> NoContent -> ShowS
P.Show, NoContent -> NoContent -> Bool
(NoContent -> NoContent -> Bool)
-> (NoContent -> NoContent -> Bool) -> Eq NoContent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoContent -> NoContent -> Bool
$c/= :: NoContent -> NoContent -> Bool
== :: NoContent -> NoContent -> Bool
$c== :: NoContent -> NoContent -> Bool
P.Eq, P.Typeable)


-- * MimeType Class

class P.Typeable mtype => MimeType mtype  where
  {-# MINIMAL mimeType | mimeTypes #-}

  mimeTypes :: P.Proxy mtype -> [ME.MediaType]
  mimeTypes Proxy mtype
p =
    case Proxy mtype -> Maybe MediaType
forall mtype. MimeType mtype => Proxy mtype -> Maybe MediaType
mimeType Proxy mtype
p of
      Just MediaType
x  -> [MediaType
x]
      Maybe MediaType
Nothing -> []

  mimeType :: P.Proxy mtype -> Maybe ME.MediaType
  mimeType Proxy mtype
p =
    case Proxy mtype -> [MediaType]
forall mtype. MimeType mtype => Proxy mtype -> [MediaType]
mimeTypes Proxy mtype
p of
      []    -> Maybe MediaType
forall a. Maybe a
Nothing
      (MediaType
x:[MediaType]
_) -> MediaType -> Maybe MediaType
forall a. a -> Maybe a
Just MediaType
x

  mimeType' :: mtype -> Maybe ME.MediaType
  mimeType' mtype
_ = Proxy mtype -> Maybe MediaType
forall mtype. MimeType mtype => Proxy mtype -> Maybe MediaType
mimeType (Proxy mtype
forall k (t :: k). Proxy t
P.Proxy :: P.Proxy mtype)
  mimeTypes' :: mtype -> [ME.MediaType]
  mimeTypes' mtype
_ = Proxy mtype -> [MediaType]
forall mtype. MimeType mtype => Proxy mtype -> [MediaType]
mimeTypes (Proxy mtype
forall k (t :: k). Proxy t
P.Proxy :: P.Proxy mtype)

-- Default MimeType Instances

-- | @application/json; charset=utf-8@
instance MimeType MimeJSON where
  mimeType :: Proxy MimeJSON -> Maybe MediaType
mimeType Proxy MimeJSON
_ = MediaType -> Maybe MediaType
forall a. a -> Maybe a
Just (MediaType -> Maybe MediaType) -> MediaType -> Maybe MediaType
forall a b. (a -> b) -> a -> b
$ String -> MediaType
forall a. IsString a => String -> a
P.fromString String
"application/json"
-- | @application/xml; charset=utf-8@
instance MimeType MimeXML where
  mimeType :: Proxy MimeXML -> Maybe MediaType
mimeType Proxy MimeXML
_ = MediaType -> Maybe MediaType
forall a. a -> Maybe a
Just (MediaType -> Maybe MediaType) -> MediaType -> Maybe MediaType
forall a b. (a -> b) -> a -> b
$ String -> MediaType
forall a. IsString a => String -> a
P.fromString String
"application/xml"
-- | @application/x-www-form-urlencoded@
instance MimeType MimeFormUrlEncoded where
  mimeType :: Proxy MimeFormUrlEncoded -> Maybe MediaType
mimeType Proxy MimeFormUrlEncoded
_ = MediaType -> Maybe MediaType
forall a. a -> Maybe a
Just (MediaType -> Maybe MediaType) -> MediaType -> Maybe MediaType
forall a b. (a -> b) -> a -> b
$ String -> MediaType
forall a. IsString a => String -> a
P.fromString String
"application/x-www-form-urlencoded"
-- | @multipart/form-data@
instance MimeType MimeMultipartFormData where
  mimeType :: Proxy MimeMultipartFormData -> Maybe MediaType
mimeType Proxy MimeMultipartFormData
_ = MediaType -> Maybe MediaType
forall a. a -> Maybe a
Just (MediaType -> Maybe MediaType) -> MediaType -> Maybe MediaType
forall a b. (a -> b) -> a -> b
$ String -> MediaType
forall a. IsString a => String -> a
P.fromString String
"multipart/form-data"
-- | @text/plain; charset=utf-8@
instance MimeType MimePlainText where
  mimeType :: Proxy MimePlainText -> Maybe MediaType
mimeType Proxy MimePlainText
_ = MediaType -> Maybe MediaType
forall a. a -> Maybe a
Just (MediaType -> Maybe MediaType) -> MediaType -> Maybe MediaType
forall a b. (a -> b) -> a -> b
$ String -> MediaType
forall a. IsString a => String -> a
P.fromString String
"text/plain"
-- | @application/octet-stream@
instance MimeType MimeOctetStream where
  mimeType :: Proxy MimeOctetStream -> Maybe MediaType
mimeType Proxy MimeOctetStream
_ = MediaType -> Maybe MediaType
forall a. a -> Maybe a
Just (MediaType -> Maybe MediaType) -> MediaType -> Maybe MediaType
forall a b. (a -> b) -> a -> b
$ String -> MediaType
forall a. IsString a => String -> a
P.fromString String
"application/octet-stream"
-- | @"*/*"@
instance MimeType MimeAny where
  mimeType :: Proxy MimeAny -> Maybe MediaType
mimeType Proxy MimeAny
_ = MediaType -> Maybe MediaType
forall a. a -> Maybe a
Just (MediaType -> Maybe MediaType) -> MediaType -> Maybe MediaType
forall a b. (a -> b) -> a -> b
$ String -> MediaType
forall a. IsString a => String -> a
P.fromString String
"*/*"
instance MimeType MimeNoContent where
  mimeType :: Proxy MimeNoContent -> Maybe MediaType
mimeType Proxy MimeNoContent
_ = Maybe MediaType
forall a. Maybe a
Nothing

-- * MimeRender Class

class MimeType mtype => MimeRender mtype x where
    mimeRender  :: P.Proxy mtype -> x -> BL.ByteString
    mimeRender' :: mtype -> x -> BL.ByteString
    mimeRender' mtype
_ x
x = Proxy mtype -> x -> ByteString
forall mtype x.
MimeRender mtype x =>
Proxy mtype -> x -> ByteString
mimeRender (Proxy mtype
forall k (t :: k). Proxy t
P.Proxy :: P.Proxy mtype) x
x


mimeRenderDefaultMultipartFormData :: WH.ToHttpApiData a => a -> BL.ByteString
mimeRenderDefaultMultipartFormData :: a -> ByteString
mimeRenderDefaultMultipartFormData = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (a -> Text) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. ToHttpApiData a => a -> Text
WH.toQueryParam

-- Default MimeRender Instances

-- | `A.encode`
instance A.ToJSON a => MimeRender MimeJSON a where mimeRender :: Proxy MimeJSON -> a -> ByteString
mimeRender Proxy MimeJSON
_ = a -> ByteString
forall a. ToJSON a => a -> ByteString
A.encode
-- | @WH.urlEncodeAsForm@
instance WH.ToForm a => MimeRender MimeFormUrlEncoded a where mimeRender :: Proxy MimeFormUrlEncoded -> a -> ByteString
mimeRender Proxy MimeFormUrlEncoded
_ = a -> ByteString
forall a. ToForm a => a -> ByteString
WH.urlEncodeAsForm

-- | @P.id@
instance MimeRender MimePlainText BL.ByteString where mimeRender :: Proxy MimePlainText -> ByteString -> ByteString
mimeRender Proxy MimePlainText
_ = ByteString -> ByteString
forall a. a -> a
P.id
-- | @BL.fromStrict . T.encodeUtf8@
instance MimeRender MimePlainText T.Text where mimeRender :: Proxy MimePlainText -> Text -> ByteString
mimeRender Proxy MimePlainText
_ = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
-- | @BCL.pack@
instance MimeRender MimePlainText String where mimeRender :: Proxy MimePlainText -> String -> ByteString
mimeRender Proxy MimePlainText
_ = String -> ByteString
BCL.pack

-- | @P.id@
instance MimeRender MimeOctetStream BL.ByteString where mimeRender :: Proxy MimeOctetStream -> ByteString -> ByteString
mimeRender Proxy MimeOctetStream
_ = ByteString -> ByteString
forall a. a -> a
P.id
-- | @BL.fromStrict . T.encodeUtf8@
instance MimeRender MimeOctetStream T.Text where mimeRender :: Proxy MimeOctetStream -> Text -> ByteString
mimeRender Proxy MimeOctetStream
_ = ByteString -> ByteString
BL.fromStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
-- | @BCL.pack@
instance MimeRender MimeOctetStream String where mimeRender :: Proxy MimeOctetStream -> String -> ByteString
mimeRender Proxy MimeOctetStream
_ = String -> ByteString
BCL.pack

instance MimeRender MimeMultipartFormData BL.ByteString where mimeRender :: Proxy MimeMultipartFormData -> ByteString -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = ByteString -> ByteString
forall a. a -> a
P.id

instance MimeRender MimeMultipartFormData Bool where mimeRender :: Proxy MimeMultipartFormData -> Bool -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = Bool -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData Char where mimeRender :: Proxy MimeMultipartFormData -> Char -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = Char -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData Double where mimeRender :: Proxy MimeMultipartFormData -> Double -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = Double -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData Float where mimeRender :: Proxy MimeMultipartFormData -> Float -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = Float -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData Int where mimeRender :: Proxy MimeMultipartFormData -> Int -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = Int -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData Integer where mimeRender :: Proxy MimeMultipartFormData -> Integer -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = Integer -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData String where mimeRender :: Proxy MimeMultipartFormData -> String -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = String -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData
instance MimeRender MimeMultipartFormData T.Text where mimeRender :: Proxy MimeMultipartFormData -> Text -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = Text -> ByteString
forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | @P.Right . P.const NoContent@
instance MimeRender MimeNoContent NoContent where mimeRender :: Proxy MimeNoContent -> NoContent -> ByteString
mimeRender Proxy MimeNoContent
_ = ByteString -> NoContent -> ByteString
forall a b. a -> b -> a
P.const ByteString
BCL.empty


-- * MimeUnrender Class

class MimeType mtype => MimeUnrender mtype o where
    mimeUnrender :: P.Proxy mtype -> BL.ByteString -> P.Either String o
    mimeUnrender' :: mtype -> BL.ByteString -> P.Either String o
    mimeUnrender' mtype
_ ByteString
x = Proxy mtype -> ByteString -> Either String o
forall mtype o.
MimeUnrender mtype o =>
Proxy mtype -> ByteString -> Either String o
mimeUnrender (Proxy mtype
forall k (t :: k). Proxy t
P.Proxy :: P.Proxy mtype) ByteString
x

-- Default MimeUnrender Instances

-- | @A.eitherDecode@
instance A.FromJSON a => MimeUnrender MimeJSON a where mimeUnrender :: Proxy MimeJSON -> ByteString -> Either String a
mimeUnrender Proxy MimeJSON
_ = ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode
-- | @P.left T.unpack . WH.urlDecodeAsForm@
instance WH.FromForm a => MimeUnrender MimeFormUrlEncoded a where mimeUnrender :: Proxy MimeFormUrlEncoded -> ByteString -> Either String a
mimeUnrender Proxy MimeFormUrlEncoded
_ = (Text -> String) -> Either Text a -> Either String a
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left Text -> String
T.unpack (Either Text a -> Either String a)
-> (ByteString -> Either Text a) -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either Text a
forall a. FromForm a => ByteString -> Either Text a
WH.urlDecodeAsForm
-- | @P.Right . P.id@

instance MimeUnrender MimePlainText BL.ByteString where mimeUnrender :: Proxy MimePlainText -> ByteString -> Either String ByteString
mimeUnrender Proxy MimePlainText
_ = ByteString -> Either String ByteString
forall a b. b -> Either a b
P.Right (ByteString -> Either String ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. a -> a
P.id
-- | @P.left P.show . TL.decodeUtf8'@
instance MimeUnrender MimePlainText T.Text where mimeUnrender :: Proxy MimePlainText -> ByteString -> Either String Text
mimeUnrender Proxy MimePlainText
_ = (UnicodeException -> String)
-> Either UnicodeException Text -> Either String Text
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left UnicodeException -> String
forall a. Show a => a -> String
P.show (Either UnicodeException Text -> Either String Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (ByteString -> ByteString)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict
-- | @P.Right . BCL.unpack@
instance MimeUnrender MimePlainText String where mimeUnrender :: Proxy MimePlainText -> ByteString -> Either String String
mimeUnrender Proxy MimePlainText
_ = String -> Either String String
forall a b. b -> Either a b
P.Right (String -> Either String String)
-> (ByteString -> String) -> ByteString -> Either String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BCL.unpack

-- | @P.Right . P.id@
instance MimeUnrender MimeOctetStream BL.ByteString where mimeUnrender :: Proxy MimeOctetStream -> ByteString -> Either String ByteString
mimeUnrender Proxy MimeOctetStream
_ = ByteString -> Either String ByteString
forall a b. b -> Either a b
P.Right (ByteString -> Either String ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. a -> a
P.id
-- | @P.left P.show . T.decodeUtf8' . BL.toStrict@
instance MimeUnrender MimeOctetStream T.Text where mimeUnrender :: Proxy MimeOctetStream -> ByteString -> Either String Text
mimeUnrender Proxy MimeOctetStream
_ = (UnicodeException -> String)
-> Either UnicodeException Text -> Either String Text
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left UnicodeException -> String
forall a. Show a => a -> String
P.show (Either UnicodeException Text -> Either String Text)
-> (ByteString -> Either UnicodeException Text)
-> ByteString
-> Either String Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either UnicodeException Text
T.decodeUtf8' (ByteString -> Either UnicodeException Text)
-> (ByteString -> ByteString)
-> ByteString
-> Either UnicodeException Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BL.toStrict
-- | @P.Right . BCL.unpack@
instance MimeUnrender MimeOctetStream String where mimeUnrender :: Proxy MimeOctetStream -> ByteString -> Either String String
mimeUnrender Proxy MimeOctetStream
_ = String -> Either String String
forall a b. b -> Either a b
P.Right (String -> Either String String)
-> (ByteString -> String) -> ByteString -> Either String String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BCL.unpack

-- | @P.Right . P.const NoContent@
instance MimeUnrender MimeNoContent NoContent where mimeUnrender :: Proxy MimeNoContent -> ByteString -> Either String NoContent
mimeUnrender Proxy MimeNoContent
_ = NoContent -> Either String NoContent
forall a b. b -> Either a b
P.Right (NoContent -> Either String NoContent)
-> (ByteString -> NoContent)
-> ByteString
-> Either String NoContent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NoContent -> ByteString -> NoContent
forall a b. a -> b -> a
P.const NoContent
NoContent


-- * Custom Mime Types

-- ** MimeImagePng

data MimeImagePng = MimeImagePng deriving (P.Typeable)

-- | @image/png@
instance MimeType MimeImagePng where
  mimeType :: Proxy MimeImagePng -> Maybe MediaType
mimeType Proxy MimeImagePng
_ = MediaType -> Maybe MediaType
forall a. a -> Maybe a
Just (MediaType -> Maybe MediaType) -> MediaType -> Maybe MediaType
forall a b. (a -> b) -> a -> b
$ String -> MediaType
forall a. IsString a => String -> a
P.fromString String
"image/png"
-- instance MimeRender MimeImagePng T.Text where mimeRender _ = undefined
-- instance MimeUnrender MimeImagePng T.Text where mimeUnrender _ = undefined