[Git][ghc/ghc][wip/jacco/haddock/codeblock-highlighting] Haddock highlighted codeblocks: optional language.

[Jacco Krijnen (@jacco)]

Jacco Krijnen pushed to branch wip/jacco/haddock/codeblock-highlighting at Glasgow Haskell Compiler / GHC


Commits:
1521cf9b by Jacco Krijnen at 2024-06-17T18:33:15+02:00
Haddock highlighted codeblocks: optional language.

The triple backtick notation should not require a
language to be used for highlighting.

- - - - -


4 changed files:

- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Json.hs
- utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
- utils/haddock/haddock-library/src/Documentation/Haddock/Types.hs


Changes:

=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/DocMarkup.hs
=====================================
@@ -70,8 +70,9 @@ parHtmlMarkup qual insertAnchors ppId =
     , markupOrderedList = makeOrdList
     , markupDefList = defList
     , markupCodeBlock = pre
-    , markupCodeBlockHighlight   = \(Highlight l cont) ->
-        pre ! [theclass ("language-" ++ l)] << toHtml cont
+    , markupCodeBlockHighlight = \(Highlight mLang cont) ->
+        let attrs = maybe [] (\name -> [theclass ("language-" ++ name)]) mLang
+        in pre ! attrs << toHtml cont
     , markupHyperlink = \(Hyperlink url mLabel) ->
         if insertAnchors
           then


=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Json.hs
=====================================
@@ -155,7 +155,7 @@ jsonDoc (DocCodeBlockHighlight hl) = jsonObject
     ]
   where
     jsonHighlight Highlight{..} = jsonObject
-        [ ("highlightLanguage", jsonString highlightLanguage)
+        [ ("highlightLanguage", jsonMaybe jsonString highlightLanguage)
         , ("highlightContent", jsonString highlightContent)
         ]
 


=====================================
utils/haddock/haddock-library/src/Documentation/Haddock/Parser.hs
=====================================
@@ -910,10 +910,10 @@ codeblockHighlight indent = DocCodeBlockHighlight <$> pHighlight
         <*> pLang
         <*> (intercalate "\n" <$> Parsec.manyTill pCodeLine pBlockEnd)
 
-    pLang :: Parser String
+    pLang :: Parser (Maybe String)
     pLang =
       skipHorizontalSpace
-        *> Parsec.many1 Parsec.alphaNum
+        *> optional (Parsec.many1 Parsec.alphaNum)
         <* skipHorizontalSpace
         <* Parsec.newline
 


=====================================
utils/haddock/haddock-library/src/Documentation/Haddock/Types.hs
=====================================
@@ -110,7 +110,7 @@ data Table id = Table
   deriving (Eq, Show, Functor, Foldable, Traversable)
 
 data Highlight = Highlight
-  { highlightLanguage :: String
+  { highlightLanguage :: Maybe String
   , highlightContent  :: String
   }
   deriving (Eq, Show)



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1521cf9b08943f3e23c9ae532b5f979d0be93d8c

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/1521cf9b08943f3e23c9ae532b5f979d0be93d8c
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240617/c23ca405/attachment-0001.html>