git.iko.soy/typeable/servant
on master help sign in
Some tests for provided content-types.
commit0453cc3d2ac79cad7b7020563fa04b1f91542195 authorJulian K. Arni <jkarni@gmail.com> dateFri 20 Feb 2015, 01:07 (12 years ago) parentd299bd3
3 files changed+87−9
compare with master
unifiedsplit
servant.cabal+1 src/Servant/API/ContentTypes.hs+34−9 test/Servant/API/ContentTypesSpec.hs+52
servant.cabal+1
@@ -86,6 +86,7 @@ test-suite spec
8686 main-is: Spec.hs
8787 build-depends:
8888 base == 4.*
89+ , aeson
8990 , hspec == 2.*
9091 , QuickCheck
9192 , parsec
src/Servant/API/ContentTypes.hs+34−9
@@ -15,10 +15,12 @@ import Control.Arrow (left)
1515import Data.Aeson (FromJSON, ToJSON, eitherDecode,
1616 encode)
1717import qualified Data.ByteString as BS
18−import Data.ByteString.Lazy (ByteString)
18+import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
1919import Data.String.Conversions (cs)
20−import qualified Data.Text.Lazy as Text
21−import qualified Data.Text.Lazy.Encoding as Text
20+import qualified Data.Text.Lazy as TextL
21+import qualified Data.Text.Lazy.Encoding as TextL
22+import qualified Data.Text as TextS
23+import qualified Data.Text.Encoding as TextS
2224import Data.Typeable
2325import GHC.Exts (Constraint)
2426import qualified Network.HTTP.Media as M
@@ -73,6 +75,7 @@ newtype AcceptHeader = AcceptHeader BS.ByteString
7375-- > toByteString _ val = pack ("This is MINE! " ++ show val)
7476-- >
7577-- > type MyAPI = "path" :> Get '[MyContentType] Int
78+--
7679class Accept ctype => MimeRender ctype a where
7780 toByteString :: Proxy ctype -> a -> ByteString
7881
@@ -92,6 +95,20 @@ instance ( AllMimeRender ctyps a, IsNonEmpty ctyps
9295
9396--------------------------------------------------------------------------
9497-- * 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+--
95112class Accept ctype => MimeUnrender ctype a where
96113 fromByteString :: Proxy ctype -> ByteString -> Either String a
97114
@@ -162,9 +179,13 @@ type family IsNonEmpty (ls::[*]) :: Constraint where
162179instance ToJSON a => MimeRender JSON a where
163180 toByteString _ = encode
164181
165−-- | `Text.encodeUtf8`
166−instance MimeRender PlainText Text.Text where
167− toByteString _ = Text.encodeUtf8
182+-- | `TextL.encodeUtf8`
183+instance MimeRender PlainText TextL.Text where
184+ toByteString _ = TextL.encodeUtf8
185+
186+-- | `fromStrict . TextS.encodeUtf8`
187+instance MimeRender PlainText TextS.Text where
188+ toByteString _ = fromStrict . TextS.encodeUtf8
168189
169190-- | `id`
170191instance MimeRender OctetStream ByteString where
@@ -177,9 +198,13 @@ instance MimeRender OctetStream ByteString where
177198instance FromJSON a => MimeUnrender JSON a where
178199 fromByteString _ = eitherDecode
179200
180−-- | `left show . Text.decodeUtf8'`
181−instance MimeUnrender PlainText Text.Text where
182− fromByteString _ = 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`
206+instance MimeUnrender PlainText TextS.Text where
207+ fromByteString _ = left show . TextS.decodeUtf8' . toStrict
183208
184209-- | `Right . id`
185210instance 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