Move accept handling into servant-server.
This commit is contained in:
parent
8930a45403
commit
98e02ea7cf
2 changed files with 6 additions and 49 deletions
|
@ -46,7 +46,7 @@ module Servant.API (
|
|||
|
||||
import Servant.API.Alternative ( (:<|>)(..) )
|
||||
import Servant.API.Capture ( Capture )
|
||||
import Servant.API.ContentTypes ( Accept(..), MimeRender(..), HTML, XML, JSON )
|
||||
import Servant.API.ContentTypes ( HTML, XML, JSON, JavaScript, CSS, PlainText )
|
||||
import Servant.API.Delete ( Delete )
|
||||
import Servant.API.Get ( Get )
|
||||
import Servant.API.Header ( Header )
|
||||
|
|
|
@ -1,55 +1,12 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
module Servant.API.ContentTypes where
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
import Data.Proxy (Proxy(..))
|
||||
import Data.Typeable (Typeable)
|
||||
import Data.Typeable
|
||||
|
||||
|
||||
data XML deriving Typeable
|
||||
data HTML deriving Typeable
|
||||
data JSON deriving Typeable
|
||||
|
||||
type ContentTypeBS = ByteString
|
||||
|
||||
class Accept ctype where
|
||||
isContentType :: Proxy ctype -> ByteString -> Bool
|
||||
contentType :: Proxy ctype -> ContentTypeBS
|
||||
isContentType p bs = bs == contentType p
|
||||
|
||||
instance Accept HTML where
|
||||
contentType _ = "text/html"
|
||||
|
||||
instance Accept JSON where
|
||||
contentType _ = "application/json"
|
||||
|
||||
instance Accept XML where
|
||||
contentType _ = "application/xml"
|
||||
|
||||
-- | Instantiate this class to register a way of serializing a type based
|
||||
-- on the @Accept@ header.
|
||||
class Accept ctype => MimeRender ctype a where
|
||||
toByteString :: Proxy ctype -> a -> ByteString
|
||||
|
||||
|
||||
class AllCTRender list a where
|
||||
handleAcceptH :: Proxy list -> ContentTypeBS -> a -> (ByteString, ContentTypeBS)
|
||||
|
||||
instance MimeRender ctyp a => AllCTRender '[ctyp] a where
|
||||
handleAcceptH _ accept val = (toByteString pctyp val, accept)
|
||||
where pctyp = Proxy :: Proxy ctyp
|
||||
|
||||
instance ( MimeRender ctyp a
|
||||
, AllCTRender ctyps a
|
||||
) => AllCTRender (ctyp ': ctyps) a where
|
||||
handleAcceptH _ accept val
|
||||
| isContentType pctyp accept = (toByteString pctyp val, accept)
|
||||
| otherwise = handleAcceptH pctyps accept val
|
||||
where pctyp = Proxy :: Proxy ctyp
|
||||
pctyps = Proxy :: Proxy ctyps
|
||||
data JavaScript deriving Typeable
|
||||
data CSS deriving Typeable
|
||||
data PlainText deriving Typeable
|
||||
|
|
Loading…
Reference in a new issue