diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,9 @@ +## MMark Ext 0.2.1.0 + +* Added the module `Text.MMark.Extension.GhcSyntaxHighlighter` with + `ghcSyntaxHighlighter` in it. This only works with GHC 8.4.1 and newer, + with older GHCs the extension just won't have any effect. + ## MMark Ext 0.2.0.0 * The `skylighting` extension no longer accepts any arguments. Skylighting diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,9 +5,8 @@ [![Stackage Nightly](http://stackage.org/package/mmark-ext/badge/nightly)](http://stackage.org/nightly/package/mmark-ext) [![Stackage LTS](http://stackage.org/package/mmark-ext/badge/lts)](http://stackage.org/lts/package/mmark-ext) [![Build Status](https://travis-ci.org/mmark-md/mmark-ext.svg?branch=master)](https://travis-ci.org/mmark-md/mmark-ext) -[![Coverage Status](https://coveralls.io/repos/mmark-md/mmark-ext/badge.svg?branch=master&service=github)](https://coveralls.io/github/mmark-md/mmark-ext?branch=master) -Commonly useful extensions for +Commonly useful extensions for the [MMark](https://hackage.haskell.org/package/mmark) markdown processor. ## Contribution diff --git a/Text/MMark/Extension/Common.hs b/Text/MMark/Extension/Common.hs --- a/Text/MMark/Extension/Common.hs +++ b/Text/MMark/Extension/Common.hs @@ -7,7 +7,7 @@ -- Stability : experimental -- Portability : portable -- --- Commonly useful extensions for MMark markdown processor. +-- Commonly useful extensions for the MMark markdown processor. -- -- We suggest using a qualified import, like this: -- @@ -47,6 +47,7 @@ ( module Text.MMark.Extension.Comment , module Text.MMark.Extension.FontAwesome , module Text.MMark.Extension.Footnotes + , module Text.MMark.Extension.GhcSyntaxHighlighter , module Text.MMark.Extension.Kbd , module Text.MMark.Extension.LinkTarget , module Text.MMark.Extension.MathJax @@ -59,6 +60,7 @@ import Text.MMark.Extension.Comment import Text.MMark.Extension.FontAwesome import Text.MMark.Extension.Footnotes +import Text.MMark.Extension.GhcSyntaxHighlighter import Text.MMark.Extension.Kbd import Text.MMark.Extension.LinkTarget import Text.MMark.Extension.MathJax diff --git a/Text/MMark/Extension/GhcSyntaxHighlighter.hs b/Text/MMark/Extension/GhcSyntaxHighlighter.hs new file mode 100644 --- /dev/null +++ b/Text/MMark/Extension/GhcSyntaxHighlighter.hs @@ -0,0 +1,121 @@ +-- | +-- Module : Text.MMark.Extension.GhcSyntaxHighlighter +-- Copyright : © 2018 Mark Karpov +-- License : BSD 3 clause +-- +-- Maintainer : Mark Karpov +-- Stability : experimental +-- Portability : portable +-- +-- Use the @ghc-syntax-highlighter@ package to highlight Haskell code. This +-- module only works with GHC 8.4.1 and newer (with older versions the +-- extension just won't have any effect). +-- +-- @since 0.2.1.0 + +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module Text.MMark.Extension.GhcSyntaxHighlighter + ( ghcSyntaxHighlighter ) +where + +import Data.Text (Text) +import Lucid +import Text.MMark.Extension (Extension, Block (..)) +import qualified Data.Text as T +import qualified Text.MMark.Extension as Ext + +#if __GLASGOW_HASKELL__ >= 804 +import GHC.SyntaxHighlighter +#else +data Token + = KeywordTok + | PragmaTok + | SymbolTok + | VariableTok + | ConstructorTok + | OperatorTok + | CharTok + | StringTok + | IntegerTok + | RationalTok + | CommentTok + | SpaceTok + | OtherTok + deriving (Eq, Ord, Enum, Bounded, Show) +tokenizeHaskell :: Text -> Maybe [(Token, Text)] +tokenizeHaskell _ = Nothing +#endif + +-- | Use the @ghc-syntax-highlighter@ package to highlight Haskell code. The +-- extension is applied only to code blocks with info string @\"haskell\"@. +-- +-- The resulting code block will be wrapped in a @div@ with class +-- @\"source-code\"@. The following @span@ classes can be used for styling: +-- +-- * 'KeywordTok' = @\"kw\"@ +-- * 'PragmaTok' = @\"pr\"@ +-- * 'SymbolTok' = @\"sy\"@ +-- * 'VariableTok' = @\"va\"@ +-- * 'ConstructorTok' = @\"cr\"@ +-- * 'OperatorTok' = @\"op\"@ +-- * 'CharTok' = @\"ch\"@ +-- * 'StringTok' = @\"st\"@ +-- * 'IntegerTok' = @\"it\"@ +-- * 'RationalTok' = @\"ra\"@ +-- * 'CommentTok' = @\"co\"@ +-- * 'SpaceTok' = no +-- * 'OtherTok' = @\"ot\"@ +-- +-- To use with 'Text.MMark.Extension.Skylighting.skylighting' the extension +-- should be applied /after/ the +-- 'Text.MMark.Extension.Skylighting.skylighting' extension so it can +-- overwrite its logic for code block with @\"haskell\"@ info string. So +-- place it on the left hand side of @('<>')@ or above +-- 'Text.MMark.Extension.Skylighting.skylighting' in the list passed to +-- 'Text.MMark.useExtensions'. + +ghcSyntaxHighlighter :: Extension +ghcSyntaxHighlighter = Ext.blockRender $ \old block -> + case block of + cb@(CodeBlock (Just "haskell") txt) -> + case tokenizeHaskell txt of + Nothing -> old cb + Just toks -> do + div_ [class_ "source-code"] + . pre_ + . code_ [class_ "language-haskell"] + $ mapM_ tokenToHtml toks + newline + other -> old other + where + newline :: Html () + newline = "\n" + +-- | Render a single 'Token'. + +tokenToHtml :: (Token, Text) -> Html () +tokenToHtml (tokenType, txt) = + span_ [class_ rawClass | not (T.null rawClass)] (toHtml txt) + where + rawClass = tokenClass tokenType + +-- | Return class corresponding to given 'TokenType'. + +tokenClass :: Token -> Text +tokenClass = \case + KeywordTok -> "kw" + PragmaTok -> "pr" + SymbolTok -> "sy" + VariableTok -> "va" + ConstructorTok -> "cr" + OperatorTok -> "op" + CharTok -> "ch" + StringTok -> "st" + IntegerTok -> "it" + RationalTok -> "ra" + CommentTok -> "co" + SpaceTok -> "" + OtherTok -> "ot" diff --git a/mmark-ext.cabal b/mmark-ext.cabal --- a/mmark-ext.cabal +++ b/mmark-ext.cabal @@ -1,7 +1,7 @@ name: mmark-ext -version: 0.2.0.0 -cabal-version: >= 1.18 -tested-with: GHC==8.0.2, GHC==8.2.2 +version: 0.2.1.0 +cabal-version: 1.18 +tested-with: GHC==8.0.2, GHC==8.2.2, GHC==8.4.2 license: BSD3 license-file: LICENSE.md author: Mark Karpov @@ -9,12 +9,12 @@ homepage: https://github.com/mmark-md/mmark-ext bug-reports: https://github.com/mmark-md/mmark-ext/issues category: Text -synopsis: Commonly useful extensions for MMark markdown processor +synopsis: Commonly useful extensions for the MMark markdown processor build-type: Simple description: - Commonly useful extensions for MMark markdown processor. - Click on "Text.MMark.Extension.Common" to get started. + Commonly useful extensions for the MMark markdown processor. Click on + "Text.MMark.Extension.Common" to get started. extra-doc-files: CHANGELOG.md , README.md @@ -32,19 +32,22 @@ library build-depends: base >= 4.9 && < 5.0 - , foldl >= 1.2 && < 1.4 + , foldl >= 1.2 && < 1.5 , lucid >= 2.6 && < 3.0 , microlens >= 0.4 && < 0.5 , mmark >= 0.0.4 && <= 0.1 - , modern-uri >= 0.1.1 && < 0.3 - , skylighting >= 0.5 && < 0.7 + , modern-uri >= 0.2 && < 0.3 + , skylighting >= 0.5 && < 0.8 , text >= 0.2 && < 1.3 + if impl(ghc >= 8.4) + build-depends: ghc-syntax-highlighter >= 0.0.1 && < 0.1 if !impl(ghc >= 8.0) build-depends: semigroups == 0.18.* exposed-modules: Text.MMark.Extension.Common , Text.MMark.Extension.Comment , Text.MMark.Extension.FontAwesome , Text.MMark.Extension.Footnotes + , Text.MMark.Extension.GhcSyntaxHighlighter , Text.MMark.Extension.Kbd , Text.MMark.Extension.LinkTarget , Text.MMark.Extension.MathJax @@ -53,7 +56,11 @@ , Text.MMark.Extension.Skylighting , Text.MMark.Extension.TableOfContents if flag(dev) - ghc-options: -O0 -Wall -Werror + ghc-options: -O0 -Wall -Werror -Wcompat + -Wincomplete-record-updates + -Wincomplete-uni-patterns + -Wnoncanonical-monad-instances + -Wnoncanonical-monadfail-instances else ghc-options: -O2 -Wall default-language: Haskell2010 @@ -68,6 +75,7 @@ , mmark >= 0.0.4 && <= 0.1 , mmark-ext , text >= 0.2 && < 1.3 + build-tools: hspec-discover >= 2.0 && < 3.0 if flag(dev) ghc-options: -O0 -Wall -Werror else @@ -75,6 +83,7 @@ other-modules: Text.MMark.Extension.CommentSpec , Text.MMark.Extension.FontAwesomeSpec , Text.MMark.Extension.FootnotesSpec + , Text.MMark.Extension.GhcSyntaxHighlighterSpec , Text.MMark.Extension.KbdSpec , Text.MMark.Extension.LinkTargetSpec , Text.MMark.Extension.MathJaxSpec diff --git a/tests/Text/MMark/Extension/GhcSyntaxHighlighterSpec.hs b/tests/Text/MMark/Extension/GhcSyntaxHighlighterSpec.hs new file mode 100644 --- /dev/null +++ b/tests/Text/MMark/Extension/GhcSyntaxHighlighterSpec.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} + +module Text.MMark.Extension.GhcSyntaxHighlighterSpec (spec) where + +import Test.Hspec +import Text.MMark.Extension.GhcSyntaxHighlighter +import Text.MMark.Extension.TestUtils + +spec :: Spec +spec = + describe "ghcSyntaxHighlighter" $ do + let to = withExt ghcSyntaxHighlighter + context "when info string is not \"haskell\"" $ + it "has no effect" $ + "```foo\nmain :: IO ()\nmain = return ()\n```\n" `to` + "
main :: IO ()\nmain = return ()\n
\n" +#if __GLASGOW_HASKELL__ >= 804 + context "with info string is \"haskell\"" $ + it "renders it correctly" $ + "```haskell\nmain :: IO ()\nmain = return ()\n```\n" `to` + "
main :: IO ()\nmain = return ()\n
\n" +#endif