Move accept handling into servant-server.

This commit is contained in:
Julian K. Arni 2015-01-12 15:09:19 +01:00
parent 8930a45403
commit 98e02ea7cf
2 changed files with 6 additions and 49 deletions

View file

@ -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 )

View file

@ -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