Skip to content

Commit

Permalink
Get rid of eitherDecodeLenient
Browse files Browse the repository at this point in the history
  • Loading branch information
maksbotan committed Jul 12, 2023
1 parent 942c7e2 commit 681c9cd
Show file tree
Hide file tree
Showing 3 changed files with 9 additions and 52 deletions.
19 changes: 2 additions & 17 deletions doc/tutorial/Server.lhs
Original file line number Diff line number Diff line change
Expand Up @@ -47,7 +47,6 @@ import System.Directory
import Text.Blaze
import Text.Blaze.Html.Renderer.Utf8
import Servant.Types.SourceT (source)
import qualified Data.Aeson.Parser
import qualified Text.Blaze.Html
```
Expand Down Expand Up @@ -431,25 +430,11 @@ class Accept ctype => MimeUnrender ctype a where
mimeUnrender :: Proxy ctype -> ByteString -> Either String a
```
We don't have much work to do there either, `Data.Aeson.eitherDecode` is
precisely what we need. However, it only allows arrays and objects as toplevel
JSON values and this has proven to get in our way more than help us so we wrote
our own little function around **aeson** and **attoparsec** that allows any type of
JSON value at the toplevel of a "JSON document". Here's the definition in case
you are curious.
``` haskell
eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
eitherDecodeLenient input = do
v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)
parseEither parseJSON v
```
This function is exactly what we need for our `MimeUnrender` instance.
As with `MimeRender`, we can use a function already available in `aeson`: `Data.Aeson.eitherDecode`.
``` haskell ignore
instance FromJSON a => MimeUnrender JSON a where
mimeUnrender _ = eitherDecodeLenient
mimeUnrender _ = eitherDecode
```
And this is all the code that lets you use `JSON` with `ReqBody`, `Get`,
Expand Down
30 changes: 2 additions & 28 deletions servant/src/Servant/API/ContentTypes.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,7 +65,6 @@ module Servant.API.ContentTypes
, AllMime(..)
, AllMimeRender(..)
, AllMimeUnrender(..)
, eitherDecodeLenient
, canHandleAcceptH
) where

Expand All @@ -75,13 +74,7 @@ import Control.Monad.Compat
import Control.DeepSeq
(NFData)
import Data.Aeson
(FromJSON (..), ToJSON (..), encode)
import Data.Aeson.Parser
(value)
import Data.Aeson.Types
(parseEither)
import Data.Attoparsec.ByteString.Char8
(endOfInput, parseOnly, skipSpace, (<?>))
(FromJSON (..), ToJSON (..), encode, eitherDecode)
import Data.Bifunctor
(bimap)
import qualified Data.ByteString as BS
Expand Down Expand Up @@ -371,28 +364,9 @@ instance NFData NoContent
--------------------------------------------------------------------------
-- * MimeUnrender Instances

-- | Like 'Data.Aeson.eitherDecode' but allows all JSON values instead of just
-- objects and arrays.
--
-- Will handle trailing whitespace, but not trailing junk. ie.
--
-- >>> eitherDecodeLenient "1 " :: Either String Int
-- Right 1
--
-- >>> eitherDecodeLenient "1 junk" :: Either String Int
-- Left "trailing junk after valid JSON: endOfInput"
eitherDecodeLenient :: FromJSON a => ByteString -> Either String a
eitherDecodeLenient input =
parseOnly parser (cs input) >>= parseEither parseJSON
where
parser = skipSpace
*> Data.Aeson.Parser.value
<* skipSpace
<* (endOfInput <?> "trailing junk after valid JSON")

-- | `eitherDecode`
instance FromJSON a => MimeUnrender JSON a where
mimeUnrender _ = eitherDecodeLenient
mimeUnrender _ = eitherDecode

-- | @urlDecodeAsForm@
-- Note that the @mimeUnrender p (mimeRender p x) == Right x@ law only
Expand Down
12 changes: 5 additions & 7 deletions servant/test/Servant/API/ContentTypesSpec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ import Prelude ()
import Prelude.Compat

import Data.Aeson
(FromJSON, ToJSON (..), Value, decode, encode, object, (.=))
(FromJSON, ToJSON (..), Value, decode, encode, object, (.=), eitherDecode)
import Data.ByteString.Char8
(ByteString, append, pack)
import qualified Data.ByteString.Lazy as BSL
Expand Down Expand Up @@ -219,15 +219,13 @@ spec = describe "Servant.API.ContentTypes" $ do
handleCTypeH (Proxy :: Proxy '[JSONorText]) "image/jpeg"
"foobar" `shouldBe` (Nothing :: Maybe (Either String Int))

-- aeson >= 0.9 decodes top-level strings
describe "eitherDecodeLenient" $ do

-- Since servant-0.20.1 MimeUnrender JSON instance uses eitherDecode,
-- as aeson >= 0.9 supports decoding top-level strings and numbers.
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` (decode x :: Maybe String)

property $ \x -> mimeUnrender (Proxy :: Proxy JSON) x
`shouldBe` (eitherDecode x :: Either String String)

data SomeData = SomeData { record1 :: String, record2 :: Int }
deriving (Generic, Eq, Show)
Expand Down

0 comments on commit 681c9cd

Please sign in to comment.