diff --git a/content/assets/Asanb.woff2 b/content/assets/Asanb.woff2
new file mode 100644
index 0000000..606fb6d
Binary files /dev/null and b/content/assets/Asanb.woff2 differ
diff --git a/content/assets/mononoki-Regular.woff2 b/content/assets/mononoki-Regular.woff2
new file mode 100644
index 0000000..63ecf58
Binary files /dev/null and b/content/assets/mononoki-Regular.woff2 differ
diff --git a/content/assets/theme.css b/content/assets/theme.css
index d600025..cd39755 100755
--- a/content/assets/theme.css
+++ b/content/assets/theme.css
@@ -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; }
+}
diff --git a/content/index.html b/content/index.html
index fac4a05..da8b6af 100644
--- a/content/index.html
+++ b/content/index.html
@@ -7,7 +7,7 @@
- Lucas Escot
+ {{ $title }}
diff --git a/content/index.md b/content/index.md
index 4996759..da4830d 100755
--- a/content/index.md
+++ b/content/index.md
@@ -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 }}
+```
diff --git a/escot.cabal b/escot.cabal
index f9e618a..18447f6 100755
--- a/escot.cabal
+++ b/escot.cabal
@@ -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
diff --git a/src/Main.hs b/src/Main.hs
index 4a1a868..1acb9d5 100755
--- a/src/Main.hs
+++ b/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
diff --git a/src/Markdown.hs b/src/Markdown.hs
new file mode 100644
index 0000000..4d6d2e0
--- /dev/null
+++ b/src/Markdown.hs
@@ -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