added custom markdown rendering
This commit is contained in:
parent
9f9e955524
commit
e7d62f6adf
Binary file not shown.
Binary file not shown.
|
|
@ -1,8 +1,20 @@
|
|||
:root {
|
||||
--large-width: 1080px;
|
||||
--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 {
|
||||
font-family: sans-serif;
|
||||
font-size: 14px;
|
||||
|
|
@ -15,13 +27,13 @@ body {
|
|||
line-height: 1.54;
|
||||
min-height: 100vh;
|
||||
background: #dce0df;
|
||||
grid-template: "a m e" 1fr
|
||||
grid-template: "a m m" 1fr
|
||||
". f f" / 180px 1fr 180px;
|
||||
gap: 2em;
|
||||
}
|
||||
|
||||
h1, h2, h3, nav a {
|
||||
font-family: monospace;
|
||||
font-family: var(--mono-font), monospace;
|
||||
font-weight: 500;
|
||||
text-transform: uppercase;
|
||||
letter-spacing: 0.1rem;
|
||||
|
|
@ -39,13 +51,6 @@ nav ul {
|
|||
padding: 0
|
||||
}
|
||||
|
||||
@media (max-width: 840px) {
|
||||
body {
|
||||
grid-template: "a" "m" 1fr "f";
|
||||
}
|
||||
nav {padding: 0}
|
||||
nav ul { position: static; }
|
||||
}
|
||||
|
||||
nav a {
|
||||
display: block;
|
||||
|
|
@ -74,11 +79,34 @@ ul {
|
|||
}
|
||||
|
||||
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 }
|
||||
|
||||
/* aside info */
|
||||
#contact + table {font-family: monospace}
|
||||
#contact + table {font-family: var(--mono-font), monospace}
|
||||
#contact + table td:first-child {
|
||||
padding-right: 1em;
|
||||
text-transform: uppercase;
|
||||
|
|
@ -95,7 +123,7 @@ main h2:first-child { margin-top: 0 }
|
|||
.pubs ul::before {
|
||||
content: attr(data-year);
|
||||
position: absolute;
|
||||
font-family: monospace;
|
||||
font-family: var(--mono-font), monospace;
|
||||
writing-mode: vertical-rl;
|
||||
text-orientation: upright;
|
||||
left: 0;
|
||||
|
|
@ -131,3 +159,43 @@ main h2:first-child { margin-top: 0 }
|
|||
}
|
||||
|
||||
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; }
|
||||
}
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
<meta name="robots" content="index, follow">
|
||||
<link rel="stylesheet" href="/assets/theme.css">
|
||||
<link rel="shortcut icon" type="image/svg" href="/assets/favicon.svg">
|
||||
<title>Lucas Escot</title>
|
||||
<title>{{ $title }}</title>
|
||||
</head>
|
||||
<body>
|
||||
<nav>{{ $nav }}</nav>
|
||||
|
|
|
|||
|
|
@ -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
|
||||
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).
|
||||
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}
|
||||
|
||||
------- ---------------------------------------
|
||||
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)
|
||||
GH [flupe](https://github.com/flupe)
|
||||
SRHT [flupe](https://sr.ht/~flupe)
|
||||
------- ---------------------------------------
|
||||
------- ------------------------------------------------------------------------------------------------
|
||||
|
||||
## Publications
|
||||
|
||||
```{=html}
|
||||
{{ $publications }}
|
||||
```
|
||||
|
|
|
|||
|
|
@ -10,6 +10,7 @@ executable escot
|
|||
hs-source-dirs: src
|
||||
other-modules: Config
|
||||
, Template
|
||||
, Markdown
|
||||
build-depends: base
|
||||
, filepath
|
||||
, achille
|
||||
|
|
@ -31,6 +32,7 @@ executable escot
|
|||
, process
|
||||
, directory
|
||||
, megaparsec
|
||||
, mtl
|
||||
default-extensions: BlockArguments
|
||||
, TupleSections
|
||||
, OverloadedStrings
|
||||
|
|
|
|||
76
src/Main.hs
76
src/Main.hs
|
|
@ -8,7 +8,9 @@ import Data.Aeson (FromJSON)
|
|||
import Data.Binary (Binary)
|
||||
import Control.Monad ((>=>))
|
||||
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.Maybe (fromJust)
|
||||
import Data.Yaml
|
||||
|
|
@ -26,11 +28,13 @@ import Achille
|
|||
import Achille.Writable (Writable)
|
||||
import Achille.Writable qualified as Writable
|
||||
import Achille.Internal.IO (AchilleIO)
|
||||
import Achille.Internal.IO qualified as AchilleIO
|
||||
import Achille.Task.Pandoc
|
||||
|
||||
import Template (Template, Context, parseTemplate)
|
||||
import Template qualified
|
||||
import Config (config, ropts, wopts, SiteConfig(title))
|
||||
import Markdown qualified
|
||||
|
||||
|
||||
-- Bibliography info
|
||||
|
|
@ -75,38 +79,88 @@ render template ctx body =
|
|||
KeyMap.insert "body" (String body) ctx
|
||||
& Template.render template
|
||||
|
||||
|
||||
-- writing Html to disk (efficiently)
|
||||
instance AchilleIO m => Writable m (Html ()) where
|
||||
write to = Writable.write to . renderBS
|
||||
|
||||
data Note = Note
|
||||
{ date :: UTCTime
|
||||
, title :: Text
|
||||
}
|
||||
deriving (Eq, Binary, Generic, FromJSON)
|
||||
|
||||
main = achille do
|
||||
index <- readTemplate "index.html"
|
||||
|
||||
match_ "assets/*" $ copyFile
|
||||
match_ "assets/*" copyFile
|
||||
match_ "papers/*" copyFile
|
||||
|
||||
match_ "static/*" $ copyFileAs (makeRelative "static/")
|
||||
match_ "papers/*" $ copyFile
|
||||
|
||||
pubs :: [Publication] <- matchFile "publications.yaml" parseYaml
|
||||
|
||||
watch pubs $ match_ "index.md" \src -> do
|
||||
(nav, index') <- matchFile "index.md" \src -> do
|
||||
doc <- readPandocWith def {readerExtensions = pandocExtensions} src
|
||||
|
||||
let Pandoc _ blocks = doc
|
||||
let headers = filter isHeaderBlock blocks
|
||||
|
||||
-- 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
|
||||
|
||||
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
|
||||
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 src = readText src <&> parseTemplate >>= \case
|
||||
|
|
|
|||
|
|
@ -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
|
||||
Loading…
Reference in New Issue