mirror of
https://github.com/aelve/guide.git
synced 2024-12-25 05:43:32 +03:00
Add code highlighting
This commit is contained in:
parent
0a2788059c
commit
1392ecd785
@ -44,6 +44,7 @@ executable guide
|
|||||||
, containers >= 0.5
|
, containers >= 0.5
|
||||||
, ekg
|
, ekg
|
||||||
, ekg-core
|
, ekg-core
|
||||||
|
, highlighting-kate >= 0.6
|
||||||
, lucid
|
, lucid
|
||||||
, megaparsec
|
, megaparsec
|
||||||
, microlens-platform >= 0.2.3
|
, microlens-platform >= 0.2.3
|
||||||
|
11
src/Main.hs
11
src/Main.hs
@ -36,6 +36,8 @@ import Lucid.Base (makeAttribute)
|
|||||||
import Web.Spock hiding (head, get, text)
|
import Web.Spock hiding (head, get, text)
|
||||||
import qualified Web.Spock as Spock
|
import qualified Web.Spock as Spock
|
||||||
import Network.Wai.Middleware.Static
|
import Network.Wai.Middleware.Static
|
||||||
|
-- Highlighting
|
||||||
|
import qualified Text.Highlighting.Kate as Kate
|
||||||
-- Monitoring
|
-- Monitoring
|
||||||
import qualified System.Remote.Monitoring as EKG
|
import qualified System.Remote.Monitoring as EKG
|
||||||
import qualified Network.Wai.Metrics as EKG
|
import qualified Network.Wai.Metrics as EKG
|
||||||
@ -227,6 +229,10 @@ otherMethods = do
|
|||||||
Spock.get "js.js" $ do
|
Spock.get "js.js" $ do
|
||||||
setHeader "Content-Type" "application/javascript; charset=utf-8"
|
setHeader "Content-Type" "application/javascript; charset=utf-8"
|
||||||
Spock.bytes $ T.encodeUtf8 (fromJS allJSFunctions)
|
Spock.bytes $ T.encodeUtf8 (fromJS allJSFunctions)
|
||||||
|
-- CSS
|
||||||
|
Spock.get "highlight.css" $ do
|
||||||
|
setHeader "Content-Type" "text/css; charset=utf-8"
|
||||||
|
Spock.bytes $ T.encodeUtf8 (T.pack (Kate.styleToCss Kate.pygments))
|
||||||
|
|
||||||
-- Moving things
|
-- Moving things
|
||||||
Spock.subcomponent "move" $ do
|
Spock.subcomponent "move" $ do
|
||||||
@ -259,6 +265,8 @@ main = do
|
|||||||
createCheckpoint db
|
createCheckpoint db
|
||||||
threadDelay (1000000 * 3600)
|
threadDelay (1000000 * 3600)
|
||||||
-- EKG metrics
|
-- EKG metrics
|
||||||
|
-- TODO: stop the server upon exit, somehow (or just don't start it
|
||||||
|
-- unless there's been some option passed?)
|
||||||
ekg <- EKG.forkServer "localhost" 5050
|
ekg <- EKG.forkServer "localhost" 5050
|
||||||
waiMetrics <- EKG.registerWaiMetrics (EKG.serverMetricStore ekg)
|
waiMetrics <- EKG.registerWaiMetrics (EKG.serverMetricStore ekg)
|
||||||
categoryGauge <- EKG.getGauge "db.categories" ekg
|
categoryGauge <- EKG.getGauge "db.categories" ekg
|
||||||
@ -335,6 +343,7 @@ renderRoot globalState mbSearchQuery = doctypehtml_ $ do
|
|||||||
includeJS (cdnjs <> "autosize.js/3.0.15/autosize.min.js")
|
includeJS (cdnjs <> "autosize.js/3.0.15/autosize.min.js")
|
||||||
onPageLoad (JS "autosize($('textarea'));")
|
onPageLoad (JS "autosize($('textarea'));")
|
||||||
includeCSS "/css.css"
|
includeCSS "/css.css"
|
||||||
|
includeCSS "/highlight.css"
|
||||||
-- Include definitions of all Javascript functions that we have defined
|
-- Include definitions of all Javascript functions that we have defined
|
||||||
-- in this file. (This isn't an actual file, so don't look for it in the
|
-- in this file. (This isn't an actual file, so don't look for it in the
|
||||||
-- static folder – it's generated and served in 'otherMethods'.)
|
-- static folder – it's generated and served in 'otherMethods'.)
|
||||||
@ -402,8 +411,6 @@ renderRoot globalState mbSearchQuery = doctypehtml_ $ do
|
|||||||
|
|
||||||
-- TODO: mention that (@hackage) is supported somewhere
|
-- TODO: mention that (@hackage) is supported somewhere
|
||||||
|
|
||||||
-- TODO: code highlighting
|
|
||||||
|
|
||||||
-- TODO: when submitting a text field, gray it out (but leave it selectable)
|
-- TODO: when submitting a text field, gray it out (but leave it selectable)
|
||||||
-- until it's been submitted
|
-- until it's been submitted
|
||||||
|
|
||||||
|
@ -19,6 +19,7 @@ import Control.Monad.Writer
|
|||||||
-- Text
|
-- Text
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
import qualified Data.Text.Lazy as TL
|
||||||
-- Parsing
|
-- Parsing
|
||||||
import Text.Megaparsec
|
import Text.Megaparsec
|
||||||
-- HTML
|
-- HTML
|
||||||
@ -31,6 +32,8 @@ import Data.Sequence
|
|||||||
import Cheapskate
|
import Cheapskate
|
||||||
import Cheapskate.Html
|
import Cheapskate.Html
|
||||||
import ShortcutLinks
|
import ShortcutLinks
|
||||||
|
-- Highlighting
|
||||||
|
import qualified Text.Highlighting.Kate as Kate
|
||||||
|
|
||||||
|
|
||||||
blazeToLucid :: Monad m => Blaze.Html -> HtmlT m ()
|
blazeToLucid :: Monad m => Blaze.Html -> HtmlT m ()
|
||||||
@ -74,6 +77,15 @@ shortcutLinks i@(Link is url title) | '@' <- T.head url =
|
|||||||
Str ("[error when processing shortcut link: " <> T.pack err <> "]")
|
Str ("[error when processing shortcut link: " <> T.pack err <> "]")
|
||||||
shortcutLinks other = other
|
shortcutLinks other = other
|
||||||
|
|
||||||
|
highlight :: Block -> Block
|
||||||
|
highlight (CodeBlock attr code) =
|
||||||
|
HtmlBlock (TL.toStrict (Blaze.renderHtml formatted))
|
||||||
|
where
|
||||||
|
lang = T.unpack (codeLang attr)
|
||||||
|
highlighted = Kate.highlightAs lang (T.unpack code)
|
||||||
|
formatted = Kate.formatHtmlBlock Kate.defaultFormatOpts highlighted
|
||||||
|
highlight other = other
|
||||||
|
|
||||||
-- TODO: this should be in the shortcut-links package itself
|
-- TODO: this should be in the shortcut-links package itself
|
||||||
|
|
||||||
-- | Parse a shortcut link. Allowed formats:
|
-- | Parse a shortcut link. Allowed formats:
|
||||||
@ -112,8 +124,8 @@ renderMarkdownLine s = do
|
|||||||
extractInlines HRule = mempty
|
extractInlines HRule = mempty
|
||||||
|
|
||||||
-- TODO: rename to renderMarkdownBlocks
|
-- TODO: rename to renderMarkdownBlocks
|
||||||
-- TODO: would be nice to have syntax highlighting
|
|
||||||
renderMarkdownBlock :: Monad m => Text -> HtmlT m ()
|
renderMarkdownBlock :: Monad m => Text -> HtmlT m ()
|
||||||
renderMarkdownBlock =
|
renderMarkdownBlock =
|
||||||
blazeToLucid . renderDoc .
|
blazeToLucid . renderDoc .
|
||||||
walk shortcutLinks . markdown def{allowRawHtml=False}
|
walk highlight . walk shortcutLinks .
|
||||||
|
markdown def
|
||||||
|
Loading…
Reference in New Issue
Block a user