When showing HandlerContent, include a content snippet by dtpowl · Pull Request #1864 · yesodweb/yesod

dtpowl · 2025-03-20T20:19:14Z

When possible, shows a snippet of the underlying Content when showing (or displayExceptioning) an HCContent.

Before submitting your PR, check that you've:

Bumped the version number

After submitting your PR:

Update the Changelog.md file with a link to your PR
Check that CI passes (or if it fails, for reasons unrelated to your change, like CI timeouts)

parsonsmatt · 2025-03-20T21:02:23Z

yesod-core/src/Yesod/Core/Types.hs

+contentToTruncatedString :: Content -> Int -> String
+contentToTruncatedString (ContentBuilder builder maybeLength) maxLength =
+    let
+      truncated = take maxLength (show builder)
+      excess = case maybeLength of
+        (Just length) -> length - maxLength
+        Nothing -> 0
+    in case (excess > 0) of
+      True -> truncated ++ "... (+" ++ show excess ++ ")"
+      False -> truncated
+contentToTruncatedString (ContentSource _) _ = "ContentSource"
+contentToTruncatedString (ContentFile _ _) _ = "ContentFile"
+contentToTruncatedString (ContentDontEvaluate _) _ = "ContentDontEvaluate"


This function is exported. Can we add a doc string with @SInCE annotation?

Suggested change

contentToTruncatedString :: Content -> Int -> String

contentToTruncatedString (ContentBuilder builder maybeLength) maxLength =

let

truncated = take maxLength (show builder)

excess = case maybeLength of

(Just length) -> length - maxLength

Nothing -> 0

in case (excess > 0) of

True -> truncated ++ "... (+" ++ show excess ++ ")"

False -> truncated

contentToTruncatedString (ContentSource _) _ = "ContentSource"

contentToTruncatedString (ContentFile _ _) _ = "ContentFile"

contentToTruncatedString (ContentDontEvaluate _) _ = "ContentDontEvaluate"

-- | doc me up boss

--

-- @since 1.6.28.0

contentToTruncatedString :: Content -> Int -> String

contentToTruncatedString (ContentBuilder builder maybeLength) maxLength =

let

truncated = take maxLength (show builder)

excess = case maybeLength of

(Just length) -> length - maxLength

Nothing -> 0

in case (excess > 0) of

True -> truncated ++ "... (+" ++ show excess ++ ")"

False -> truncated

contentToTruncatedString (ContentSource _) _ = "ContentSource"

contentToTruncatedString (ContentFile _ _) _ = "ContentFile"

contentToTruncatedString (ContentDontEvaluate _) _ = "ContentDontEvaluate"

parsonsmatt · 2025-03-20T21:10:00Z

yesod-core/src/Yesod/Core/Types.hs

+contentToTruncatedString :: Content -> Int -> String
+contentToTruncatedString (ContentBuilder builder maybeLength) maxLength =
+    let
+      truncated = take maxLength (show builder)


hmm. show is probably not what we want here, but it may be. Calling show on a string-ish type usually will add quotes around it, so it can be copy/pasted into Haskell code.

λ> import Data.ByteString.Builder λ> show ("hello" :: Builder) "\"hello\"" λ> print ("hello" :: Builder) "hello" λ> putStrLn "hello" hello λ> print ("hello" :: String) "hello"

(print is putStrLn . show)

Likewise, show "\n" == "\"\\n\""

But, what we have is a bunch of bytes. Do we interpret them as ASCII and do Data.ByteString.Char8.unpack :: ByteString -> String? Or do we treat them as UTF8 and do Data.Text.Encoding.decodeUtf8 ?

If we were to accept TypedContent here instead of Content, we'd be able to infer the encoding. If it's ASCII or UTF-8 or some other text encoding, the right thing to do will be obvious. And if the content type tells us it's not text at all, we'll just refrain from generating a snippet.

yesod-core/ChangeLog.md

Co-authored-by: Matt Parsons <[email protected]>

schoettl · 2025-03-21T07:24:44Z

yesod-core/src/Yesod/Core/Types.hs

+      excess = case maybeLength of
+        (Just length) -> length - (fromIntegral maxLength)
+        Nothing -> 0
+    in case (excess > 0) of


Just my curiosity, is it a code formatter that surrounds Just length, excess > 0 and fromIntegral maxLength with parens or is it your personal preference?

