git.iko.soy/typeable/servant
on master help sign in
Merge pull request #18 from haskell-servant/jkarni/decodeLenient

Use lenient decoding for JSON.

commit8cac6c6bb339b2e395422691946a0c1c4c8d9520 authorJulian Arni <jkarni@gmail.com> dateWed 25 Feb 2015, 13:09 (12 years ago) parentb00596a1a200f1
3 files changed+63−30
compare with master
unifiedsplit
servant.cabal+2 src/Servant/API/ContentTypes.hs+31−16 test/Servant/API/ContentTypesSpec.hs+30−14
servant.cabal+2
@@ -45,6 +45,7 @@ library
4545 build-depends:
4646 base >=4.7 && <5
4747 , aeson >= 0.7
48+ , attoparsec >= 0.12
4849 , bytestring == 0.10.*
4950 , http-media >= 0.4 && < 0.7
5051 , http-types == 0.8.*
@@ -86,6 +87,7 @@ test-suite spec
8687 build-depends:
8788 base == 4.*
8889 , aeson
90+ , attoparsec
8991 , bytestring
9092 , hspec == 2.*
9193 , QuickCheck
src/Servant/API/ContentTypes.hs+31−16
@@ -11,24 +11,28 @@
1111{-# LANGUAGE UndecidableInstances #-}
1212module Servant.API.ContentTypes where
1313
14−import Control.Arrow (left)
14+import Control.Applicative ((<*))
15+import Control.Arrow (left)
1516import Control.Monad
16−import Data.Aeson (FromJSON, ToJSON, eitherDecode,
17− encode)
18−import qualified Data.ByteString as BS
19−import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
20−import qualified Data.ByteString.Lazy as B
21−import Data.String.Conversions (cs)
17+import Data.Aeson (FromJSON, ToJSON, Value,
18+ encode, parseJSON)
19+import Data.Aeson.Parser (value)
20+import Data.Aeson.Types (parseEither)
21+import Data.Attoparsec.ByteString (endOfInput, parseOnly)
22+import qualified Data.ByteString as BS
23+import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
24+import qualified Data.ByteString.Lazy as B
2225import Data.Monoid
23−import qualified Data.Text.Lazy as TextL
24−import qualified Data.Text.Lazy.Encoding as TextL
25−import qualified Data.Text as TextS
26−import qualified Data.Text.Encoding as TextS
26+import Data.String.Conversions (cs)
27+import qualified Data.Text as TextS
28+import qualified Data.Text.Encoding as TextS
29+import qualified Data.Text.Lazy as TextL
30+import qualified Data.Text.Lazy.Encoding as TextL
2731import Data.Typeable
28−import GHC.Exts (Constraint)
29−import qualified Network.HTTP.Media as M
30−import Network.URI (unEscapeString, escapeURIString,
31− isUnreserved)
32+import GHC.Exts (Constraint)
33+import qualified Network.HTTP.Media as M
34+import Network.URI (escapeURIString, isUnreserved,
35+ unEscapeString)
3236
3337-- * Provided content types
3438data JSON deriving Typeable
@@ -190,6 +194,8 @@ instance ToJSON a => MimeRender JSON a where
190194 toByteString _ = encode
191195
192196-- | `encodeFormUrlEncoded . toFormUrlEncoded`
197+-- Note that the `fromByteString p (toByteString p x) == Right x` law only
198+-- holds if every element of x is non-null (i.e., not `("", "")`)
193199instance ToFormUrlEncoded a => MimeRender FormUrlEncoded a where
194200 toByteString _ = encodeFormUrlEncoded . toFormUrlEncoded
195201
@@ -213,11 +219,20 @@ instance MimeRender OctetStream BS.ByteString where
213219--------------------------------------------------------------------------
214220-- * MimeUnrender Instances
215221
222+-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
223+-- objects and arrays.
224+eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
225+eitherDecodeLenient input = do
226+ v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)
227+ parseEither parseJSON v
228+
216229-- | `eitherDecode`
217230instance FromJSON a => MimeUnrender JSON a where
218− fromByteString _ = eitherDecode
231+ fromByteString _ = eitherDecodeLenient
219232
220233-- | `decodeFormUrlEncoded >=> fromFormUrlEncoded`
234+-- Note that the `fromByteString p (toByteString p x) == Right x` law only
235+-- holds if every element of x is non-null (i.e., not `("", "")`)
221236instance FromFormUrlEncoded a => MimeUnrender FormUrlEncoded a where
222237 fromByteString _ = decodeFormUrlEncoded >=> fromFormUrlEncoded
223238
test/Servant/API/ContentTypesSpec.hs+30−14
@@ -8,22 +8,24 @@ module Servant.API.ContentTypesSpec where
88import Control.Applicative
99import Control.Arrow
1010import Data.Aeson
11−import Data.Function (on)
11+import Data.Aeson.Parser (jstring)
12+import Data.Attoparsec.ByteString (parseOnly)
13+import Data.Function (on)
1214import Data.Proxy
1315
14−import Data.ByteString.Char8 (ByteString, append, pack)
15−import qualified Data.ByteString.Lazy as BSL
16−import Data.List (maximumBy)
17−import Data.Maybe (fromJust, isJust, isNothing)
18−import Data.String (IsString (..))
19−import Data.String.Conversions (cs)
20−import qualified Data.Text as TextS
21−import qualified Data.Text.Lazy as TextL
16+import Data.ByteString.Char8 (ByteString, append, pack)
17+import qualified Data.ByteString.Lazy as BSL
18+import Data.List (maximumBy)
19+import Data.Maybe (fromJust, isJust, isNothing)
20+import Data.String (IsString (..))
21+import Data.String.Conversions (cs)
22+import qualified Data.Text as TextS
23+import qualified Data.Text.Lazy as TextL
2224import GHC.Generics
23−import Network.URL (importParams, exportParams)
25+import Network.URL (exportParams, importParams)
2426import Test.Hspec
2527import Test.QuickCheck
26−import Test.QuickCheck.Instances ()
28+import Test.QuickCheck.Instances ()
2729
2830import Servant.API.ContentTypes
2931
@@ -42,17 +44,23 @@ spec = describe "Servant.API.ContentTypes" $ do
4244
4345 describe "The FormUrlEncoded Content-Type type" $ do
4446
47+ let isNonNull ("", "") = False
48+ isNonNull _ = True
49+
4550 it "has fromByteString reverse toByteString" $ do
4651 let p = Proxy :: Proxy FormUrlEncoded
47− property $ \x -> fromByteString p (toByteString p x) == Right (x::[(TextS.Text,TextS.Text)])
52+ property $ \x -> all isNonNull x
53+ ==> fromByteString p (toByteString p x) == Right (x::[(TextS.Text,TextS.Text)])
4854
4955 it "has fromByteString reverse exportParams (Network.URL)" $ do
5056 let p = Proxy :: Proxy FormUrlEncoded
51− property $ \x -> (fromByteString p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
57+ property $ \x -> all isNonNull x
58+ ==> (fromByteString p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
5259
5360 it "has importParams (Network.URL) reverse toByteString" $ do
5461 let p = Proxy :: Proxy FormUrlEncoded
55− property $ \x -> (fmap (map (cs *** cs)) . importParams . cs . toByteString p $ x) == Just (x::[(TextS.Text,TextS.Text)])
62+ property $ \x -> all isNonNull x
63+ ==> (fmap (map (cs *** cs)) . importParams . cs . toByteString p $ x) == Just (x::[(TextS.Text,TextS.Text)])
5664
5765 describe "The PlainText Content-Type type" $ do
5866
@@ -148,6 +156,14 @@ spec = describe "Servant.API.ContentTypes" $ do
148156 (encode val)
149157 `shouldBe` Just (Right val)
150158
159+ describe "eitherDecodeLenient" $ do
160+
161+ it "parses top-level strings" $ do
162+ let toMaybe = either (const Nothing) Just
163+ -- The Left messages differ, so convert to Maybe
164+ property $ \x -> toMaybe (eitherDecodeLenient x)
165+ `shouldBe` toMaybe (parseOnly jstring $ cs x)
166+
151167
152168data SomeData = SomeData { record1 :: String, record2 :: Int }
153169 deriving (Generic, Eq, Show)