eeva/servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Merge pull request #18 from haskell-servant/jkarni/decodeLenient

Browse Source 
Use lenient decoding for JSON.
This commit is contained in:
Julian Arni 2015-02-25 13:09:07 +01:00
commit 8cac6c6bb3
3 changed files with 63 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
servant.cabal
View File

@ -45,6 +45,7 @@ library
build-depends:
base >=4.7 && <5
, aeson >= 0.7
, attoparsec >= 0.12
, bytestring == 0.10.*
, http-media >= 0.4 && < 0.7
, http-types == 0.8.*
@ -86,6 +87,7 @@ test-suite spec
build-depends:
base == 4.*
, aeson
, attoparsec
, bytestring
, hspec == 2.*
, QuickCheck

47
src/Servant/API/ContentTypes.hs
View File

@ -11,24 +11,28 @@
{-# LANGUAGE UndecidableInstances #-}
module Servant.API.ContentTypes where
import Control.Arrow (left)
import Control.Applicative ((<*))
import Control.Arrow (left)
import Control.Monad
import Data.Aeson (FromJSON, ToJSON, eitherDecode,
encode)
import qualified Data.ByteString as BS
import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
import qualified Data.ByteString.Lazy as B
import Data.String.Conversions (cs)
import Data.Aeson (FromJSON, ToJSON, Value,
encode, parseJSON)
import Data.Aeson.Parser (value)
import Data.Aeson.Types (parseEither)
import Data.Attoparsec.ByteString (endOfInput, parseOnly)
import qualified Data.ByteString as BS
import Data.ByteString.Lazy (ByteString, fromStrict, toStrict)
import qualified Data.ByteString.Lazy as B
import Data.Monoid
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.String.Conversions (cs)
import qualified Data.Text as TextS
import qualified Data.Text.Encoding as TextS
import qualified Data.Text.Lazy as TextL
import qualified Data.Text.Lazy.Encoding as TextL
import Data.Typeable
import GHC.Exts (Constraint)
import qualified Network.HTTP.Media as M
import Network.URI (unEscapeString, escapeURIString,
isUnreserved)
import GHC.Exts (Constraint)
import qualified Network.HTTP.Media as M
import Network.URI (escapeURIString, isUnreserved,
unEscapeString)
-- * Provided content types
data JSON deriving Typeable
@ -190,6 +194,8 @@ instance ToJSON a => MimeRender JSON a where
toByteString _ = encode
-- | `encodeFormUrlEncoded . toFormUrlEncoded`
-- Note that the `fromByteString p (toByteString p x) == Right x` law only
-- holds if every element of x is non-null (i.e., not `("", "")`)
instance ToFormUrlEncoded a => MimeRender FormUrlEncoded a where
toByteString _ = encodeFormUrlEncoded . toFormUrlEncoded
@ -213,11 +219,20 @@ instance MimeRender OctetStream BS.ByteString where
--------------------------------------------------------------------------
-- * MimeUnrender Instances
-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
-- objects and arrays.
eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
eitherDecodeLenient input = do
v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)
parseEither parseJSON v
-- | `eitherDecode`
instance FromJSON a => MimeUnrender JSON a where
fromByteString _ = eitherDecode
fromByteString _ = eitherDecodeLenient
-- | `decodeFormUrlEncoded >=> fromFormUrlEncoded`
-- Note that the `fromByteString p (toByteString p x) == Right x` law only
-- holds if every element of x is non-null (i.e., not `("", "")`)
instance FromFormUrlEncoded a => MimeUnrender FormUrlEncoded a where
fromByteString _ = decodeFormUrlEncoded >=> fromFormUrlEncoded

44
test/Servant/API/ContentTypesSpec.hs
View File

@ -8,22 +8,24 @@ module Servant.API.ContentTypesSpec where
import Control.Applicative
import Control.Arrow
import Data.Aeson
import Data.Function (on)
import Data.Aeson.Parser (jstring)
import Data.Attoparsec.ByteString (parseOnly)
import Data.Function (on)
import Data.Proxy
import Data.ByteString.Char8 (ByteString, append, pack)
import qualified Data.ByteString.Lazy as BSL
import Data.List (maximumBy)
import Data.Maybe (fromJust, isJust, isNothing)
import Data.String (IsString (..))
import Data.String.Conversions (cs)
import qualified Data.Text as TextS
import qualified Data.Text.Lazy as TextL
import Data.ByteString.Char8 (ByteString, append, pack)
import qualified Data.ByteString.Lazy as BSL
import Data.List (maximumBy)
import Data.Maybe (fromJust, isJust, isNothing)
import Data.String (IsString (..))
import Data.String.Conversions (cs)
import qualified Data.Text as TextS
import qualified Data.Text.Lazy as TextL
import GHC.Generics
import Network.URL (importParams, exportParams)
import Network.URL (exportParams, importParams)
import Test.Hspec
import Test.QuickCheck
import Test.QuickCheck.Instances ()
import Test.QuickCheck.Instances ()
import Servant.API.ContentTypes
@ -42,17 +44,23 @@ spec = describe "Servant.API.ContentTypes" $ do
describe "The FormUrlEncoded Content-Type type" $ do
let isNonNull ("", "") = False
isNonNull _ = True
it "has fromByteString reverse toByteString" $ do
let p = Proxy :: Proxy FormUrlEncoded
property $ \x -> fromByteString p (toByteString p x) == Right (x::[(TextS.Text,TextS.Text)])
property $ \x -> all isNonNull x
==> fromByteString p (toByteString p x) == Right (x::[(TextS.Text,TextS.Text)])
it "has fromByteString reverse exportParams (Network.URL)" $ do
let p = Proxy :: Proxy FormUrlEncoded
property $ \x -> (fromByteString p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
property $ \x -> all isNonNull x
==> (fromByteString p . cs . exportParams . map (cs *** cs) $ x) == Right (x::[(TextS.Text,TextS.Text)])
it "has importParams (Network.URL) reverse toByteString" $ do
let p = Proxy :: Proxy FormUrlEncoded
property $ \x -> (fmap (map (cs *** cs)) . importParams . cs . toByteString p $ x) == Just (x::[(TextS.Text,TextS.Text)])
property $ \x -> all isNonNull x
==> (fmap (map (cs *** cs)) . importParams . cs . toByteString p $ x) == Just (x::[(TextS.Text,TextS.Text)])
describe "The PlainText Content-Type type" $ do
@ -148,6 +156,14 @@ spec = describe "Servant.API.ContentTypes" $ do
(encode val)
`shouldBe` Just (Right val)
describe "eitherDecodeLenient" $ do
it "parses top-level strings" $ do
let toMaybe = either (const Nothing) Just
-- The Left messages differ, so convert to Maybe
property $ \x -> toMaybe (eitherDecodeLenient x)
`shouldBe` toMaybe (parseOnly jstring $ cs x)
data SomeData = SomeData { record1 :: String, record2 :: Int }
deriving (Generic, Eq, Show)