diff --git a/build/Filters/Archive.hs b/build/Filters/Archive.hs index ba12597..872b0b4 100644 --- a/build/Filters/Archive.hs +++ b/build/Filters/Archive.hs @@ -30,22 +30,45 @@ import Text.Pandoc.Walk (walk) import ArchiveIndex (ArchiveStatus (..), archiveIndexIsEmpty, archiveSlugFor, archiveStatusForSlug) --- | Annotate body links. Headings are left alone — an affordance there --- would be noise. Identity when the index is empty. +-- | Annotate body links. Links inside headings are left alone at +-- /every/ nesting depth — an affordance there would be noise, and a +-- top-level pattern match would miss a @Header@ inside a @Div@ or +-- @BlockQuote@. Header links are tagged with a sentinel class before +-- the annotation walk and stripped of it afterwards, so the sentinel +-- can never leak into the writer. Identity when the index is empty. apply :: Pandoc -> Pandoc -apply doc@(Pandoc meta blocks) +apply doc | archiveIndexIsEmpty = doc - | otherwise = Pandoc meta (map annotateBlock blocks) + | otherwise = + walk unprotectLink . walk annotateInlines . walk protectHeader $ doc -annotateBlock :: Block -> Block -annotateBlock h@Header{} = h -annotateBlock b = walk annotateInlines b +-- | Sentinel class marking a link the annotation walk must skip. It +-- only exists between the protect and unprotect walks inside 'apply'. +skipClass :: T.Text +skipClass = "archive-header-skip" + +protectHeader :: Block -> Block +protectHeader (Header lvl attr ils) = Header lvl attr (walk protect ils) + where + protect (Link (ident, cls, kvs) text target) = + Link (ident, skipClass : cls, kvs) text target + protect x = x +protectHeader b = b + +unprotectLink :: Inline -> Inline +unprotectLink (Link (ident, cls, kvs) text target) + | skipClass `elem` cls = + Link (ident, filter (/= skipClass) cls, kvs) text target +unprotectLink x = x -- | For each archived @Link@: flip it if the target is 'Rotted', else --- append the affordance. Non-archived links pass through untouched. +-- append the affordance. Non-archived links — and links protected by +-- 'protectHeader' — pass through untouched. annotateInlines :: [Inline] -> [Inline] annotateInlines = concatMap expand where + expand l@(Link (_, cls, _) _ _) + | skipClass `elem` cls = [l] expand l@(Link attr text (url, _)) = case archiveSlugFor url of Nothing -> [l] diff --git a/build/Filters/EmbedPdf.hs b/build/Filters/EmbedPdf.hs index f2a11f9..e9fae99 100644 --- a/build/Filters/EmbedPdf.hs +++ b/build/Filters/EmbedPdf.hs @@ -12,15 +12,23 @@ -- -- The file path must be root-relative (begins with @/@). -- PDF.js is expected to be vendored at @/pdfjs/web/viewer.html@. +-- +-- Code protection (honest scope): lines inside /fenced/ code blocks +-- are passed through untouched ('Filters.Wikilinks.mapOutsideFences'), +-- so fenced examples can show @{{pdf:…}}@ literally. Indented code +-- blocks and inline code spans are NOT recognised — a full-line +-- directive inside either is still rewritten. module Filters.EmbedPdf (preprocess) where import Data.Char (isDigit) import Data.List (isPrefixOf, isSuffixOf) +import Filters.Wikilinks (mapOutsideFences) import qualified Utils as U --- | Apply PDF-embed substitution to the raw Markdown source string. +-- | Apply PDF-embed substitution to the raw Markdown source string, +-- skipping lines inside fenced code blocks. preprocess :: String -> String -preprocess = unlines . map processLine . lines +preprocess = mapOutsideFences processLine processLine :: String -> String processLine line = diff --git a/build/Filters/Images.hs b/build/Filters/Images.hs index 7cf7e27..5efac59 100644 --- a/build/Filters/Images.hs +++ b/build/Filters/Images.hs @@ -231,7 +231,7 @@ renderPicture :: Attr -> [Inline] -> Target -> Bool -> Maybe (Int, Int) -> Text renderPicture (ident, classes, kvs) alt (src, title) lightbox dims = T.concat [ "" - , "" + , "" , " Pandoc apply = walk classifyLink . walk classifyPdfLink @@ -49,6 +52,11 @@ classifyLink l@(Link (_, classes, _) _ _) -- brand icon stamp, and have their own popup provider. Leave them -- entirely alone. | "source-ref" `elem` classes = l + -- PDF links were already rewritten to the (root-relative) viewer URL + -- and given their own chrome by 'classifyPdfLink' in the preceding + -- pass; without this guard they would be double-classified as + -- internal page links. + | "pdf-link" `elem` classes = l classifyLink (Link (ident, classes, kvs) ils (url, title)) | isExternal url = let icon = domainIcon url @@ -100,8 +108,9 @@ isExternal url = where siteHost = "levineuwirth.org" --- | Extract the lowercased hostname from an absolute http(s) URL. --- Returns 'Nothing' for non-http(s) URLs (relative paths, mailto:, etc.). +-- | Extract the lowercased hostname from an absolute http(s) URL, +-- stripping any userinfo (@user:pass\@@) and port. Returns 'Nothing' +-- for non-http(s) URLs (relative paths, mailto:, etc.). extractHost :: Text -> Maybe Text extractHost url | Just rest <- T.stripPrefix "https://" url = Just (hostOf rest) @@ -109,45 +118,60 @@ extractHost url | otherwise = Nothing where hostOf rest = - let withPort = T.takeWhile (\c -> c /= '/' && c /= '?' && c /= '#') rest - host = T.takeWhile (/= ':') withPort + let authority = T.takeWhile (\c -> c /= '/' && c /= '?' && c /= '#') rest + -- 'T.breakOnEnd' yields the segment after the last @\@@, or + -- the whole authority when there is no userinfo. + (_, hostPort) = T.breakOnEnd "@" authority + host = T.takeWhile (/= ':') hostPort in T.toLower host -- | Icon name for the link, matching a file in /images/link-icons/.svg. +-- +-- Matches on the URL's host only, never on the full URL — a path like +-- @https://example.org/why-x.com-failed@ must not get the Twitter +-- icon. URLs with no extractable host get the generic icon. domainIcon :: Text -> Text -domainIcon url +domainIcon url = maybe "external" iconForHost (extractHost url) + +iconForHost :: Text -> Text +iconForHost host -- Scholarly / reference - | "wikipedia.org" `T.isInfixOf` url = "wikipedia" - | "arxiv.org" `T.isInfixOf` url = "arxiv" - | "doi.org" `T.isInfixOf` url = "doi" - | "worldcat.org" `T.isInfixOf` url = "worldcat" - | "orcid.org" `T.isInfixOf` url = "orcid" - | "archive.org" `T.isInfixOf` url = "internet-archive" + | m "wikipedia.org" = "wikipedia" + | m "arxiv.org" = "arxiv" + | m "doi.org" = "doi" + | m "worldcat.org" = "worldcat" + | m "orcid.org" = "orcid" + | m "archive.org" = "internet-archive" -- Code / software - | "github.com" `T.isInfixOf` url = "github" - | "git.levineuwirth.org" `T.isInfixOf` url = "forgejo" - | "tensorflow.org" `T.isInfixOf` url = "tensorflow" + | m "github.com" = "github" + | m "git.levineuwirth.org" = "forgejo" + | m "tensorflow.org" = "tensorflow" -- AI companies (consumer products share a brand icon with the lab) - | "anthropic.com" `T.isInfixOf` url = "anthropic" - | "claude.ai" `T.isInfixOf` url = "anthropic" - | "openai.com" `T.isInfixOf` url = "openai" - | "chatgpt.com" `T.isInfixOf` url = "openai" + | m "anthropic.com" = "anthropic" + | m "claude.ai" = "anthropic" + | m "openai.com" = "openai" + | m "chatgpt.com" = "openai" -- Social / media - | "twitter.com" `T.isInfixOf` url = "twitter" - | "x.com" `T.isInfixOf` url = "twitter" - | "reddit.com" `T.isInfixOf` url = "reddit" - | "youtube.com" `T.isInfixOf` url = "youtube" - | "youtu.be" `T.isInfixOf` url = "youtube" - | "tiktok.com" `T.isInfixOf` url = "tiktok" - | "substack.com" `T.isInfixOf` url = "substack" - | "news.ycombinator.com" `T.isInfixOf` url = "hacker-news" - | "lesswrong.com" `T.isInfixOf` url = "lesswrong" + | m "twitter.com" = "twitter" + | m "x.com" = "twitter" + | m "reddit.com" = "reddit" + | m "youtube.com" = "youtube" + | m "youtu.be" = "youtube" + | m "tiktok.com" = "tiktok" + | m "substack.com" = "substack" + | m "news.ycombinator.com" = "hacker-news" + | m "lesswrong.com" = "lesswrong" -- News - | "nytimes.com" `T.isInfixOf` url = "new-york-times" + | m "nytimes.com" = "new-york-times" -- Institutions - | "nasa.gov" `T.isInfixOf` url = "nasa" - | "apple.com" `T.isInfixOf` url = "apple" - | otherwise = "external" + | m "nasa.gov" = "nasa" + | m "apple.com" = "apple" + | otherwise = "external" + where + -- Label-suffix match: the host is the domain itself or a subdomain + -- of it. Never fires on a lookalike label (@notx.com@) or on text + -- in the path or query. + m d = host == d || ("." <> d) `T.isSuffixOf` host -- | Percent-encode characters that would break a @?file=@ query-string value. -- Slashes are intentionally left unencoded so root-relative paths remain diff --git a/build/Filters/Score.hs b/build/Filters/Score.hs index 85ba031..4baf322 100644 --- a/build/Filters/Score.hs +++ b/build/Filters/Score.hs @@ -15,6 +15,7 @@ module Filters.Score (inlineScores) where import Control.Exception (IOException, try) +import Data.Char (isHexDigit) import Data.Maybe (listToMaybe) import qualified Data.Text as T import qualified Data.Text.IO as TIO @@ -86,25 +87,48 @@ findImagePath blocks = listToMaybe -- | Replace hardcoded black fill/stroke values with @currentColor@ so the -- SVG inherits the CSS @color@ property in both light and dark modes. -- --- 6-digit hex patterns are at the bottom of the composition chain --- (applied first) so they are replaced before the 3-digit shorthand, --- preventing partial matches (e.g. @#000@ matching the prefix of @#000000@). +-- Quoted attribute forms (@fill="#000"@) are self-delimiting — the +-- closing quote bounds the match — so plain 'T.replace' is safe for +-- them. Unquoted style-property forms (@fill:#000@) are not: naive +-- replacement would also fire on the prefix of a longer hex colour +-- (@fill:#000080@ → @fill:currentColor80@, invalid CSS). Those go +-- through 'replaceHexColor', which rewrites a match only when it is +-- not followed by another hex digit; the boundary check also makes +-- the 3-digit/6-digit application order irrelevant. processColors :: T.Text -> T.Text processColors - -- 3-digit hex and keyword patterns (applied after 6-digit replacements) + -- 3-digit hex and keyword patterns = T.replace "fill=\"#000\"" "fill=\"currentColor\"" . T.replace "fill=\"black\"" "fill=\"currentColor\"" . T.replace "stroke=\"#000\"" "stroke=\"currentColor\"" . T.replace "stroke=\"black\"" "stroke=\"currentColor\"" - . T.replace "fill:#000" "fill:currentColor" + . replaceHexColor "fill:#000" "fill:currentColor" . T.replace "fill:black" "fill:currentColor" - . T.replace "stroke:#000" "stroke:currentColor" + . replaceHexColor "stroke:#000" "stroke:currentColor" . T.replace "stroke:black" "stroke:currentColor" -- 6-digit hex patterns (applied first — bottom of the chain) . T.replace "fill=\"#000000\"" "fill=\"currentColor\"" . T.replace "stroke=\"#000000\"" "stroke=\"currentColor\"" - . T.replace "fill:#000000" "fill:currentColor" - . T.replace "stroke:#000000" "stroke:currentColor" + . replaceHexColor "fill:#000000" "fill:currentColor" + . replaceHexColor "stroke:#000000" "stroke:currentColor" + +-- | 'T.replace' restricted to hex-boundary-terminated matches: an +-- occurrence of @needle@ is rewritten only when the character after +-- it is not another hex digit, so @fill:#000@ never fires inside the +-- longer colours @fill:#0008@, @fill:#000080@, or @fill:#00000080@. +replaceHexColor :: T.Text -> T.Text -> T.Text -> T.Text +replaceHexColor needle replacement = go + where + go t = + let (pre, rest) = T.breakOn needle t + in if T.null rest + then pre + else + let after = T.drop (T.length needle) rest + in case T.uncons after of + Just (c, _) | isHexDigit c -> + pre <> needle <> go after + _ -> pre <> replacement <> go after buildHtml :: Maybe T.Text -> Maybe T.Text -> T.Text -> T.Text buildHtml mName mCaption svgContent = T.concat diff --git a/build/Filters/Smallcaps.hs b/build/Filters/Smallcaps.hs index 3c7b5ad..d927af9 100644 --- a/build/Filters/Smallcaps.hs +++ b/build/Filters/Smallcaps.hs @@ -14,7 +14,8 @@ -- extra filter logic is needed for that case. -- -- The filter is /not/ applied inside headings (where Fira Sans uppercase --- text looks intentional) or inside @Code@/@RawInline@ inlines. +-- text looks intentional, at any nesting depth — including headings +-- inside divs and block quotes) or inside @Code@/@RawInline@ inlines. module Filters.Smallcaps (apply) where import Data.Char (isUpper, isAlpha) @@ -25,13 +26,31 @@ import Text.Pandoc.Walk (walk) import qualified Utils as U -- | Apply smallcaps detection to paragraph-level content. --- Skips heading blocks to avoid false positives. +-- Heading blocks are skipped at /every/ nesting level (a top-level +-- pattern match would miss a @Header@ inside a @Div@ or +-- @BlockQuote@): each header's @Str@ content is swapped for a +-- sentinel 'RawInline' before the wrapping walk and restored +-- afterwards, so 'wrapCaps' can never see it, wherever the header +-- sits in the block tree. apply :: Pandoc -> Pandoc -apply (Pandoc meta blocks) = Pandoc meta (map applyBlock blocks) +apply = walk restoreStr . walk wrapCaps . walk protectHeader -applyBlock :: Block -> Block -applyBlock b@(Header {}) = b -- leave headings untouched -applyBlock b = walk wrapCaps b +-- | Sentinel format marking a @Str@ that must not be wrapped. It only +-- exists between the protect and restore walks inside 'apply' and +-- can never leak into the writer. +skipFmt :: Format +skipFmt = Format "smallcaps-skip" + +protectHeader :: Block -> Block +protectHeader (Header lvl attr ils) = Header lvl attr (walk protectStr ils) + where + protectStr (Str t) = RawInline skipFmt t + protectStr x = x +protectHeader b = b + +restoreStr :: Inline -> Inline +restoreStr (RawInline fmt t) | fmt == skipFmt = Str t +restoreStr x = x -- | Wrap an all-caps Str token in an abbr element, preserving any trailing -- punctuation (comma, period, colon, semicolon, closing paren/bracket) diff --git a/build/Filters/SourceRefs.hs b/build/Filters/SourceRefs.hs index 64656bb..2f3d783 100644 --- a/build/Filters/SourceRefs.hs +++ b/build/Filters/SourceRefs.hs @@ -19,12 +19,15 @@ -- source-preview rule in 'Site.rules') and renders a -- syntax-highlighted snippet via Prism. -- --- Conservative-by-design: the trigger only fires on paths under a --- short whitelist of top-level directories, or a small set of named --- root files. This keeps the parser cheap and avoids false positives --- on words that happen to contain a slash and a dot. +-- Conservative-by-design: the trigger only fires on paths the +-- @/source/@ serving rule actually publishes ('isServedPath', a +-- mirror of @sourcePreviewable@ in 'Site.rules'), or a small set of +-- named root files. This keeps the parser cheap, avoids false +-- positives on words that happen to contain a slash and a dot, and +-- guarantees every wrapped path has a fetchable @/source/…@ copy. module Filters.SourceRefs (apply, isSourcePath, forgejoSourceUrl) where +import Control.Monad (when) import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef) import qualified Data.Map.Strict as Map import Data.Text (Text) @@ -94,16 +97,17 @@ classifyExistingLink x = pure x -- Heuristic -- --------------------------------------------------------------------------- --- | True when the text looks like a repo-relative path under one of --- the whitelisted directories (or is a whitelisted root file), ends --- in a known source extension, and contains only safe path --- characters. Conservative by design — the goal is no false --- positives on prose that incidentally contains a slash and a dot. +-- | True when the text looks like a repo-relative path that the +-- @/source/@ serving rule actually publishes (or is a whitelisted +-- root file), ends in a known source extension, and contains only +-- safe path characters. Conservative by design — the goal is no +-- false positives on prose that incidentally contains a slash and a +-- dot, and no wrapped path whose popup fetch would 404. isSourcePath :: Text -> Bool isSourcePath t = and [ not (T.null t) , T.all safeChar t - , (hasKnownPrefix t && hasKnownExt t) || isKnownRootFile t + , (isServedPath t && hasKnownExt t) || isKnownRootFile t ] where safeChar c = @@ -112,11 +116,26 @@ isSourcePath t = and || ('0' <= c && c <= '9') || c == '/' || c == '.' || c == '_' || c == '-' || c == '+' -hasKnownPrefix :: Text -> Bool -hasKnownPrefix t = any (`T.isPrefixOf` t) - [ "build/", "static/", "templates/", "tools/" - , "nginx/", "data/", "content/", "yaml-source/" +-- | Mirror of the @sourcePreviewable@ whitelist in 'Site.rules' (the +-- rule that copies files to @/source/@) — the two must stay +-- aligned so every link this filter emits has a corresponding +-- @/source/…@ target for the popup to fetch. Directories Site.hs +-- does not serve (e.g. @content/@) are deliberately absent here: +-- wrapping them would emit popups that are guaranteed to 404. +isServedPath :: Text -> Bool +isServedPath t = or + [ "build/" `T.isPrefixOf` t && hasExt ".hs" + , "static/js/" `T.isPrefixOf` t + , "static/css/" `T.isPrefixOf` t + , "templates/" `T.isPrefixOf` t + , "tools/" `T.isPrefixOf` t && (hasExt ".sh" || hasExt ".py") + , "nginx/" `T.isPrefixOf` t && hasExt ".conf" + , "data/" `T.isPrefixOf` t + && not ("/" `T.isInfixOf` T.drop 5 t) -- top-level data files only + && (hasExt ".json" || hasExt ".yaml" || hasExt ".md" || hasExt ".bib") ] + where + hasExt e = e `T.isSuffixOf` T.toLower t hasKnownExt :: Text -> Bool hasKnownExt t = @@ -125,7 +144,7 @@ hasKnownExt t = [ ".hs", ".js", ".mjs", ".css", ".html" , ".py", ".cabal", ".md", ".yaml", ".yml" , ".toml", ".sh", ".bash", ".svg", ".conf" - , ".json", ".ini", ".tex" + , ".json", ".ini", ".tex", ".bib" ] isKnownRootFile :: Text -> Bool @@ -142,14 +161,19 @@ isKnownRootFile t = t `elem` -- File existence cache -- --------------------------------------------------------------------------- --- | Process-wide memo of @doesFileExist@ results, keyed by the same --- path the popup will fetch. Hakyll runs this filter once per --- compiled page and the same source-file references recur across +-- | Process-wide memo of /positive/ @doesFileExist@ results, keyed by +-- the same path the popup will fetch. Hakyll runs this filter once +-- per compiled page and the same source-file references recur across -- many pages (e.g. @build\/Filters\/Links.hs@ in the Links page, -- the Colophon, several essays); the cache turns N stats into one --- per distinct path. The build process's working directory is the --- project root, so the path can be passed straight to --- 'doesFileExist' without prefixing. +-- per distinct path. Only existence is memoized: a missing file is +-- re-stat'ed on every miss, so a source file created during a +-- long-lived @make watch@ session is picked up on the next rebuild +-- instead of staying "absent" for the process lifetime. (A file +-- /deleted/ mid-watch stays cached as present until restart — the +-- benign direction: the popup fetch 404s and simply never appears.) +-- The build process's working directory is the project root, so the +-- path can be passed straight to 'doesFileExist' without prefixing. {-# NOINLINE existsCacheRef #-} existsCacheRef :: IORef (Map.Map Text Bool) existsCacheRef = unsafePerformIO (newIORef Map.empty) @@ -161,7 +185,8 @@ existsCached path = do Just b -> pure b Nothing -> do b <- doesFileExist (T.unpack path) - atomicModifyIORef' existsCacheRef (\m -> (Map.insert path b m, ())) + when b $ + atomicModifyIORef' existsCacheRef (\m -> (Map.insert path b m, ())) pure b -- --------------------------------------------------------------------------- diff --git a/build/Filters/Transclusion.hs b/build/Filters/Transclusion.hs index 4a18a93..cdbaf2c 100644 --- a/build/Filters/Transclusion.hs +++ b/build/Filters/Transclusion.hs @@ -5,7 +5,13 @@ -- HTML placeholders that transclude.js resolves at runtime. -- -- A directive must be the sole content of a line (after trimming) to be --- replaced — this prevents accidental substitution inside prose or code. +-- replaced — this prevents accidental substitution inside prose. +-- +-- Code protection (honest scope): lines inside /fenced/ code blocks +-- are passed through untouched ('Filters.Wikilinks.mapOutsideFences'), +-- so fenced examples can show @{{slug}}@ literally. Indented code +-- blocks and inline code spans are NOT recognised — a full-line +-- directive inside either is still rewritten. -- -- Examples: -- {{my-essay}} → full-page transclusion of /my-essay.html @@ -14,11 +20,13 @@ module Filters.Transclusion (preprocess) where import Data.List (isSuffixOf, isPrefixOf, stripPrefix) +import Filters.Wikilinks (mapOutsideFences) import qualified Utils as U --- | Apply transclusion substitution to the raw Markdown source string. +-- | Apply transclusion substitution to the raw Markdown source string, +-- skipping lines inside fenced code blocks. preprocess :: String -> String -preprocess = unlines . map processLine . lines +preprocess = mapOutsideFences processLine processLine :: String -> String processLine line = diff --git a/build/Filters/Viz.hs b/build/Filters/Viz.hs index 408f3ec..f60533f 100644 --- a/build/Filters/Viz.hs +++ b/build/Filters/Viz.hs @@ -37,6 +37,7 @@ module Filters.Viz (inlineViz) where import Control.Exception (IOException, catch) +import Data.Char (isHexDigit) import Data.Maybe (fromMaybe) import qualified Data.Text as T import System.Directory (doesFileExist) @@ -117,20 +118,47 @@ runScript baseDir attrs = -- | Replace hardcoded black fill/stroke values with @currentColor@ so the -- embedded SVG inherits the CSS text colour in both light and dark modes. +-- +-- Quoted attribute forms (@fill="#000"@) are self-delimiting — the +-- closing quote bounds the match — so plain 'T.replace' is safe for +-- them. Unquoted style-property forms (@fill:#000@) are not: naive +-- replacement would also fire on the prefix of a longer hex colour +-- (@fill:#000080@ → @fill:currentColor80@, invalid CSS). Those go +-- through 'replaceHexColor', which rewrites a match only when it is +-- not followed by another hex digit. processColors :: T.Text -> T.Text processColors = T.replace "fill=\"#000\"" "fill=\"currentColor\"" . T.replace "fill=\"black\"" "fill=\"currentColor\"" . T.replace "stroke=\"#000\"" "stroke=\"currentColor\"" . T.replace "stroke=\"black\"" "stroke=\"currentColor\"" - . T.replace "fill:#000" "fill:currentColor" + . replaceHexColor "fill:#000" "fill:currentColor" . T.replace "fill:black" "fill:currentColor" - . T.replace "stroke:#000" "stroke:currentColor" + . replaceHexColor "stroke:#000" "stroke:currentColor" . T.replace "stroke:black" "stroke:currentColor" . T.replace "fill=\"#000000\"" "fill=\"currentColor\"" . T.replace "stroke=\"#000000\"" "stroke=\"currentColor\"" - . T.replace "fill:#000000" "fill:currentColor" - . T.replace "stroke:#000000" "stroke:currentColor" + . replaceHexColor "fill:#000000" "fill:currentColor" + . replaceHexColor "stroke:#000000" "stroke:currentColor" + +-- | 'T.replace' restricted to hex-boundary-terminated matches: an +-- occurrence of @needle@ is rewritten only when the character after +-- it is not another hex digit, so @fill:#000@ never fires inside the +-- longer colours @fill:#0008@, @fill:#000080@, or @fill:#00000080@. +-- (Mirrors 'Filters.Score.replaceHexColor'.) +replaceHexColor :: T.Text -> T.Text -> T.Text -> T.Text +replaceHexColor needle replacement = go + where + go t = + let (pre, rest) = T.breakOn needle t + in if T.null rest + then pre + else + let after = T.drop (T.length needle) rest + in case T.uncons after of + Just (c, _) | isHexDigit c -> + pre <> needle <> go after + _ -> pre <> replacement <> go after -- --------------------------------------------------------------------------- -- JSON safety for