git.iko.soy/typeable/servant
on master help sign in
Some tests for provided content-types.
0453cc3Julian K. Arni
servant.cabal+1
compare with master
unifiedsplit
@@ -86,6 +86,7 @@ test-suite spec
86 main-is: Spec.hs
86 main-is: Spec.hs
87 build-depends:
87 build-depends:
88 base == 4.*
88 base == 4.*
89+ , aeson
89 , hspec == 2.*
90 , hspec == 2.*
90 , QuickCheck
91 , QuickCheck
91 , parsec
92 , parsec
src/Servant/API/ContentTypes.hs+34−9
@@ -15,10 +15,12 @@ import Control.Arrow (left)
15import Data.Aeson (FromJSON, ToJSON, eitherDecode,
15import Data.Aeson (FromJSON, ToJSON, eitherDecode,
16 encode)
16 encode)
17import qualified Data.ByteString as BS
17import qualified Data.ByteString as BS
18−import Data.ByteString.Lazy (ByteString)
18+import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
19import Data.String.Conversions (cs)
19import Data.String.Conversions (cs)
20−import qualified Data.Text.Lazy as Text
20+import qualified Data.Text.Lazy as TextL
21−import qualified Data.Text.Lazy.Encoding as Text
21+import qualified Data.Text.Lazy.Encoding as TextL
22+import qualified Data.Text as TextS
23+import qualified Data.Text.Encoding as TextS
22import Data.Typeable
24import Data.Typeable
23import GHC.Exts (Constraint)
25import GHC.Exts (Constraint)
24import qualified Network.HTTP.Media as M
26import qualified Network.HTTP.Media as M
@@ -73,6 +75,7 @@ newtype AcceptHeader = AcceptHeader BS.ByteString
73-- > toByteString _ val = pack ("This is MINE! " ++ show val)
75-- > toByteString _ val = pack ("This is MINE! " ++ show val)
74-- >
76-- >
75-- > type MyAPI = "path" :> Get '[MyContentType] Int
77-- > type MyAPI = "path" :> Get '[MyContentType] Int
78+--
76class Accept ctype => MimeRender ctype a where
79class Accept ctype => MimeRender ctype a where
77 toByteString :: Proxy ctype -> a -> ByteString
80 toByteString :: Proxy ctype -> a -> ByteString
78
81
@@ -92,6 +95,20 @@ instance ( AllMimeRender ctyps a, IsNonEmpty ctyps
92
95
93--------------------------------------------------------------------------
96--------------------------------------------------------------------------
94-- * Unrender
97-- * Unrender
98+
99+-- | Instantiate this class to register a way of deserializing a type based
100+-- on the request's @Content-Type@ header.
101+--
102+-- > data MyContentType = MyContentType String
103+-- >
104+-- > instance Accept MyContentType where
105+-- > contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8")
106+-- >
107+-- > instance Show a => MimeRender MyContentType where
108+-- > fromByteString _ bs = MyContentType $ unpack bs
109+-- >
110+-- > type MyAPI = "path" :> ReqBody '[MyContentType] :> Get '[JSON] Int
111+--
95class Accept ctype => MimeUnrender ctype a where
112class Accept ctype => MimeUnrender ctype a where
96 fromByteString :: Proxy ctype -> ByteString -> Either String a
113 fromByteString :: Proxy ctype -> ByteString -> Either String a
97
114
@@ -162,9 +179,13 @@ type family IsNonEmpty (ls::[*]) :: Constraint where
162instance ToJSON a => MimeRender JSON a where
179instance ToJSON a => MimeRender JSON a where
163 toByteString _ = encode
180 toByteString _ = encode
164
181
182+-- | `TextL.encodeUtf8`
183+instance MimeRender PlainText TextL.Text where
165−-- | `Text.encodeUtf8`
184+ toByteString _ = TextL.encodeUtf8
185+
186+-- | `fromStrict . TextS.encodeUtf8`
166−instance MimeRender PlainText Text.Text where
187+instance MimeRender PlainText TextS.Text where
167− toByteString _ = Text.encodeUtf8
188+ toByteString _ = fromStrict . TextS.encodeUtf8
168
189
169-- | `id`
190-- | `id`
170instance MimeRender OctetStream ByteString where
191instance MimeRender OctetStream ByteString where
@@ -177,9 +198,13 @@ instance MimeRender OctetStream ByteString where
177instance FromJSON a => MimeUnrender JSON a where
198instance FromJSON a => MimeUnrender JSON a where
178 fromByteString _ = eitherDecode
199 fromByteString _ = eitherDecode
179
200
180−-- | `left show . Text.decodeUtf8'`
201+-- | `left show . TextL.decodeUtf8'`
202+instance MimeUnrender PlainText TextL.Text where
203+ fromByteString _ = left show . TextL.decodeUtf8'
204+
205+-- | `left show . TextS.decodeUtf8' . toStrict`
181−instance MimeUnrender PlainText Text.Text where
206+instance MimeUnrender PlainText TextS.Text where
182− fromByteString _ = left show . Text.decodeUtf8'
207+ fromByteString _ = left show . TextS.decodeUtf8' . toStrict
183
208
184-- | `Right . id`
209-- | `Right . id`
185instance MimeUnrender OctetStream ByteString where
210instance MimeUnrender OctetStream ByteString where
test/Servant/API/ContentTypesSpec.hsnew file+52
@@ -0,0 +1,52 @@
1+{-# LANGUAGE DeriveGeneric #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
3+module Servant.API.ContentTypesSpec where
4+
5+import Control.Applicative
6+import Data.Aeson
7+import Data.Proxy
8+import qualified Data.Text as TextS
9+import qualified Data.Text.Lazy as TextL
10+import GHC.Generics
11+import Test.Hspec
12+import Test.QuickCheck
13+
14+import Servant.API.ContentTypes
15+
16+spec :: Spec
17+spec = describe "Servant.API.ContentTypes" $ do
18+
19+ describe "The JSON Content-Type type" $ do
20+
21+ it "has fromByteString reverse toByteString for valid top-level json ([Int]) " $ do
22+ let p = Proxy :: Proxy JSON
23+ property $ \x -> fromByteString p (toByteString p x) == Right (x::[Int])
24+
25+ it "has fromByteString reverse toByteString for valid top-level json " $ do
26+ let p = Proxy :: Proxy JSON
27+ property $ \x -> fromByteString p (toByteString p x) == Right (x::SomeData)
28+
29+ describe "The PlainText Content-Type type" $ do
30+
31+ it "has fromByteString reverse toByteString (lazy Text)" $ do
32+ let p = Proxy :: Proxy PlainText
33+ property $ \x -> fromByteString p (toByteString p x) == Right (x::TextL.Text)
34+
35+ it "has fromByteString reverse toByteString (strict Text)" $ do
36+ let p = Proxy :: Proxy PlainText
37+ property $ \x -> fromByteString p (toByteString p x) == Right (x::TextS.Text)
38+
39+
40+data SomeData = SomeData { record1 :: String, record2 :: Int }
41+ deriving (Generic, Eq, Show)
42+
43+instance FromJSON SomeData
44+instance ToJSON SomeData
45+instance Arbitrary SomeData where
46+ arbitrary = SomeData <$> arbitrary <*> arbitrary
47+
48+instance Arbitrary TextL.Text where
49+ arbitrary = TextL.pack <$> arbitrary
50+
51+instance Arbitrary TextS.Text where
52+ arbitrary = TextS.pack <$> arbitrary