d299bd3 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Move Mime(Un)Render and remove types which don't have instances for them

d299bd3Julian K. Arni12 years ago

servant.cabal+1

compare with master

unifiedsplit

@@ -45,6 +45,7 @@ library

45 Servant.Utils.Links

46 build-depends:

47 base >=4.7 && <5

48+ , aeson >= 0.7

48 , bytestring == 0.10.*

49 , bytestring == 0.10.*

49 , http-media >= 0.4 && < 0.6

50 , http-media >= 0.4 && < 0.6

50 , http-types == 0.8.*

51 , http-types == 0.8.*

src/Servant/API.hs+2−3

@@ -46,9 +46,8 @@ module Servant.API (

47import Servant.API.Alternative ( (:<|>)(..) )

48import Servant.API.Capture ( Capture )

49−import Servant.API.ContentTypes ( HTML, XML, JSON, JavaScript, CSS

49+import Servant.API.ContentTypes ( JSON , PlainText, OctetStream

50− , PlainText, OctetStream, MimeRender(..)

51− , MimeUnrender(..))

50+ , MimeRender(..) , MimeUnrender(..))

52import Servant.API.Delete ( Delete )

51import Servant.API.Delete ( Delete )

53import Servant.API.Get ( Get )

52import Servant.API.Get ( Get )

54import Servant.API.Header ( Header )

53import Servant.API.Header ( Header )

src/Servant/API/ContentTypes.hs+46−30

@@ -1,29 +1,30 @@

1+{-# LANGUAGE ConstraintKinds #-}

2+{-# LANGUAGE DataKinds #-}

1−{-# LANGUAGE DeriveDataTypeable #-}

3+{-# LANGUAGE DeriveDataTypeable #-}

2−{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE ConstraintKinds #-}

4−{-# LANGUAGE FlexibleInstances #-}

4+{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE MultiParamTypeClasses #-}

6−{-# LANGUAGE OverloadedStrings #-}

6+{-# LANGUAGE OverloadedStrings #-}

7−{-# LANGUAGE PolyKinds #-}

7+{-# LANGUAGE PolyKinds #-}

8−{-# LANGUAGE ScopedTypeVariables #-}

8+{-# LANGUAGE ScopedTypeVariables #-}

9−{-# LANGUAGE TypeFamilies #-}

9+{-# LANGUAGE TypeFamilies #-}

10−{-# LANGUAGE TypeOperators #-}

10+{-# LANGUAGE TypeOperators #-}

11−{-# LANGUAGE UndecidableInstances #-}

11+{-# LANGUAGE UndecidableInstances #-}

12module Servant.API.ContentTypes where

14+import Control.Arrow (left)

15+import Data.Aeson (FromJSON, ToJSON, eitherDecode,

16+ encode)

14import qualified Data.ByteString as BS

17import qualified Data.ByteString as BS

15import Data.ByteString.Lazy (ByteString)

18import Data.ByteString.Lazy (ByteString)

16import Data.String.Conversions (cs)

19import Data.String.Conversions (cs)

20+import qualified Data.Text.Lazy as Text

21+import qualified Data.Text.Lazy.Encoding as Text

17import Data.Typeable

22import Data.Typeable

18import GHC.Exts (Constraint)

23import GHC.Exts (Constraint)

19import qualified Network.HTTP.Media as M

24import qualified Network.HTTP.Media as M

21-- * Provided content types

26-- * Provided content types

22−data XML deriving Typeable

23−data HTML deriving Typeable

24data JSON deriving Typeable

27data JSON deriving Typeable

25−data JavaScript deriving Typeable

26−data CSS deriving Typeable

27data PlainText deriving Typeable

28data PlainText deriving Typeable

28data OctetStream deriving Typeable

29data OctetStream deriving Typeable

@@ -41,26 +42,10 @@ data OctetStream deriving Typeable

41class Accept ctype where

42class Accept ctype where

42 contentType :: Proxy ctype -> M.MediaType

43 contentType :: Proxy ctype -> M.MediaType

44−-- | @text/html;charset=utf-8@

45−instance Accept HTML where

46− contentType _ = "text" M.// "html" M./: ("charset", "utf-8")

47−

48-- | @application/json;charset=utf-8@

45-- | @application/json;charset=utf-8@

49instance Accept JSON where

46instance Accept JSON where

50 contentType _ = "application" M.// "json" M./: ("charset", "utf-8")

47 contentType _ = "application" M.// "json" M./: ("charset", "utf-8")

52−-- | @application/xml;charset=utf-8@

53−instance Accept XML where

54− contentType _ = "application" M.// "xml" M./: ("charset", "utf-8")

55−

56−-- | @application/javascript;charset=utf-8@

57−instance Accept JavaScript where

58− contentType _ = "application" M.// "javascript" M./: ("charset", "utf-8")

59−

60−-- | @text/css;charset=utf-8@

61−instance Accept CSS where

62− contentType _ = "text" M.// "css" M./: ("charset", "utf-8")

63−

64-- | @text/plain;charset=utf-8@

49-- | @text/plain;charset=utf-8@

65instance Accept PlainText where

50instance Accept PlainText where

66 contentType _ = "text" M.// "plain" M./: ("charset", "utf-8")

51 contentType _ = "text" M.// "plain" M./: ("charset", "utf-8")

@@ -168,3 +153,34 @@ instance ( MimeUnrender ctyp a

168

153

169type family IsNonEmpty (ls::[*]) :: Constraint where

154type family IsNonEmpty (ls::[*]) :: Constraint where

170 IsNonEmpty (x ': xs) = ()

155 IsNonEmpty (x ': xs) = ()

156+

157+

158+--------------------------------------------------------------------------

159+-- * MimeRender Instances

160+

161+-- | `encode`

162+instance ToJSON a => MimeRender JSON a where

163+ toByteString _ = encode

164+

165+-- | `Text.encodeUtf8`

166+instance MimeRender PlainText Text.Text where

167+ toByteString _ = Text.encodeUtf8

168+

169+-- | `id`

170+instance MimeRender OctetStream ByteString where

171+ toByteString _ = id

172+

173+--------------------------------------------------------------------------

174+-- * MimeUnrender Instances

175+

176+-- | `eitherDecode`

177+instance FromJSON a => MimeUnrender JSON a where

178+ fromByteString _ = eitherDecode

179+

180+-- | `left show . Text.decodeUtf8'`

181+instance MimeUnrender PlainText Text.Text where

182+ fromByteString _ = left show . Text.decodeUtf8'

183+

184+-- | `Right . id`

185+instance MimeUnrender OctetStream ByteString where

186+ fromByteString _ = Right . id

test/Servant/Utils/LinksSpec.hs+4−4

@@ -29,15 +29,15 @@ type TestApi =

29 :<|> "raw" :> Raw

31type TestLink = "hello" :> "hi" :> Get '[JSON] Bool

32−type TestLink2 = "greet" :> Post '[XML] Bool

32+type TestLink2 = "greet" :> Post '[PlainText] Bool

33type TestLink3 = "parent" :> "child" :> Get '[JSON] String

35type BadTestLink = "hallo" :> "hi" :> Get '[JSON] Bool

36−type BadTestLink2 = "greet" :> Get '[XML] Bool

36+type BadTestLink2 = "greet" :> Get '[PlainText] Bool

37type BadTestLink3 = "parent" :> "child" :> MatrixFlag "male" :> Get '[JSON] String

39−type BadTestLink' = "hello" :> "hi" :> Get '[HTML] Bool

39+type BadTestLink' = "hello" :> "hi" :> Get '[OctetStream] Bool

40−type BadTestLink'2 = "greet" :> Get '[HTML] Bool

40+type BadTestLink'2 = "greet" :> Get '[OctetStream] Bool

42type NotALink = "hello" :> Capture "x" Bool :> Get '[JSON] Bool

43type NotALink2 = "hello" :> ReqBody '[JSON] 'True :> Get '[JSON] Bool