diff --git a/guide.cabal b/guide.cabal index 3c614a8..c70359c 100644 --- a/guide.cabal +++ b/guide.cabal @@ -88,6 +88,7 @@ library , aeson-pretty , base >=4.9 && <4.10 , base-prelude + , blaze-html , bytestring , cereal , cmark == 0.5.* @@ -111,6 +112,7 @@ library , fsnotify == 0.2.* , hashable , haskell-src-meta + , highlighting-kate , http-api-data , http-client , http-client-tls diff --git a/src/Snippets/Renderer.hs b/src/Snippets/Renderer.hs index 32425dd..2357841 100644 --- a/src/Snippets/Renderer.hs +++ b/src/Snippets/Renderer.hs @@ -8,9 +8,14 @@ where import Imports -import qualified Data.Map as M (lookup) +import Data.List (dropWhileEnd) +import qualified Data.Map as M (lookup) +import qualified Data.Text as T -- Web -import Lucid hiding (for_) +import Lucid hiding (for_) + +import Text.Blaze.Html.Renderer.String (renderHtml) +import Text.Highlighting.Kate import Guide.Utils import Snippets.Parser @@ -23,6 +28,7 @@ renderTestSnippets = do nodes <- liftIO mainParse head_ $ do includeCSS "/snippets.css" + includeCSS "/highlight.css" title_ "Snippets – Aelve Guide" meta_ [ name_ "viewport" , content_ "width=device-width, initial-scale=1.0, user-scalable=yes" @@ -77,7 +83,7 @@ renderTab :: (Monad m) -> HtmlT m () -- ^ Rendered tab content renderTab lbls intLbl@(_, lbl) x = let clss = if not (null lbls) then " tabcontent" else "" in - div_ [class_ ("code" <> clss), id_ lbl] $ + div_ [class_ ("code sourceCode" <> clss), id_ lbl] $ pre_ $ for_ x (renderLine lbls intLbl) @@ -108,25 +114,32 @@ renderNode lbls intLbl (HltBegin:xs) = do mark_ [class_ "inlineMark"] $ renderNode lbls intLbl before renderNode lbls intLbl (drop 1 after) renderNode lbls intLbl (CodeText t:xs) = do - toHtml t + renderTextHtml t renderNode lbls intLbl xs renderNode lbls intLbl@(curInt, curLbl) (Choice x:xs) = do case M.lookup curLbl x of Just curTxt -> if curInt == 1 - then toHtml curTxt + then renderTextHtml curTxt else case lookup (pred curInt) lbls of Just prevLbl -> case M.lookup prevLbl x of Just prevTxt -> if prevTxt /= curTxt - then span_ [class_ "diff"] $ toHtml curTxt - else toHtml curTxt - Nothing -> span_ [class_ "diff"] $ toHtml curTxt - Nothing -> toHtml curTxt + then span_ [class_ "diff"] $ renderTextHtml curTxt + else renderTextHtml curTxt + Nothing -> span_ [class_ "diff"] $ renderTextHtml curTxt + Nothing -> renderTextHtml curTxt Nothing -> "" renderNode lbls intLbl xs renderNode lbls lbl (Hackage x:xs) = do a_ [href_ "#"] (toHtml x) renderNode lbls lbl xs -renderNode lbls lbl (_:xs) = renderNode lbls lbl xs \ No newline at end of file +renderNode lbls lbl (_:xs) = renderNode lbls lbl xs + +highlightKateCode :: Text -> String +highlightKateCode code = renderHtml $ formatHtmlInline defaultFormatOpts + $ highlightAs "haskell" (T.unpack code) + +renderTextHtml :: (Monad m) => Text -> HtmlT m () +renderTextHtml = toHtmlRaw . highlightKateCode \ No newline at end of file