It's less a preference and more a habit inherited from working in other languages; I'm pretty new to Haskell.

I don't really think the parens aid legibility in the examples you pointed out, so I'll probably remove them.

parsonsmatt · 2025-03-21T17:13:45Z

yesod-core/src/Yesod/Core/Types.hs

+      = mconcat [ "HCContent "
+                , show (status, t)
+                , contentToTruncatedString c 1000
+                ]


Maybe want to parens + space it

Suggested change

= mconcat [ "HCContent "

, show (status, t)

, contentToTruncatedString c 1000

]

= mconcat [ "HCContent "

, show (status, t)

, " ("

, contentToTruncatedString c 1000

, ")"

]

parsonsmatt · 2025-03-21T17:15:14Z

yesod-core/src/Yesod/Core/Types.hs

+contentToTruncatedString :: Content -> I.Int64 -> String
+contentToTruncatedString (ContentBuilder builder maybeLength) maxLength =
+    let
+      truncated = (T.unpack . Data.Text.Encoding.decodeUtf8) $ L.toStrict $ L.take maxLength (BB.toLazyByteString builder)


style nit: it's nice to have a consistent flow of function application. You can do almost all . with a single $, or all $:

Suggested change

truncated = (T.unpack . Data.Text.Encoding.decodeUtf8) $ L.toStrict $ L.take maxLength (BB.toLazyByteString builder)

truncated = T.unpack $ Data.Text.Encoding.decodeUtf8 $ L.toStrict $ L.take maxLength $ BB.toLazyByteString builder

Suggested change

truncated = (T.unpack . Data.Text.Encoding.decodeUtf8) $ L.toStrict $ L.take maxLength (BB.toLazyByteString builder)

truncated = T.unpack . Data.Text.Encoding.decodeUtf8 . L.toStrict . L.take maxLength $ BB.toLazyByteString builder

parsonsmatt · 2025-03-21T17:16:34Z

yesod-core/src/Yesod/Core/Types.hs

+-- bytes of the content, and annotating it with the remaining length.
+--
+-- @since 1.6.28.0
+contentToTruncatedString :: Content -> I.Int64 -> String


Int64 is a reasonable choice here but it's a little nicer to use Integer or Int here - those are in Prelude and don't require imports for end users.

Agreed, but take in Data.ByteString.Lazy actually requires Int64.

parsonsmatt · 2025-03-21T17:17:12Z

yesod-core/src/Yesod/Core/Types.hs

 import qualified Data.Text.Lazy.Builder             as TBuilder
 import           Data.Time                          (UTCTime)
 import           GHC.Generics                       (Generic)
+import qualified GHC.Int                            as I


GHC.Int is kind of an internal module - generally preferable to import from Data.Int which is less GHC internals-y

dtpowl · 2025-03-24T20:59:28Z

yesod-core/src/Yesod/Core/Content.hs

 simpleContentType :: ContentType -> ContentType
 simpleContentType = fst . B.break (== _semicolon)

+decoderForCharset :: Maybe B.ByteString -> L.ByteString -> TL.Text


Wikipedia offers some information about how often non-UTF8 encodings are used.

Unsurprisingly, UTF-8 is overwhelmingly more common than all other encodings combined. I added support for some of the more common alternatives, regardless.

dtpowl · 2025-03-24T21:01:51Z

yesod-core/src/Yesod/Core/HandlerContents.hs

@@ -0,0 +1,37 @@
+module Yesod.Core.HandlerContents


I broke this type definition out into a separate file to avoid a circular dependency. Maybe someone else can see a better way to solve this?

I think this is fine - just make sure HandlerContents is being properly re-exported from the original module in which it is defined.

