Remove usage of Data.Aeson.Parser

scarf-sh · Feb 7, 2024 · 3f4c196 · 3f4c196
1 parent 4105983
commit 3f4c196
Show file tree

Hide file tree

Showing 17 changed files with 160 additions and 502 deletions.
diff --git a/Request.template.hs b/Request.template.hs
@@ -18,8 +18,7 @@ module Tie.Template.Request_
   )
 where
 
-import Data.Aeson (FromJSON, parseJSON)
-import qualified Data.Aeson.Parser
+import qualified Data.Aeson
 import qualified Data.Aeson.Types
 import Data.Attoparsec.ByteString (eitherResult, parseWith)
 import Data.ByteString (ByteString)
@@ -267,7 +266,7 @@ data BodyParser a
       Network.HTTP.Media.MediaType
       ((a -> Wai.Application) -> Wai.Application)
 
-jsonBodyParser :: (FromJSON a) => BodyParser a
+jsonBodyParser :: (Data.Aeson.FromJSON a) => BodyParser a
 jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
 {-# INLINE jsonBodyParser #-}
 
@@ -294,35 +293,20 @@ parseRequestBody parsers withBody = \request respond -> do
       respond (Wai.responseBuilder (toEnum 415) [] mempty)
 {-# INLINE parseRequestBody #-}
 
-parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
+parseRequestBodyJSON :: (Data.Aeson.FromJSON a) => (a -> Wai.Application) -> Wai.Application
 parseRequestBodyJSON withBody = \request respond -> do
-  result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
-  case eitherResult result of
-    Left _err ->
+  body <- Wai.lazyRequestBody request
+  case Data.Aeson.decode' body of 
+    Nothing -> 
       respond (Wai.responseBuilder (toEnum 400) [] mempty)
-    Right value ->
-      case Data.Aeson.Types.parseEither Data.Aeson.parseJSON value of
-        Left _err ->
-          respond (Wai.responseBuilder (toEnum 400) [] mempty)
-        Right body ->
-          withBody body request respond
+    Just body ->
+      withBody body request respond
 {-# INLINEABLE parseRequestBodyJSON #-}
 
 parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
 parseRequestBodyForm withBody = \request respond -> do
-  -- Reads the body using lazy IO. Not great but it gets us
-  -- going and is pretty local.
-  let getBodyBytes :: IO [ByteString]
-      getBodyBytes = do
-        chunk <- Wai.getRequestBodyChunk request
-        case chunk of
-          "" -> pure []
-          _ -> do
-            rest <- unsafeInterleaveIO getBodyBytes
-            pure (chunk : rest)
-
-  bytes <- getBodyBytes
-  case urlDecodeAsForm (LBS.fromChunks bytes) of
+  body <- Wai.lazyRequestBody request
+  case urlDecodeAsForm body of
     Left _err ->
       respond (Wai.responseBuilder (toEnum 400) [] mempty)
     Right form ->

diff --git a/src/Tie/Codegen/Imports.hs b/src/Tie/Codegen/Imports.hs
@@ -92,10 +92,6 @@ codegenModuleHeader moduleName =
       <> PP.line
       <> "import"
     <+> "qualified"
-    <+> "Data.Aeson.Parser"
-      <> PP.line
-      <> "import"
-    <+> "qualified"
     <+> "Data.Aeson.Types"
       <> PP.line
       <> "import"

diff --git a/test/golden/additional-properties.yaml.out b/test/golden/additional-properties.yaml.out
@@ -15,7 +15,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString
@@ -105,8 +104,7 @@ module Test.Request
   )
 where
 
-import Data.Aeson (FromJSON, parseJSON)
-import qualified Data.Aeson.Parser
+import qualified Data.Aeson
 import qualified Data.Aeson.Types
 import Data.Attoparsec.ByteString (eitherResult, parseWith)
 import Data.ByteString (ByteString)
@@ -354,7 +352,7 @@ data BodyParser a
       Network.HTTP.Media.MediaType
       ((a -> Wai.Application) -> Wai.Application)
 
-jsonBodyParser :: (FromJSON a) => BodyParser a
+jsonBodyParser :: (Data.Aeson.FromJSON a) => BodyParser a
 jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
 {-# INLINE jsonBodyParser #-}
 
@@ -381,35 +379,20 @@ parseRequestBody parsers withBody = \request respond -> do
       respond (Wai.responseBuilder (toEnum 415) [] mempty)
 {-# INLINE parseRequestBody #-}
 
-parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
+parseRequestBodyJSON :: (Data.Aeson.FromJSON a) => (a -> Wai.Application) -> Wai.Application
 parseRequestBodyJSON withBody = \request respond -> do
-  result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
-  case eitherResult result of
-    Left _err ->
+  body <- Wai.lazyRequestBody request
+  case Data.Aeson.decode' body of 
+    Nothing -> 
       respond (Wai.responseBuilder (toEnum 400) [] mempty)
-    Right value ->
-      case Data.Aeson.Types.parseEither Data.Aeson.parseJSON value of
-        Left _err ->
-          respond (Wai.responseBuilder (toEnum 400) [] mempty)
-        Right body ->
-          withBody body request respond
+    Just body ->
+      withBody body request respond
 {-# INLINEABLE parseRequestBodyJSON #-}
 
 parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
 parseRequestBodyForm withBody = \request respond -> do
-  -- Reads the body using lazy IO. Not great but it gets us
-  -- going and is pretty local.
-  let getBodyBytes :: IO [ByteString]
-      getBodyBytes = do
-        chunk <- Wai.getRequestBodyChunk request
-        case chunk of
-          "" -> pure []
-          _ -> do
-            rest <- unsafeInterleaveIO getBodyBytes
-            pure (chunk : rest)
-
-  bytes <- getBodyBytes
-  case urlDecodeAsForm (LBS.fromChunks bytes) of
+  body <- Wai.lazyRequestBody request
+  case urlDecodeAsForm body of
     Left _err ->
       respond (Wai.responseBuilder (toEnum 400) [] mempty)
     Right form ->
@@ -469,7 +452,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString
@@ -520,7 +502,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString
@@ -611,7 +592,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString
@@ -679,7 +659,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString

diff --git a/test/golden/bug-1.yaml.out b/test/golden/bug-1.yaml.out
@@ -15,7 +15,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString
@@ -91,8 +90,7 @@ module Test.Request
   )
 where
 
-import Data.Aeson (FromJSON, parseJSON)
-import qualified Data.Aeson.Parser
+import qualified Data.Aeson
 import qualified Data.Aeson.Types
 import Data.Attoparsec.ByteString (eitherResult, parseWith)
 import Data.ByteString (ByteString)
@@ -340,7 +338,7 @@ data BodyParser a
       Network.HTTP.Media.MediaType
       ((a -> Wai.Application) -> Wai.Application)
 
-jsonBodyParser :: (FromJSON a) => BodyParser a
+jsonBodyParser :: (Data.Aeson.FromJSON a) => BodyParser a
 jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
 {-# INLINE jsonBodyParser #-}
 
@@ -367,35 +365,20 @@ parseRequestBody parsers withBody = \request respond -> do
       respond (Wai.responseBuilder (toEnum 415) [] mempty)
 {-# INLINE parseRequestBody #-}
 
-parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
+parseRequestBodyJSON :: (Data.Aeson.FromJSON a) => (a -> Wai.Application) -> Wai.Application
 parseRequestBodyJSON withBody = \request respond -> do
-  result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
-  case eitherResult result of
-    Left _err ->
+  body <- Wai.lazyRequestBody request
+  case Data.Aeson.decode' body of 
+    Nothing -> 
       respond (Wai.responseBuilder (toEnum 400) [] mempty)
-    Right value ->
-      case Data.Aeson.Types.parseEither Data.Aeson.parseJSON value of
-        Left _err ->
-          respond (Wai.responseBuilder (toEnum 400) [] mempty)
-        Right body ->
-          withBody body request respond
+    Just body ->
+      withBody body request respond
 {-# INLINEABLE parseRequestBodyJSON #-}
 
 parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
 parseRequestBodyForm withBody = \request respond -> do
-  -- Reads the body using lazy IO. Not great but it gets us
-  -- going and is pretty local.
-  let getBodyBytes :: IO [ByteString]
-      getBodyBytes = do
-        chunk <- Wai.getRequestBodyChunk request
-        case chunk of
-          "" -> pure []
-          _ -> do
-            rest <- unsafeInterleaveIO getBodyBytes
-            pure (chunk : rest)
-
-  bytes <- getBodyBytes
-  case urlDecodeAsForm (LBS.fromChunks bytes) of
+  body <- Wai.lazyRequestBody request
+  case urlDecodeAsForm body of
     Left _err ->
       respond (Wai.responseBuilder (toEnum 400) [] mempty)
     Right form ->
@@ -455,7 +438,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString

diff --git a/test/golden/bug-2.yaml.out b/test/golden/bug-2.yaml.out
@@ -15,7 +15,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString
@@ -91,8 +90,7 @@ module Test.Request
   )
 where
 
-import Data.Aeson (FromJSON, parseJSON)
-import qualified Data.Aeson.Parser
+import qualified Data.Aeson
 import qualified Data.Aeson.Types
 import Data.Attoparsec.ByteString (eitherResult, parseWith)
 import Data.ByteString (ByteString)
@@ -340,7 +338,7 @@ data BodyParser a
       Network.HTTP.Media.MediaType
       ((a -> Wai.Application) -> Wai.Application)
 
-jsonBodyParser :: (FromJSON a) => BodyParser a
+jsonBodyParser :: (Data.Aeson.FromJSON a) => BodyParser a
 jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
 {-# INLINE jsonBodyParser #-}
 
@@ -367,35 +365,20 @@ parseRequestBody parsers withBody = \request respond -> do
       respond (Wai.responseBuilder (toEnum 415) [] mempty)
 {-# INLINE parseRequestBody #-}
 
-parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
+parseRequestBodyJSON :: (Data.Aeson.FromJSON a) => (a -> Wai.Application) -> Wai.Application
 parseRequestBodyJSON withBody = \request respond -> do
-  result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
-  case eitherResult result of
-    Left _err ->
+  body <- Wai.lazyRequestBody request
+  case Data.Aeson.decode' body of 
+    Nothing -> 
       respond (Wai.responseBuilder (toEnum 400) [] mempty)
-    Right value ->
-      case Data.Aeson.Types.parseEither Data.Aeson.parseJSON value of
-        Left _err ->
-          respond (Wai.responseBuilder (toEnum 400) [] mempty)
-        Right body ->
-          withBody body request respond
+    Just body ->
+      withBody body request respond
 {-# INLINEABLE parseRequestBodyJSON #-}
 
 parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
 parseRequestBodyForm withBody = \request respond -> do
-  -- Reads the body using lazy IO. Not great but it gets us
-  -- going and is pretty local.
-  let getBodyBytes :: IO [ByteString]
-      getBodyBytes = do
-        chunk <- Wai.getRequestBodyChunk request
-        case chunk of
-          "" -> pure []
-          _ -> do
-            rest <- unsafeInterleaveIO getBodyBytes
-            pure (chunk : rest)
-
-  bytes <- getBodyBytes
-  case urlDecodeAsForm (LBS.fromChunks bytes) of
+  body <- Wai.lazyRequestBody request
+  case urlDecodeAsForm body of
     Left _err ->
       respond (Wai.responseBuilder (toEnum 400) [] mempty)
     Right form ->
@@ -455,7 +438,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString
@@ -506,7 +488,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString
@@ -567,7 +548,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString
@@ -640,7 +620,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString
@@ -706,7 +685,6 @@ import qualified Control.Monad
 import qualified Control.Monad.IO.Class
 import qualified Data.Aeson
 import qualified Data.Aeson.Encoding
-import qualified Data.Aeson.Parser
 import qualified Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString
 import qualified Data.ByteString