improve getJsonBody error output

Author: chris-martin

freckle-app/CHANGELOG.md

@@ -1,4 +1,9 @@
-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-app-v1.20.1.1...main)
+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-app-v1.20.1.2...main)
+
+## [v1.20.1.1](https://github.com/freckle/freckle-app/compare/freckle-app-v1.20.1.1...freckle-app-v1.20.1.2)
+
+Improve quality of error message output from `getJsonBody` and `getCsvBody`
+in `Freckle.App.Test.Yesod`.
 
 ## [v1.20.1.1](https://github.com/freckle/freckle-app/compare/freckle-app-v1.20.1.0...freckle-app-v1.20.1.1)
 

freckle-app/freckle-app.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.22
 -- see: https://github.com/sol/hpack
 
 name:           freckle-app
-version:        1.20.1.1
+version:        1.20.1.2
 synopsis:       Haskell application toolkit used at Freckle
 description:    Please see README.md
 category:       Utils

freckle-app/library/Freckle/App/Test/Yesod.hs

@@ -79,19 +79,20 @@ import Control.Monad.State (StateT)
 import Control.Monad.Trans.Maybe (MaybeT)
 import Control.Monad.Trans.Resource (ResourceT)
 import Control.Monad.Validate (ValidateT)
-import Data.Aeson (FromJSON, eitherDecode)
+import Data.Aeson (FromJSON)
 import Data.BCP47 (BCP47)
 import Data.BCP47 qualified as BCP47
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.ByteString.Lazy qualified as BSL
 import Data.CaseInsensitive (CI)
-import Data.Csv (FromNamedRecord, decodeByName)
+import Data.Csv qualified as CSV
 import Data.Text qualified as T
 import Data.Vector qualified as V
 import Freckle.App.Test (expectationFailure)
 import Network.HTTP.Types.Header (hAccept, hAcceptLanguage, hContentType)
 import Network.Wai.Test (SResponse (..))
+import Test.HUnit qualified as HUnit
 import Web.Cookie (SetCookie)
 import Yesod.Core (RedirectUrl, Yesod)
 import Yesod.Test
@@ -111,6 +112,7 @@ import Yesod.Test
   , withResponse
   )
 import Yesod.Test qualified
+import Yesod.Test.Internal (getBodyTextPreview)
 
 class (MonadIO m, Yesod site) => MonadYesodExample site m | m -> site where
   liftYesodExample :: YesodExample site a -> m a
@@ -161,18 +163,31 @@ testSetCookie = liftYesodExample . Yesod.Test.testSetCookie
 -- | Get the body of the most recent response and decode it as JSON
 getJsonBody
   :: forall a m site. (MonadYesodExample site m, FromJSON a, HasCallStack) => m a
-getJsonBody = either err pure . eitherDecode =<< getRawBody
- where
-  err e = expectationFailure $ "Error decoding JSON response body: " <> e
+getJsonBody = liftYesodExample Yesod.Test.requireJSONResponse
 
 -- | Get the body of the most recent response and decode it as CSV
 getCsvBody
   :: forall a m site
-   . (MonadYesodExample site m, FromNamedRecord a, HasCallStack)
+   . (MonadYesodExample site m, CSV.FromNamedRecord a, HasCallStack)
   => m [a]
-getCsvBody = either err (pure . V.toList . snd) . decodeByName =<< getRawBody
+getCsvBody =
+  liftYesodExample $
+    withResponse $ \(SResponse _status _headers body) ->
+      -- todo - check the response header first
+      case fmap (V.toList . snd) (CSV.decodeByName body) of
+        Left err ->
+          failure $
+            T.concat
+              [ "Failed to parse CSV response; error: "
+              , T.pack err
+              , "CSV: "
+              , getBodyTextPreview body
+              ]
+        Right v -> pure v
  where
-  err e = expectationFailure $ "Error decoding CSV response body: " <> e
+  failure reason = do
+    liftIO $ HUnit.assertFailure $ T.unpack reason
+    error ""
 
 -- | Get the body of the most recent response as a byte string
 getRawBody

freckle-app/package.yaml

@@ -1,5 +1,5 @@
 name: freckle-app
-version: 1.20.1.1
+version: 1.20.1.2
 maintainer: Freckle Education
 category: Utils
 github: freckle/freckle-app