You'll need to modify the yesod-core.cabal file and add this as either an exposed-modules (which makes it public so you'll want to add a CHANGELOG entry + some haddocks here) or other-modules (in which case it is private and you don't need to do quite so much ((though having an @since tag in some moduel docs is nice for the developer trawlin code)))

dtpowl · 2025-03-24T21:04:59Z

yesod-core/src/Yesod/Core/Content.hs


+decoderForCharset :: Maybe B.ByteString -> L.ByteString -> TL.Text
+decoderForCharset (Just encodingSymbol)
+  | encodingSymbol == (encodeUtf8 $ T.pack $ "utf-8")        = LE.decodeUtf8With EE.lenientDecode


See the IANA documentation for the character set symbols. I didn't handle synonyms here.

parsonsmatt

lots of comments, many of which are just on style/idiomatic Haskell

parsonsmatt · 2025-03-24T22:27:46Z

yesod-core/src/Yesod/Core/Content.hs

+decoderForCharset :: Maybe B.ByteString -> L.ByteString -> TL.Text
+decoderForCharset (Just encodingSymbol)
+  | encodingSymbol == (encodeUtf8 $ T.pack $ "utf-8")        = LE.decodeUtf8With EE.lenientDecode
+  | encodingSymbol == (encodeUtf8 $ T.pack $ "US-ASCII")     = TL.fromStrict . fst . decodeASCIIPrefix . B.toStrict


If you enable OverloadedStrings then you can write:

Suggested change

| encodingSymbol == (encodeUtf8 $ T.pack $ "US-ASCII") = TL.fromStrict . fst . decodeASCIIPrefix . B.toStrict

| encodingSymbol == "US-ASCII" = TL.fromStrict . fst . decodeASCIIPrefix . B.toStrict

parsonsmatt · 2025-03-24T22:29:06Z

yesod-core/src/Yesod/Core/Content.hs

+decoderForCharset (Just encodingSymbol)
+  | encodingSymbol == (encodeUtf8 $ T.pack $ "utf-8")        = LE.decodeUtf8With EE.lenientDecode
+  | encodingSymbol == (encodeUtf8 $ T.pack $ "US-ASCII")     = TL.fromStrict . fst . decodeASCIIPrefix . B.toStrict
+  | encodingSymbol == (encodeUtf8 $ T.pack $ "latin1")       = LE.decodeLatin1


i generally do not recommend using a formatter that aligns = like that - very sensitive to alignment breaking in other cases

instead, indenting after the = helps to have alignment on the expressions

Suggested change

| encodingSymbol == (encodeUtf8 $ T.pack $ "latin1") = LE.decodeLatin1

| encodingSymbol == (encodeUtf8 $ T.pack $ "latin1") =

LE.decodeLatin1

this is one of those things where the very nice aesthetics of Mathy Lookin Haskell Code don't play super nice with code-on-computer (vs code-on-paper)

parsonsmatt · 2025-03-24T22:30:18Z

yesod-core/src/Yesod/Core/Content.hs

+      typeIsText  = B.isPrefixOf (packString "text") t             ||
+                    B.isPrefixOf (packString "application/json") t ||
+                    B.isPrefixOf (packString "application/rss")  t ||
+                    B.isPrefixOf (packString "application/atom") t


Similar note re alignment - generally nicer to have operator first

Suggested change

typeIsText = B.isPrefixOf (packString "text") t ||

B.isPrefixOf (packString "application/json") t ||

B.isPrefixOf (packString "application/rss") t ||

B.isPrefixOf (packString "application/atom") t

typeIsText =

B.isPrefixOf (packString "text") t

|| B.isPrefixOf (packString "application/json") t

|| B.isPrefixOf (packString "application/rss") t

|| B.isPrefixOf (packString "application/atom") t

parsonsmatt · 2025-03-24T22:31:06Z

yesod-core/src/Yesod/Core/Content.hs

+      (t, params) = NWP.parseContentType ct
+      charset     = lookup (packString "charset") params


Suggested change

(t, params) = NWP.parseContentType ct

charset = lookup (packString "charset") params

(t, params) =

NWP.parseContentType ct

charset =

lookup (packString "charset") params

more diff-friendly way to get alignment on the expressions

parsonsmatt · 2025-03-24T22:32:32Z

yesod-core/src/Yesod/Core/Content.hs

+textDecoderFor :: ContentType -> L.ByteString -> Maybe TL.Text
+textDecoderFor ct =


This is point-free - we can make the below a bit more legible if we accept the parameter explicitly:

Suggested change

textDecoderFor :: ContentType -> L.ByteString -> Maybe TL.Text

textDecoderFor ct =

textDecoderFor :: ContentType -> L.ByteString -> Maybe TL.Text

textDecoderFor ct bytes =

This makes sense, but I'll probably rename this function while I'm at. Obviously there's no behavioral difference, but textDecoderFor sounds like a unary function that accepts a content type and returns a decoder; decodeTextForContentType sounds like a two-place function that accepts both a content type and some bytes.

parsonsmatt · 2025-03-24T22:40:01Z

yesod-core/src/Yesod/Core/HandlerContents.hs

+data HandlerContents =
+      HCContent !H.Status !TypedContent
+    | HCError !ErrorResponse
+    | HCSendFile !ContentType !FilePath !(Maybe W.FilePart)
+    | HCRedirect !H.Status !Text
+    | HCCreated !Text
+    | HCWai !W.Response
+    | HCWaiApp !W.Application
+instance Show HandlerContents where


parsonsmatt · 2025-03-24T22:40:10Z

yesod-core/src/Yesod/Core/HandlerContents.hs

+    show (HCWai _) = "HCWai"
+    show (HCWaiApp _) = "HCWaiApp"
+instance Exception HandlerContents


Suggested change

show (HCWai _) = "HCWai"

show (HCWaiApp _) = "HCWaiApp"

instance Exception HandlerContents

show (HCWai _) = "HCWai"

show (HCWaiApp _) = "HCWaiApp"

instance Exception HandlerContents

parsonsmatt · 2025-03-24T22:41:40Z

yesod-core/src/Yesod/Core/HandlerContents.hs

@@ -0,0 +1,37 @@
+module Yesod.Core.HandlerContents


I think this is fine - just make sure HandlerContents is being properly re-exported from the original module in which it is defined.

You'll need to modify the yesod-core.cabal file and add this as either an exposed-modules (which makes it public so you'll want to add a CHANGELOG entry + some haddocks here) or other-modules (in which case it is private and you don't need to do quite so much ((though having an @since tag in some moduel docs is nice for the developer trawlin code)))

parsonsmatt · 2025-03-24T22:47:04Z

yesod-core/src/Yesod/Core/Content.hs

+contentToSnippet :: Content -> (L.ByteString -> Maybe TL.Text) -> I.Int64 -> Maybe TL.Text
+contentToSnippet (ContentBuilder builder maybeLength) decoder maxLength = do
+  truncatedText <- decoder . L.take maxLength $ BB.toLazyByteString builder
+  pure $ truncatedText <> (TL.pack excessLengthString)
+  where
+    excessLength = fromMaybe 0 $ (subtract $ fromIntegral maxLength) <$> maybeLength
+    excessLengthString = case excessLength > 0 of
+      False -> ""
+      True -> "...+ " <> (show excessLength)


We can return L.ByteString here and leave the decoding to callsites. That simplifies our signature and use a bit.

Suggested change

contentToSnippet :: Content -> (L.ByteString -> Maybe TL.Text) -> I.Int64 -> Maybe TL.Text

contentToSnippet (ContentBuilder builder maybeLength) decoder maxLength = do

truncatedText <- decoder . L.take maxLength $ BB.toLazyByteString builder

pure $ truncatedText <> (TL.pack excessLengthString)

where

excessLength = fromMaybe 0 $ (subtract $ fromIntegral maxLength) <$> maybeLength

excessLengthString = case excessLength > 0 of

False -> ""

True -> "...+ " <> (show excessLength)

contentToSnippet :: Content -> I.Int64 -> Maybe L.ByteString

contentToSnippet (ContentBuilder builder maybeLength) maxLength = do

truncatedText <- decoder . L.take maxLength $ BB.toLazyByteString builder

pure $ truncatedText <> (TL.pack excessLengthString)

where

excessLength = fromMaybe 0 $ (subtract $ fromIntegral maxLength) <$> maybeLength

excessLengthString = case excessLength > 0 of

False -> ""

True -> "...+ " <> (_f excessLength)

For _f, consider Data.ByteStrying.Lazy.Char8 which can pack :: [Char] -> ByteString or for supreme efficiency, using intDec :: Int -> Builder for constructing this, and then BB.toLazyByteString.

parsonsmatt · 2025-03-24T22:47:54Z

yesod-core/src/Yesod/Core/Content.hs

+--
+-- @since 1.6.28.0
+typedContentToSnippet :: TypedContent -> I.Int64 -> Maybe TL.Text
+typedContentToSnippet (TypedContent t c) maxLength = contentToSnippet c (textDecoderFor t) maxLength


If we extract the decoding responsibility, then we have:

Suggested change

typedContentToSnippet (TypedContent t c) maxLength = contentToSnippet c (textDecoderFor t) maxLength

typedContentToSnippet (TypedContent t c) maxLength = textDecoderFor t $ contentToSnippet c maxLength

dtpowl added 2 commits March 20, 2025 14:18

when showing HandlerContent, include some information from the Content

f0c77a8

add PR link

b8f61ba

parsonsmatt reviewed Mar 20, 2025

View reviewed changes

change version number

bf395f4

Co-authored-by: Matt Parsons <[email protected]>

dtpowl force-pushed the show-truncated-content-in-handler-content branch 2 times, most recently from cafe865 to a81cb21 Compare March 20, 2025 22:19

truncate lazily and decode as UTF-8

0d907ea

dtpowl force-pushed the show-truncated-content-in-handler-content branch from a81cb21 to 0d907ea Compare March 20, 2025 22:42

schoettl reviewed Mar 21, 2025

View reviewed changes

parsonsmatt reviewed Mar 21, 2025

View reviewed changes

dtpowl added 3 commits March 24, 2025 13:44

respect content type better when generating snippets

57ff57b

handle some rare encodings

8fdba93

doc string and style

bc3cf7a

dtpowl commented Mar 24, 2025

View reviewed changes

remove unused imports

8a0b687

dtpowl commented Mar 24, 2025

View reviewed changes

dtpowl requested a review from parsonsmatt March 24, 2025 21:03

dtpowl commented Mar 24, 2025

View reviewed changes

parsonsmatt reviewed Mar 24, 2025

View reviewed changes

dtpowl and others added 3 commits March 25, 2025 09:40

adopt style recommendations from PR review

9967b31

rearrange some things to avoid a breaking change

eded7b8

Merge branch 'master' into show-truncated-content-in-handler-content

fc4c47c

parsonsmatt mentioned this pull request Jul 8, 2025

Mercury patches MercuryTechnologies/yesod#2

Open

parsonsmatt added 3 commits July 8, 2025 09:13

fix build

7ccb550

hm

4907117

Merge branch 'master' into show-truncated-content-in-handler-content

b394160

parsonsmatt mentioned this pull request Oct 23, 2025

HandlerContents snippet #1894

Merged

5 tasks

	truncated = (T.unpack . Data.Text.Encoding.decodeUtf8) $ L.toStrict $ L.take maxLength (BB.toLazyByteString builder)
	truncated = T.unpack $ Data.Text.Encoding.decodeUtf8 $ L.toStrict $ L.take maxLength $ BB.toLazyByteString builder

	truncated = (T.unpack . Data.Text.Encoding.decodeUtf8) $ L.toStrict $ L.take maxLength (BB.toLazyByteString builder)
	truncated = T.unpack . Data.Text.Encoding.decodeUtf8 . L.toStrict . L.take maxLength $ BB.toLazyByteString builder

	\| encodingSymbol == (encodeUtf8 $ T.pack $ "US-ASCII") = TL.fromStrict . fst . decodeASCIIPrefix . B.toStrict
	\| encodingSymbol == "US-ASCII" = TL.fromStrict . fst . decodeASCIIPrefix . B.toStrict

	\| encodingSymbol == (encodeUtf8 $ T.pack $ "latin1") = LE.decodeLatin1
	\| encodingSymbol == (encodeUtf8 $ T.pack $ "latin1") =
	LE.decodeLatin1

		(t, params) = NWP.parseContentType ct
		charset = lookup (packString "charset") params

		textDecoderFor :: ContentType -> L.ByteString -> Maybe TL.Text
		textDecoderFor ct =

	typedContentToSnippet (TypedContent t c) maxLength = contentToSnippet c (textDecoderFor t) maxLength
	typedContentToSnippet (TypedContent t c) maxLength = textDecoderFor t $ contentToSnippet c maxLength

Conversation

dtpowl commented Mar 20, 2025 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

dtpowl Mar 20, 2025 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

parsonsmatt left a comment

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

dtpowl Mar 25, 2025 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Choose a reason for hiding this comment

Uh oh!

Reviewers

Assignees

Labels

Projects

Milestone

Development

Uh oh!

3 participants

dtpowl commented Mar 20, 2025 •

edited

Loading

dtpowl Mar 20, 2025 •

edited

Loading

dtpowl Mar 25, 2025 •

edited

Loading