diff --git a/servant.cabal b/servant.cabal index 91fcb190..fbb89db5 100644 --- a/servant.cabal +++ b/servant.cabal @@ -86,6 +86,7 @@ test-suite spec main-is: Spec.hs build-depends: base == 4.* + , aeson , hspec == 2.* , QuickCheck , parsec diff --git a/src/Servant/API/ContentTypes.hs b/src/Servant/API/ContentTypes.hs index 468d8509..b2d5dc1d 100644 --- a/src/Servant/API/ContentTypes.hs +++ b/src/Servant/API/ContentTypes.hs @@ -15,10 +15,12 @@ import Control.Arrow (left) import Data.Aeson (FromJSON, ToJSON, eitherDecode, encode) import qualified Data.ByteString as BS -import Data.ByteString.Lazy (ByteString) +import Data.ByteString.Lazy (ByteString, fromStrict, toStrict) import Data.String.Conversions (cs) -import qualified Data.Text.Lazy as Text -import qualified Data.Text.Lazy.Encoding as Text +import qualified Data.Text.Lazy as TextL +import qualified Data.Text.Lazy.Encoding as TextL +import qualified Data.Text as TextS +import qualified Data.Text.Encoding as TextS import Data.Typeable import GHC.Exts (Constraint) import qualified Network.HTTP.Media as M @@ -73,6 +75,7 @@ newtype AcceptHeader = AcceptHeader BS.ByteString -- > toByteString _ val = pack ("This is MINE! " ++ show val) -- > -- > type MyAPI = "path" :> Get '[MyContentType] Int +-- class Accept ctype => MimeRender ctype a where toByteString :: Proxy ctype -> a -> ByteString @@ -92,6 +95,20 @@ instance ( AllMimeRender ctyps a, IsNonEmpty ctyps -------------------------------------------------------------------------- -- * Unrender + +-- | Instantiate this class to register a way of deserializing a type based +-- on the request's @Content-Type@ header. +-- +-- > data MyContentType = MyContentType String +-- > +-- > instance Accept MyContentType where +-- > contentType _ = "example" // "prs.me.mine" /: ("charset", "utf-8") +-- > +-- > instance Show a => MimeRender MyContentType where +-- > fromByteString _ bs = MyContentType $ unpack bs +-- > +-- > type MyAPI = "path" :> ReqBody '[MyContentType] :> Get '[JSON] Int +-- class Accept ctype => MimeUnrender ctype a where fromByteString :: Proxy ctype -> ByteString -> Either String a @@ -162,9 +179,13 @@ type family IsNonEmpty (ls::[*]) :: Constraint where instance ToJSON a => MimeRender JSON a where toByteString _ = encode --- | `Text.encodeUtf8` -instance MimeRender PlainText Text.Text where - toByteString _ = Text.encodeUtf8 +-- | `TextL.encodeUtf8` +instance MimeRender PlainText TextL.Text where + toByteString _ = TextL.encodeUtf8 + +-- | `fromStrict . TextS.encodeUtf8` +instance MimeRender PlainText TextS.Text where + toByteString _ = fromStrict . TextS.encodeUtf8 -- | `id` instance MimeRender OctetStream ByteString where @@ -177,9 +198,13 @@ instance MimeRender OctetStream ByteString where instance FromJSON a => MimeUnrender JSON a where fromByteString _ = eitherDecode --- | `left show . Text.decodeUtf8'` -instance MimeUnrender PlainText Text.Text where - fromByteString _ = left show . Text.decodeUtf8' +-- | `left show . TextL.decodeUtf8'` +instance MimeUnrender PlainText TextL.Text where + fromByteString _ = left show . TextL.decodeUtf8' + +-- | `left show . TextS.decodeUtf8' . toStrict` +instance MimeUnrender PlainText TextS.Text where + fromByteString _ = left show . TextS.decodeUtf8' . toStrict -- | `Right . id` instance MimeUnrender OctetStream ByteString where diff --git a/test/Servant/API/ContentTypesSpec.hs b/test/Servant/API/ContentTypesSpec.hs new file mode 100644 index 00000000..6ce225cf --- /dev/null +++ b/test/Servant/API/ContentTypesSpec.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Servant.API.ContentTypesSpec where + +import Control.Applicative +import Data.Aeson +import Data.Proxy +import qualified Data.Text as TextS +import qualified Data.Text.Lazy as TextL +import GHC.Generics +import Test.Hspec +import Test.QuickCheck + +import Servant.API.ContentTypes + +spec :: Spec +spec = describe "Servant.API.ContentTypes" $ do + + describe "The JSON Content-Type type" $ do + + it "has fromByteString reverse toByteString for valid top-level json ([Int]) " $ do + let p = Proxy :: Proxy JSON + property $ \x -> fromByteString p (toByteString p x) == Right (x::[Int]) + + it "has fromByteString reverse toByteString for valid top-level json " $ do + let p = Proxy :: Proxy JSON + property $ \x -> fromByteString p (toByteString p x) == Right (x::SomeData) + + describe "The PlainText Content-Type type" $ do + + it "has fromByteString reverse toByteString (lazy Text)" $ do + let p = Proxy :: Proxy PlainText + property $ \x -> fromByteString p (toByteString p x) == Right (x::TextL.Text) + + it "has fromByteString reverse toByteString (strict Text)" $ do + let p = Proxy :: Proxy PlainText + property $ \x -> fromByteString p (toByteString p x) == Right (x::TextS.Text) + + +data SomeData = SomeData { record1 :: String, record2 :: Int } + deriving (Generic, Eq, Show) + +instance FromJSON SomeData +instance ToJSON SomeData +instance Arbitrary SomeData where + arbitrary = SomeData <$> arbitrary <*> arbitrary + +instance Arbitrary TextL.Text where + arbitrary = TextL.pack <$> arbitrary + +instance Arbitrary TextS.Text where + arbitrary = TextS.pack <$> arbitrary