flupe
/
escot
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added custom markdown rendering

This commit is contained in:
flupe 2022-10-05 08:42:34 +02:00
parent 9f9e955524
commit e7d62f6adf
8 changed files with 273 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
content/assets/Asanb.woff2 Normal file
View File

Binary file not shown.

BIN
content/assets/mononoki-Regular.woff2 Normal file
View File

Binary file not shown.

92
content/assets/theme.css
View File

@ -1,8 +1,20 @@
:root { :root {
--large-width: 1080px; --large-width: 1080px;
--small-width: 600px; --small-width: 600px;
--mono-font: mononoki;
} }
@font-face {
font-family: mononoki;
src: url("/assets/mononoki-Regular.woff2") format("woff2");
}
@font-face {
font-family: Asanb;
src: url("/assets/Asanb.woff2") format("woff2");
}
body { body {
font-family: sans-serif; font-family: sans-serif;
font-size: 14px; font-size: 14px;
@ -15,13 +27,13 @@ body {
line-height: 1.54; line-height: 1.54;
min-height: 100vh; min-height: 100vh;
background: #dce0df; background: #dce0df;
grid-template: "a m e" 1fr grid-template: "a m m" 1fr
". f f" / 180px 1fr 180px; ". f f" / 180px 1fr 180px;
gap: 2em; gap: 2em;
} }
h1, h2, h3, nav a { h1, h2, h3, nav a {
font-family: monospace; font-family: var(--mono-font), monospace;
font-weight: 500; font-weight: 500;
text-transform: uppercase; text-transform: uppercase;
letter-spacing: 0.1rem; letter-spacing: 0.1rem;
@ -39,13 +51,6 @@ nav ul {
padding: 0 padding: 0
} }
@media (max-width: 840px) {
body {
grid-template: "a" "m" 1fr "f";
}
nav {padding: 0}
nav ul { position: static; }
}
nav a { nav a {
display: block; display: block;
@ -74,11 +79,34 @@ ul {
} }
main *+h2 {margin-top: 2rem} main *+h2 {margin-top: 2rem}
main {margin-bottom: 2rem;} main {
margin-bottom: 2rem;
grid-area: m;
}
main > * {
max-width: var(--small-width);
}
main > pre, main > details, div.sourceCode {
max-width: 100%;
box-sizing: border-box;
clear: both;
}
main > ol.footnotes {
margin: 0;
padding: 0;
float: right;
font-size: .9em;
opacity: .8;
}
main > ol.footnotes li p:first-child { margin-top: 0; }
main > ol.footnotes li p:last-child { margin-bottom: 0; }
main h2:first-child { margin-top: 0 } main h2:first-child { margin-top: 0 }
/* aside info */ /* aside info */
#contact + table {font-family: monospace} #contact + table {font-family: var(--mono-font), monospace}
#contact + table td:first-child { #contact + table td:first-child {
padding-right: 1em; padding-right: 1em;
text-transform: uppercase; text-transform: uppercase;
@ -95,7 +123,7 @@ main h2:first-child { margin-top: 0 }
.pubs ul::before { .pubs ul::before {
content: attr(data-year); content: attr(data-year);
position: absolute; position: absolute;
font-family: monospace; font-family: var(--mono-font), monospace;
writing-mode: vertical-rl; writing-mode: vertical-rl;
text-orientation: upright; text-orientation: upright;
left: 0; left: 0;
@ -131,3 +159,43 @@ main h2:first-child { margin-top: 0 }
} }
footer {grid-area: f} footer {grid-area: f}
pre {
white-space: pre-wrap;
background: #fff;
border-radius: 4px;
padding: .5em 1em;
}
details summary {
border: 1px solid #000;
border-radius: 4px;
padding: .5em 1em;
cursor: pointer;
}
details[open] {
border-bottom: 1px solid #000;
border-radius: 4px;
}
code {font-family: var(--mono-font), Asanb, monospace}
pre.Agda a { text-decoration: none; font-family: var(--mono-font), Asanb, monospace; }
.Keyword { color: #d08770 }
.Primitive { color: #5e81ac }
.InductiveConstructor { color: #a3be8c }
.Comment { color: #d8dee9 }
.Hole {
background: #88c0d0;
border-radius: 4px;
}
@media (max-width: 840px) {
body {
grid-template: "a" "m" 1fr "f";
}
nav {padding: 0}
nav ul { position: static; }
main > ol.footnotes + * { clear: both; }
}

2
content/index.html
View File

@ -7,7 +7,7 @@
<meta name="robots" content="index, follow"> <meta name="robots" content="index, follow">
<link rel="stylesheet" href="/assets/theme.css"> <link rel="stylesheet" href="/assets/theme.css">
<link rel="shortcut icon" type="image/svg" href="/assets/favicon.svg"> <link rel="shortcut icon" type="image/svg" href="/assets/favicon.svg">
<title>Lucas Escot</title> <title>{{ $title }}</title>
</head> </head>
<body> <body>
<nav>{{ $nav }}</nav> <nav>{{ $nav }}</nav>

16
content/index.md
View File

@ -5,7 +5,13 @@ in the [Programming Languages Group](https://pl.ewi.tudelft.nl/),
under the supervision of Jesper Cockx. My work revolves around generic programming under the supervision of Jesper Cockx. My work revolves around generic programming
in dependently-typed languages --- namely, [Agda](https://github.com/agda/agda). in dependently-typed languages --- namely, [Agda](https://github.com/agda/agda).
## Miscellaneous ## Notes {#notes}
```{=html}
{{ $notes }}
```
## Miscellaneous {#misc}
On my spare time, I do a fair bit of drawing. Some of it may be found over at [acatalepsie.fr](https://acatalepsie.fr). On my spare time, I do a fair bit of drawing. Some of it may be found over at [acatalepsie.fr](https://acatalepsie.fr).
Along with a group of friends, I am part of the [sbi.re](https://sbi.re) network, Along with a group of friends, I am part of the [sbi.re](https://sbi.re) network,
@ -13,13 +19,15 @@ under which we self-host a bunch of services.
## Contact/Links {#contact} ## Contact/Links {#contact}
------- --------------------------------------- ------- ------------------------------------------------------------------------------------------------
Mail [lucas@escot.me](mailto:lucas@escot.me) Mail [lucas@escot.me](mailto:lucas@escot.me), [l.f.b.escot@tudelft.nl](mailto:l.f.b.escot@tudelft.nl)
GPG [lescot.gpg](/lescot.gpg) GPG [lescot.gpg](/lescot.gpg)
GH [flupe](https://github.com/flupe) GH [flupe](https://github.com/flupe)
SRHT [flupe](https://sr.ht/~flupe) SRHT [flupe](https://sr.ht/~flupe)
------- --------------------------------------- ------- ------------------------------------------------------------------------------------------------
## Publications ## Publications
```{=html}
{{ $publications }} {{ $publications }}
```

2
escot.cabal
View File

@ -10,6 +10,7 @@ executable escot
hs-source-dirs: src hs-source-dirs: src
other-modules: Config other-modules: Config
, Template , Template
, Markdown
build-depends: base build-depends: base
, filepath , filepath
, achille , achille
@ -31,6 +32,7 @@ executable escot
, process , process
, directory , directory
, megaparsec , megaparsec
, mtl
default-extensions: BlockArguments default-extensions: BlockArguments
, TupleSections , TupleSections
, OverloadedStrings , OverloadedStrings

76
src/Main.hs
View File

@ -8,7 +8,9 @@ import Data.Aeson (FromJSON)
import Data.Binary (Binary) import Data.Binary (Binary)
import Control.Monad ((>=>)) import Control.Monad ((>=>))
import Data.Function ((&)) import Data.Function ((&))
import Data.Text (Text) import Data.Text (Text, pack)
import Data.Time (UTCTime, defaultTimeLocale)
import System.Directory qualified as System
import Data.List (intersperse) import Data.List (intersperse)
import Data.Maybe (fromJust) import Data.Maybe (fromJust)
import Data.Yaml import Data.Yaml
@ -26,11 +28,13 @@ import Achille
import Achille.Writable (Writable) import Achille.Writable (Writable)
import Achille.Writable qualified as Writable import Achille.Writable qualified as Writable
import Achille.Internal.IO (AchilleIO) import Achille.Internal.IO (AchilleIO)
import Achille.Internal.IO qualified as AchilleIO
import Achille.Task.Pandoc import Achille.Task.Pandoc
import Template (Template, Context, parseTemplate) import Template (Template, Context, parseTemplate)
import Template qualified import Template qualified
import Config (config, ropts, wopts, SiteConfig(title)) import Config (config, ropts, wopts, SiteConfig(title))
import Markdown qualified
-- Bibliography info -- Bibliography info
@ -75,38 +79,88 @@ render template ctx body =
KeyMap.insert "body" (String body) ctx KeyMap.insert "body" (String body) ctx
& Template.render template & Template.render template
-- writing Html to disk (efficiently) -- writing Html to disk (efficiently)
instance AchilleIO m => Writable m (Html ()) where instance AchilleIO m => Writable m (Html ()) where
write to = Writable.write to . renderBS write to = Writable.write to . renderBS
data Note = Note
{ date :: UTCTime
, title :: Text
}
deriving (Eq, Binary, Generic, FromJSON)
main = achille do main = achille do
index <- readTemplate "index.html" index <- readTemplate "index.html"
match_ "assets/*" $ copyFile match_ "assets/*" copyFile
match_ "papers/*" copyFile
match_ "static/*" $ copyFileAs (makeRelative "static/") match_ "static/*" $ copyFileAs (makeRelative "static/")
match_ "papers/*" $ copyFile
pubs :: [Publication] <- matchFile "publications.yaml" parseYaml (nav, index') <- matchFile "index.md" \src -> do
watch pubs $ match_ "index.md" \src -> do
doc <- readPandocWith def {readerExtensions = pandocExtensions} src doc <- readPandocWith def {readerExtensions = pandocExtensions} src
let Pandoc _ blocks = doc let Pandoc _ blocks = doc
let headers = filter isHeaderBlock blocks let headers = filter isHeaderBlock blocks
-- parsing rendered md as template -- parsing rendered md as template
template :: Template <- renderPandoc doc <&> parseTemplate <&> fromJust let template = renderText (Markdown.render doc) & LT.toStrict & parseTemplate & fromJust
let ctx = KeyMap.insert "nav" (String (LT.toStrict $ renderText $ renderNav headers)) $ return (LT.toStrict $ renderText $ renderNav headers, template)
pubs :: [Publication] <- matchFile "publications.yaml" parseYaml
notes :: [(FilePath, Note)] <- match "notes/*.md" \src -> do
if ".lagda.md" /= takeExtensions src then do
(meta@Note{..}, doc) <- readPandocMetadataWith def {readerExtensions = pandocExtensions} src
path <- LT.toStrict (renderText (Markdown.render doc))
& write (src -<.> "html")
. render index (KeyMap.insert "title" (String title) $ KeyMap.insert "nav" (String nav) $ KeyMap.empty)
return (path, meta)
else do
spath <- toAbsolute src
odir <- getOutputDir <&> (</> dropExtensions src)
debug odir
tmp <- liftIO System.getTemporaryDirectory <&> (</> "escot")
liftIO $ System.createDirectoryIfMissing False tmp
liftIO $ System.createDirectoryIfMissing True odir
liftIO $ AchilleIO.copyFile spath (tmp </> "index.lagda.md")
dir <- liftIO System.getCurrentDirectory
liftIO $ System.setCurrentDirectory tmp
callCommand $
"agda --html "
<> "--html-dir=. "
<> "--html-highlight=auto "
<> "index.lagda.md"
liftIO $ System.setCurrentDirectory dir
callCommand $ "cp " <> tmp <> "/* " <> odir
(meta@Note{..}, doc) <- readAbsPandocMetadataWith def {readerExtensions = pandocExtensions} (tmp </> "index.md")
debug doc
path <- renderPandoc doc >>= write (dropExtensions src </> "index.html")
. render index (KeyMap.insert "title" (String title) $ KeyMap.insert "nav" (String nav) $ KeyMap.empty)
return (takeDirectory path, meta)
let notesList :: Html () =
ul_ $ foldMap (\(src, Note{..}) -> li_ $ a_ [ href_ (pack src) ] $ toHtmlRaw title) notes
watch pubs $ watch notes do
let ctx = KeyMap.insert "nav" (String nav) $
KeyMap.insert "notes" (String (LT.toStrict $ renderText notesList)) $
KeyMap.insert "title" (String "Lucas Escot") $
KeyMap.insert "publications" (String (LT.toStrict $ renderText $ renderPublications pubs)) KeyMap.empty KeyMap.insert "publications" (String (LT.toStrict $ renderText $ renderPublications pubs)) KeyMap.empty
write (src -<.> "html") $ render index ctx (LT.toStrict $ Template.render template ctx) write "index.html" $ render index ctx (LT.toStrict $ Template.render index' ctx)
where where
renderNav :: [Block] -> Html () renderNav :: [Block] -> Html ()
renderNav = ul_ . foldMap (\(Header _ (id, _, _) _) -> li_ $ a_ [href_ $ "#" <> id] (toHtmlRaw id)) renderNav = ul_ . foldMap (\(Header _ (id, _, _) _) -> li_ $ a_ [href_ $ "/#" <> id] (toHtmlRaw id))
readTemplate :: FilePath -> Task IO Template readTemplate :: FilePath -> Task IO Template
readTemplate src = readText src <&> parseTemplate >>= \case readTemplate src = readText src <&> parseTemplate >>= \case

113
src/Markdown.hs Normal file
View File

@ -0,0 +1,113 @@
module Markdown where
import Lucid
import Lucid.Base (makeElement)
import Data.Text (pack)
import Text.Pandoc.Builder
import Control.Monad (foldM)
import Data.Functor ((<&>))
import Data.Bifoldable (Bifoldable, bifoldMap, bifoldrM)
import Control.Monad.State.Strict
import Control.Monad.Identity
data MDState = MDState
{ stNoteCount :: Int -- count of notes that HAVE been printed
, stNotes :: [Html ()] -- notes that haven't be printed yet
, stLevel :: Int -- block depth
}
defaultMDState :: MDState
defaultMDState = MDState
{ stNoteCount = 0
, stNotes = []
, stLevel = 0
}
render :: Pandoc -> Html ()
render (Pandoc meta blocks) =
fst $ runIdentity $ runStateT (blocksToHtml blocks) defaultMDState
inlineToHtml :: Monad m => Inline -> StateT MDState m (Html ())
inlineToHtml (Str str) = pure $ toHtml str
inlineToHtml (Emph ins) = em_ <$> inlinesToHtml ins
inlineToHtml (Underline ins) = makeElement "u" <$> inlinesToHtml ins
inlineToHtml (Strong ins) = strong_ <$> inlinesToHtml ins
inlineToHtml (Strikeout ins) = makeElement "s" <$> inlinesToHtml ins
inlineToHtml (Superscript ins) = sup_ <$> inlinesToHtml ins
inlineToHtml (Subscript ins) = sub_ <$> inlinesToHtml ins
inlineToHtml (SmallCaps ins) = span_ [class_ "sc"] <$> inlinesToHtml ins
inlineToHtml (Quoted typ ins) =
let (l, r) = case typ of
SingleQuote -> ("‘", "’")
DoubleQuote -> ("“", "”")
in pure l >> inlinesToHtml ins >> pure r
inlineToHtml (Cite cits ins) = undefined -- TODO: citations
inlineToHtml (Code attrs str) = pure $ code_ $ toHtml str
inlineToHtml Space = pure " "
inlineToHtml SoftBreak = pure "\n"
inlineToHtml LineBreak = pure $ br_ []
inlineToHtml (Math _ math) = pure $ span_ [class_ "math"] $ toHtml math -- TODO: compile-time katex math
inlineToHtml (RawInline f str) | f == "html" = pure $ toHtmlRaw str
inlineToHtml (RawInline f str) = pure mempty
inlineToHtml (Link attrs ins (src, title)) = a_ [href_ src, title_ title] <$> inlinesToHtml ins
inlineToHtml (Image attrs ins (src, title)) = pure $ img_ [href_ src, title_ title] -- TODO: handle image alt
inlineToHtml (Note blocks) = do
MDState {..} <- get
let currentIdx = stNoteCount + length stNotes + 1
note <- blocksToHtml blocks
modify \s -> s { stNotes = note : stNotes }
pure $ a_ [href_ $ "#note" <> pack (show currentIdx)] $ "[" <> toHtml (show currentIdx) <> "]"
inlineToHtml (Span attrs ins) = span_ <$> inlinesToHtml ins
inlinesToHtml :: Monad m => [Inline] -> StateT MDState m (Html ())
inlinesToHtml = foldMapM inlineToHtml
blockToHtml :: Monad m => Block -> StateT MDState m (Html ())
blockToHtml (Plain ins) = pre_ <$> inlinesToHtml ins
blockToHtml (Para ins) = p_ <$> inlinesToHtml ins
blockToHtml (LineBlock ins) = undefined
blockToHtml (CodeBlock attrs code) = pure $ pre_ $ code_ $ toHtmlRaw code -- TODO: highlighting
blockToHtml (RawBlock f str) | f == "html" = pure $ toHtmlRaw str
blockToHtml (RawBlock f str) = pure mempty
blockToHtml (BlockQuote blocks) = blockquote_ <$> blocksToHtml blocks
blockToHtml (OrderedList attrs items) = ol_ <$> foldMapM (fmap li_ . blocksToHtml) items -- TODO: handle attrs
blockToHtml (BulletList items) = ul_ <$> foldMapM (fmap li_ . blocksToHtml) items
blockToHtml (DefinitionList items) =
dl_ <$> foldMapM (bifoldMapM inlinesToHtml (foldMapM (fmap dd_ . blocksToHtml))) items
blockToHtml (Header k attrs ins) = h_ k <$> inlinesToHtml ins -- TODO: handle attrs (especially ID)
where h_ :: Applicative m => Int -> HtmlT m a -> HtmlT m a
h_ 1 = h1_
h_ 2 = h2_
h_ 3 = h3_
h_ 4 = h4_
h_ 5 = h5_
h_ _ = h6_
blockToHtml HorizontalRule = pure $ hr_ []
blockToHtml (Table attrs caption _ head rows foot) = pure mempty
blockToHtml (Div attrs blocks) = pure mempty
blockToHtml Null = pure mempty
blocksToHtml :: Monad m => [Block] -> StateT MDState m (Html ())
blocksToHtml = fmap mconcat . mapM renderBlock
where renderBlock :: Monad m => Block -> StateT MDState m (Html ())
renderBlock block = do
modify \s -> s { stLevel = stLevel s + 1 }
html <- blockToHtml block
MDState {..} <- get
let printingNotes = not (null stNotes) && stLevel == 1
let notes = when printingNotes (ol_ [class_ "footnotes", start_ $ pack (show $ stNoteCount + 1)] $ foldMap li_ (reverse stNotes))
when printingNotes $ modify \s -> s {stNoteCount = stNoteCount + length stNotes, stNotes = [] }
modify \s -> s { stLevel = stLevel - 1 }
pure $ html <> notes
foldMapM :: (Monad m, Monoid w, Foldable t) => (a -> m w) -> t a -> m w
foldMapM f = foldM (\acc a -> do
w <- f a
return $! mappend acc w)
mempty
bifoldMapM :: (Monad m, Monoid w, Bifoldable t) => (a -> m w) -> (b -> m w) -> t a b -> m w
bifoldMapM f g = bifoldrM (\a b -> f a <&> (`mappend` b)) (\a b -> g a <&> (`mappend` b)) mempty