About this Website

module Main where

import System.Directory (listDirectory, createDirectoryIfMissing, doesDirectoryExist, copyFile)
import System.FilePath (joinPath)
import Control.Monad ((>=>))
import Data.List (partition)
import Data.Tuple.Extra (both)

import Parser (runParser, contentSlug, renderOutputWithTemplate, contentExtension, contentPath)
import Directives (directiveRunner, singleton)

import Config

listDirWithPath dir = map (joinPath . (dir :) . singleton) <$> listDirectory dir

handlePage :: String -> IO ()
handlePage filename = do
  contents <- readFile filename
  case runParser directiveRunner contents filename of
    Left err -> putStrLn ("error in " ++ filename ++ ": " ++ err)
    Right ps -> do
      case contentPath ps of
        Just path -> do
          let outputPath = joinPath [rootOutputDir, path]
          output <- renderOutputWithTemplate ps templateFile
          writeFile outputPath output
        Nothing -> putStrLn ("path not specified in " ++ filename)

handleStaticFile :: String -> IO ()
handleStaticFile path = do
  copyFile path $ joinPath [rootOutputDir, path]

findAllSubfiles :: String -> IO [String]
findAllSubfiles path = do
  contents <- listDirWithPath path
  taggedContents <- mapM (\path -> do
      isDir <- doesDirectoryExist path
      return (isDir, path)
    ) contents
  let (folders, thisFiles) = both (map snd) $ partition fst taggedContents
  otherFiles <- concat <$> mapM findAllSubfiles folders
  return $ thisFiles ++ otherFiles

main :: IO ()
main = do
  createDirectoryIfMissing True rootOutputDir
  createDirectoryIfMissing True postsDir
  createDirectoryIfMissing True $ joinPath [rootOutputDir, staticInDir]

  findAllSubfiles staticInDir >>= mapM_ handleStaticFile

  allContent <- findAllSubfiles contentDir
  mapM_ handlePage allContent

module Config where

import System.FilePath (joinPath)

contentDir = "content"
postsDir = joinPath [contentDir, "posts"]
rootOutputDir = "generated"
templateFile = "template.html"
staticInDir = "static"
pageOutDir = "p"

module Directives where
import Data.List (stripPrefix)

import Parser (Parser, parseError, consumeChar, emitText, emitFragment, setRuntimeVar, setVarFirstTime, getRuntimeVar, emitNonText, closeParagraph, peekChar, parse, captureParseOutput, emitFragments, isVarTrue, addFootnote, listFoonotes, ParserState (footnotes), SubParseOption (NoParagraphs, DoParagraphsAndReset, DoParagraphs))
import PostProcessor (Fragment(..))
import GHC.TypeLits (ErrorMessage(Text))
import Control.Monad (when, unless)
import System.FilePath (joinPath)
import Config (staticInDir, pageOutDir)

singleton = (: [])

knownLanguages = ["ts"]

matchClosingChar '`' = Just '`'
matchClosingChar '{' = Just '}'
matchClosingChar '[' = Just ']'
matchClosingChar '#' = Just '#'
matchClosingChar _ = Nothing

justOrParseError errMsg (Just x) = return x
justOrParseError errMsg Nothing = parseError errMsg

readMiddleOfBlock :: Char -> Parser String
readMiddleOfBlock closingChar = do
  c <- consumeChar >>= justOrParseError "unexpected end of file"
  if c == closingChar then
    return ""
  else do
    rest <- readMiddleOfBlock closingChar
    return $ c : rest

readBlock :: Parser String
readBlock = do
  openingChar <- consumeChar
  closingChar <- justOrParseError
    "unknown closing char"
    (openingChar >>= matchClosingChar)
  readMiddleOfBlock closingChar

readAndEvalBlockMiddle :: Char -> SubParseOption -> Parser [Fragment]
readAndEvalBlockMiddle closingChar doParagraphs = do
  let shouldExit = (== closingChar) <$> (peekChar >>= justOrParseError "unexpected end of file")
  output <- captureParseOutput doParagraphs $ parse shouldExit
  c <- consumeChar >>= justOrParseError "unexpected end of file"
  if c /= closingChar then
    parseError $ "expected closing char " ++ [c]
  else
    return output

readBlockAndEval :: SubParseOption -> Parser [Fragment]
readBlockAndEval doParagraphs = do
  openingChar <- consumeChar
  closingChar <- justOrParseError
    "unknown closing char"
    (openingChar >>= matchClosingChar)
  readAndEvalBlockMiddle closingChar doParagraphs

wrapTextBlockWithTag tag block = do
  emitText "<"
  emitText tag
  emitText ">"
  emitFragments block
  emitText "</"
  emitText tag
  emitText ">"

wrapNonTextBlockWithTag tag block = do
  emitFragment $ TextOutput "<"
  emitFragment $ TextOutput tag
  emitFragment $ TextOutput ">"
  emitFragments block
  emitFragment $ TextOutput "</"
  emitFragment $ TextOutput tag
  emitFragment $ TextOutput ">"

replace s (old, new) = case stripPrefix old s of
  Just rest -> new ++ replace rest (old, new)
  Nothing -> case s of
    c:rest -> c : replace rest (old, new)
    [] -> []

attributeQuoteSubstitutions = [("&", "&amp;"), ("<", "&lt;"), ("\"", "&quot;")]

quoteAttribute attrName attrValue =
    attrName
    ++ "=\""
    ++ foldr (flip replace) attrValue attributeQuoteSubstitutions
    ++ "\""

wrapBlockWithAttributes :: (String -> Parser ()) -> String -> [(String, String)] -> [Fragment] -> Parser ()
wrapBlockWithAttributes emitter tag attributes block = do
  emitter "<"
  emitter tag
  emitter (if null attributes then "" else " ")
  emitter $ unwords $ map (uncurry quoteAttribute) attributes
  emitter ">"
  emitFragments block
  emitter "</"
  emitter tag
  emitter ">"

wrapTextTagSimple tag = readBlockAndEval NoParagraphs >>= wrapTextBlockWithTag tag
wrapNonTextTagSimple tag = readBlockAndEval NoParagraphs >>= wrapNonTextBlockWithTag tag

directiveRunner :: String -> Parser ()

directiveRunner "title" = do
  block <- readBlock
  wrapNonTextBlockWithTag "h1" [TextOutput block]
  setVarFirstTime "title" block

directiveRunner "h2" = wrapNonTextTagSimple "h2"
directiveRunner "h3" = wrapNonTextTagSimple "h3"
directiveRunner "emphasis" = wrapTextTagSimple "em"

directiveRunner "posted-date" = do
  readBlock >>= wrapBlockWithAttributes emitNonText "div" [("id", "posted-date")] . singleton . TextOutput

directiveRunner "blurb" = do
  block <- readBlockAndEval DoParagraphsAndReset
  wrapBlockWithAttributes emitNonText "div" [("id", "blurb")] block

directiveRunner "maths" = do
  code <- readBlock
  setRuntimeVar "needs-mathjax" "true"
  let wrapped = "\\(" ++ code ++ "\\)"
  wrapBlockWithAttributes emitText "span" [("class", "mathjax")] [TextOutput wrapped]

directiveRunner "slug" = do
  block <- readBlock
  setVarFirstTime "slug" block

directiveRunner "code-block" = do
  closeParagraph
  langName <- readBlock
  code <- readBlock
  emitFragment $ BlockCodeOutput langName code
  unless (langName == "txt") $ setRuntimeVar "needs-higlighting-css" "true"

directiveRunner "read_var_nontext" = do
  varName <- readBlock
  varVal <- getRuntimeVar varName >>= justOrParseError "undefined variable"
  emitNonText varVal

directiveRunner "read_var_text" = do
  varName <- readBlock
  varVal <- getRuntimeVar varName >>= justOrParseError "undefined variable"
  emitText varVal

directiveRunner "wiki_link" = do
  pageName <- readBlock
  linkText <- readBlockAndEval NoParagraphs
  wrapBlockWithAttributes emitText "a" [("href", "https://en.wikipedia.org/wiki/" ++ pageName)] linkText

directiveRunner "link" = do
  pageName <- readBlock
  linkText <- readBlockAndEval NoParagraphs
  wrapBlockWithAttributes emitText "a" [("href", pageName)] linkText

directiveRunner "if_var" = do
  name <- readBlock
  block <- readBlockAndEval NoParagraphs
  isTrue <- isVarTrue name
  when isTrue $ emitFragments block

directiveRunner "at" = do
  block <- readBlock
  emitNonText "@"
  unless (null block) (parseError "non-empty param to at")

directiveRunner "no_p" = do
  block <- readBlockAndEval NoParagraphs
  emitFragments block

directiveRunner "type" = do
  block <- readBlock
  case block of
    "post" -> setVarFirstTime "outputDir" pageOutDir
    _ -> parseError ("unknown type " ++ block)

directiveRunner "index" = do
  block <- readBlock
  setVarFirstTime "outputDir" block
  setVarFirstTime "slug" "index"

directiveRunner "static_file" = do
  filename <- readBlock
  emitNonText $ "/" ++ staticInDir ++ "/" ++ filename


directiveRunner "rem" = do
  readBlock
  return ()

directiveRunner "ref_post" = do
  postSlug <- readBlock
  emitNonText $ "/" ++ pageOutDir ++ "/" ++ postSlug

directiveRunner "hs_quine" = do
  closeParagraph
  emitFragment QuineOutputFragment
  setRuntimeVar "needs-higlighting-css" "true"

directiveRunner "cat_file" = do
  closeParagraph
  langName <- readBlock
  filename <- readBlock
  emitFragment $ CatFileOutput langName filename

directiveRunner "highlighting_css" = do
  emitFragment HighlightingCSS

directiveRunner "footnote" = do
  footnoteName <- readBlock

  setRuntimeVar "current-footnote" footnoteName
  footnoteContents <- readBlockAndEval DoParagraphsAndReset
  newCurrent <- getRuntimeVar "current-footnote"
  unless (concat newCurrent == "") $ parseError "no footnote return!"

  footnoteNum <- addFootnote footnoteName footnoteContents
  emitText $
    "<sup class=\"footnote\"><a href=\"#footnote--"
    ++ footnoteName
    ++ "\" id=\"footnote-ret--"
    ++ footnoteName
    ++ "\">[" ++ show footnoteNum ++ "]</a></sup>"

directiveRunner "footnote_output" = do
  footnotes <- listFoonotes
  unless (null footnotes) (do
    emitNonText "<hr/><h2>Footnotes</h2><div id=\"footnote-output\"><ol>"
    sequence_ [
      do
        emitNonText $ "<li id=\"footnote--" ++ fst footnote ++ "\">"
        emitFragments $ snd footnote
        emitNonText "</li>"
      | footnote <- reverse footnotes
      ]
    emitNonText "</ol></div>"
    )

directiveRunner "footnote_ret" = do
  current <- concat <$> getRuntimeVar "current-footnote"
  when (current == "") $ parseError "no footnote to return from!"
  emitNonText $ "<a href=\"#footnote-ret--" ++ current ++ "\">↩</a>"
  setRuntimeVar "current-footnote" ""

directiveRunner s
 | s `elem` knownLanguages = do
    block <- readBlock
    emitText ""
    emitFragment (InlineCodeOutput s block)
    unless (s == "txt") $ setRuntimeVar "needs-higlighting-css" "true"
 | otherwise = parseError $ "unknown directive: " ++ s

module Parser where

import Control.Monad
import Data.Char (isLetter, isDigit, toLower, isSpace)
import qualified Data.Map.Strict as Map

import PostProcessor (renderFragments, Fragment(..))
import System.FilePath (joinPath)

type VarMap = Map.Map String String

data ParserState = ParserState {
    stateSource :: String, stateOutput :: [Fragment],
    lineNum :: Int, colNum :: Int, runtimeVars :: VarMap,
    stateDirectiveRunner :: DirectiveRunner,
    stateFilename :: String, isInParagraph :: Bool,
    footnotes :: [(String, [Fragment])]
  }
newtype Parser a = Parser (ParserState -> Either String (ParserState, a))
type DirectiveRunner = String -> Parser ()

data SubParseOption = NoParagraphs | DoParagraphs | DoParagraphsAndReset deriving (Eq)

instance Monad Parser where
  return x = Parser (\ps -> Right (ps, x))
  (Parser a) >>= f = Parser (\ps -> case a ps of
      Left err -> Left err
      Right (ps', v) -> let Parser b = f v in b ps'
    )

instance Applicative Parser where
  pure = return
  (<*>) = ap

instance Functor Parser where
  fmap = ap . pure

source :: Parser String
source = Parser (\ps -> Right (ps, stateSource ps))

advanceParserPos :: Char -> ParserState -> ParserState
advanceParserPos '\n' ps = ps { lineNum = 1 + lineNum ps, colNum = 1 }
advanceParserPos _ ps = ps { colNum = 1 + colNum ps }

consumeChar :: Parser (Maybe Char)
consumeChar = Parser (\ps -> Right (case stateSource ps of
   [] -> (ps, Nothing)
   c : s -> (advanceParserPos c $ ps { stateSource = s }, Just c)
  ))


tryRemoveFragment :: Fragment -> Parser Bool
tryRemoveFragment frag = Parser (\ps -> Right (case stateOutput ps of
    f:fs -> if f == frag then (ps { stateOutput = fs }, True) else (ps, False)
    _ -> (ps, False)
  ))

isAtParagraphBreak :: Parser Bool
isAtParagraphBreak = do
  auto <- parserShouldAutoParagraph
  Parser (\ps -> Right (case stateSource ps of
    '\n':'\n':cs -> (ps, auto && isInParagraph ps)
    _ -> (ps, False)
    ))

peekChar :: Parser (Maybe Char)
peekChar = Parser (\ps -> Right (case stateSource ps of
   [] -> (ps, Nothing)
   c : s -> (ps, Just c)
  ))

emitFragment :: Fragment -> Parser ()
emitFragment fragment = Parser (\ps -> Right (
    ps { stateOutput = fragment : stateOutput ps }, ())
  )

addFootnote :: String -> [Fragment] -> Parser Int
addFootnote name fragments = Parser (\ps -> Right (
    ps { footnotes = (name, fragments) : footnotes ps }, length (footnotes ps) + 1)
  )

listFoonotes :: Parser [(String, [Fragment])]
listFoonotes = Parser (\ps -> Right (ps, footnotes ps))

parseIsInParagraph = Parser (
  \ps -> Right (ps, isInParagraph ps)
  )

parseSetIsInParagraph b = do
  auto <- parserShouldAutoParagraph
  Parser (
    \ps -> Right (ps { isInParagraph = b }, ())
    )

emitNonText = emitFragment . TextOutput

emitText s = do
  autoOpenParagraph <- parserShouldAutoParagraph
  needsToOpenParagraph <- not <$> parseIsInParagraph
  when (needsToOpenParagraph && autoOpenParagraph) $ do
    emitFragment $ TextOutput "<p>"
    parseSetIsInParagraph True
  emitNonText s

emitFragments :: [Fragment] -> Parser ()
emitFragments fragments = do
  autoOpenParagraph <- parserShouldAutoParagraph
  needsToOpenParagraph <- not <$> parseIsInParagraph
  -- when (needsToOpenParagraph && autoOpenParagraph) $ do
  --   emitFragment $ TextOutput "<p>"
  --   parseSetIsInParagraph True
  mapM_ emitFragment (reverse fragments)


parseError :: String -> Parser a
parseError err = Parser (
  \ps -> Left $
    "Parse error at "
    ++ stateFilename ps 
    ++ ":" ++ show (lineNum ps)
    ++ ":" ++ show (colNum ps)
    ++ ": " ++ err
  )

getParsePos :: Parser String
getParsePos = Parser (
  \ps -> Right (ps, show (lineNum ps) ++ ":" ++ show (colNum ps))
  )

setParseOutput :: [Fragment] -> Parser ()
setParseOutput output = Parser (\ps -> Right (ps { stateOutput = output }, ()))

getParseOutput :: Parser [Fragment]
getParseOutput = Parser (\ps -> Right (ps, stateOutput ps))

captureParseOutput :: SubParseOption -> Parser () -> Parser [Fragment]
captureParseOutput doParagraphs p = do
  originalOutput <- getParseOutput
  oldShouldDoParagraphs <- parserShouldAutoParagraph
  setParserShouldAutoParagraph (doParagraphs /= NoParagraphs)
  isInParagraph <- parseIsInParagraph
  when (doParagraphs == DoParagraphsAndReset) (parseSetIsInParagraph False)
  setParseOutput []
  p
  subOutput <- getParseOutput
  setParseOutput originalOutput
  setParserShouldAutoParagraph oldShouldDoParagraphs
  parseSetIsInParagraph isInParagraph
  return subOutput

getDirectiveRunner :: Parser DirectiveRunner
getDirectiveRunner = Parser (
  \ps -> Right (ps, stateDirectiveRunner ps)
  )

parseDirective :: Parser String
parseDirective = do
  c <- peekChar
  case c of
    Nothing -> return ""
    Just c' | isLetter c' || isDigit c' || c' == '_' || c' == '-' -> do
      consumeChar
      rest <- parseDirective
      return $ c' : rest
    Just c' | otherwise -> return ""

closeParagraph :: Parser ()
closeParagraph = do
  inParagraph <- parseIsInParagraph
  auto <- parserShouldAutoParagraph
  s <- source
  when (inParagraph && auto) (do
    -- removed <- tryRemoveFragment (TextOutput "<p>")
    -- unless removed do
    --     emitFragment $ TextOutput "</p>\n"
    --     parseSetIsInParagraph False
    --   )
    -- )
      emitFragment $ TextOutput "</p>\n"
      parseSetIsInParagraph False
    )

parse :: Parser Bool -> Parser ()
parse shouldExit = do
  needsToExit <- shouldExit

  if needsToExit then closeParagraph else do
    newParagraph <- isAtParagraphBreak

    if newParagraph then do
      consumeChar
      consumeChar
      closeParagraph
      parse shouldExit
    else do
      c <- consumeChar

      case c of
        Nothing -> closeParagraph
        Just '@' -> do
          directive <- parseDirective
          directiveRunner <- getDirectiveRunner
          directiveRunner directive
          parse shouldExit
        Just c' -> do
          (if isSpace c' then emitNonText else emitText) [c']
          parse shouldExit

initialParseState source filename runner = ParserState {
    stateSource = source, stateOutput = [], lineNum = 1, colNum = 1,
    runtimeVars = Map.fromList [("auto-paragraph", "true")], stateDirectiveRunner = runner,
    stateFilename = filename, isInParagraph = False, footnotes = []
  }

contentSlug :: ParserState -> Maybe String
contentSlug ps = Map.lookup "slug" (runtimeVars ps)

contentPath :: ParserState -> Maybe String
contentPath ps = do
  slug <- Map.lookup "slug" (runtimeVars ps)
  outputDir <- Map.lookup "outputDir" (runtimeVars ps)
  return $ joinPath [outputDir, slug ++ "." ++ contentExtension ps]

renderAsFragments :: ParserState -> IO String
renderAsFragments = renderFragments . reverse . stateOutput

renderOutputWithTemplate :: ParserState -> String -> IO String
renderOutputWithTemplate ps templateFilename = do
  contentString <- renderAsFragments ps
  templateSource <- readFile templateFilename
  let extraVars = Map.fromList [("content", contentString), ("auto-paragraph", "false")]
  case runParserFromOldState ps templateSource templateFilename extraVars of
    Left err -> error $ "error running template: " ++ err
    Right ps' -> renderAsFragments ps'

contentExtension :: ParserState -> String
contentExtension ps = "html"

setRuntimeVar :: String -> String -> Parser ()
setRuntimeVar var val = Parser (\ps -> Right (
    ps { runtimeVars = Map.insert var val (runtimeVars ps) }, ())
  )

getRuntimeVar :: String -> Parser (Maybe String)
getRuntimeVar var = Parser (\ps -> Right (
    ps, Map.lookup var (runtimeVars ps))
  )

isVarTrue var = do
  val <- getRuntimeVar var
  return $ case val of
    Nothing -> False
    Just s -> map toLower s `elem` ["yes", "true", "y", "t"]

parserShouldAutoParagraph = isVarTrue "auto-paragraph"

setParserShouldAutoParagraph b =
  setRuntimeVar "auto-paragraph" (if b then "true" else "false")

setVarFirstTime :: String -> String -> Parser ()
setVarFirstTime var val = do
  previous <- getRuntimeVar var
  case previous of
    Nothing -> setRuntimeVar var val
    Just s -> parseError ("variable already set: " ++ var)

runParser :: DirectiveRunner -> String -> String -> Either String ParserState
runParser directiveRunner source filename = case runParser $ initialParseState source filename directiveRunner of
    Left err -> Left err
    Right (state, _) -> Right state
  where Parser runParser = parse (return False)

runParserFromOldState :: ParserState -> String -> String -> VarMap -> Either String ParserState
runParserFromOldState oldState source filename extraVars =
  let initialState = (initialParseState source filename (stateDirectiveRunner oldState)) {
      runtimeVars = extraVars `Map.union` runtimeVars oldState
    }
  in case runParser initialState of
      Left err -> Left err
      Right (state, _) -> Right state
    where Parser runParser = parse (return False)

module PostProcessor where

import System.Process (proc, readCreateProcessWithExitCode, shell)

import Data.Char (ord)
import System.Exit (ExitCode(ExitSuccess))

type SyntaxLanguage = String

data Fragment =
    TextOutput String
  | InlineCodeOutput SyntaxLanguage String
  | BlockCodeOutput SyntaxLanguage String
  | QuineOutputFragment
  | CatFileOutput SyntaxLanguage String
  | HighlightingCSS
  deriving (Eq)

postprocesserPath = "./post_processor.py"

showStrAsOrdArray :: String -> String
showStrAsOrdArray = show . map ord

tryQuickConcat :: [Fragment] -> Maybe String
tryQuickConcat [] = Just ""
tryQuickConcat ((TextOutput s) : fs) = (s ++) <$> tryQuickConcat fs
tryQuickConcat _ = Nothing

combineTextFragments :: [Fragment] -> [Fragment]
combineTextFragments (f1@(TextOutput s1) : fs) = case combineTextFragments fs of
  (TextOutput s2) : fs' -> TextOutput (s1 ++ s2) : fs'
  f2 : fs' -> f1 : f2 : fs'
  [] -> [f1]
combineTextFragments (f : fs) = f : combineTextFragments fs
combineTextFragments [] = []

buildRequest :: Fragment -> String
buildRequest (TextOutput s) = "raw " ++ showStrAsOrdArray s
buildRequest (InlineCodeOutput lang s) = "inline " ++ lang ++ " " ++ showStrAsOrdArray s
buildRequest (BlockCodeOutput lang s) = "block " ++ lang ++ " " ++ showStrAsOrdArray s
buildRequest QuineOutputFragment = "quine []"
buildRequest (CatFileOutput lang filename) = "cat_file " ++ lang ++ " " ++ showStrAsOrdArray filename
buildRequest HighlightingCSS = "highlighting_css []"

renderFragments :: [Fragment] -> IO String
renderFragments fragments = case tryQuickConcat fragments of
  Just s -> return s
  Nothing -> do
    let request = unlines $ map buildRequest $ combineTextFragments fragments
    let createProcess = proc postprocesserPath []
    (exitCode, stdout, stderr) <- readCreateProcessWithExitCode createProcess request
    if exitCode /= ExitSuccess || (not . null) stderr then
      error $ "Failed to post-process: " ++ stderr
    else
      return stdout

#!/usr/bin/env python3

import sys
import json
import os

from pygments import highlight
from pygments.lexers import PythonLexer, HaskellLexer, TypeScriptLexer, TextLexer
from pygments.formatters import HtmlFormatter

def escape(s): return s.replace('&', '&amp;').replace('<', '&lt;')

# yes there's a dedicated pygments functions for this but oh well...
associations = {
    'py': PythonLexer,
    'hs': HaskellLexer,
    'ts': TypeScriptLexer,
    'txt': TextLexer
}

def read_file(filename):
    with open(filename) as file: return file.read()


def render_block(lang, code, is_block=True):
    num_lines = len(code.split('\n')) + 10
    scaling = 1 + 1.5 / num_lines
    if is_block:
        formatter = HtmlFormatter(
            cssclass="highlight code",
            cssstyles=f"--div-code-hover-resize-scale: {scaling}"
        )
    else:
        formatter = HtmlFormatter(nowrap=True)
    return highlight(code.strip(), associations[lang](), formatter)

def output_quine(buffer):
    POST_PROCESSOR = 'post_processor.py'
    RENDERER_DIR = 'renderer'

    all_files = []
    for filename in os.listdir(RENDERER_DIR):
        assert filename.endswith('.hs')
        all_files.append((
            filename, 'hs',
            read_file(os.path.join(RENDERER_DIR, filename))
        ))

    all_files.append((POST_PROCESSOR, 'py', read_file(POST_PROCESSOR)))
    all_files.sort(
        key=lambda f: ' ' if f[0] == 'Main.hs' else f[0]
    )

    for filename, lang, contents in all_files:
        print(f"<h2>{escape(filename)}</h2>")
        print(render_block(lang, contents, True))


for line in sys.stdin:
    cmd, *args, data = line.split(' ')
    data = ''.join(map(chr, json.loads(data)))

    cleaned_up = escape(data)

    if cmd == 'raw':
        print(end=data)
    elif cmd == 'inline':
        print(
            '<span class="highlight code">',
            render_block(args[0], data, False).strip(),
            '</span>',
            sep='', end=''
        )
    elif cmd == 'block':
        print(render_block(args[0], data, True))
    elif cmd == 'quine':
        buffer = []
        output_quine(buffer)
        print(''.join(buffer))
    elif cmd == 'cat_file':
        print(render_block(args[0], read_file(data), True))
    elif cmd == 'highlighting_css':
        print('*/', HtmlFormatter().get_style_defs('.highlight'), '/*')
    else:
        print("unknown command", cmd, file=sys.stderr)
        sys.exit(1)

@title{About this Website}
@slug{quine}
@type{post}

The web pages on this wbesite have been written in a strange markup language which I made. The HTML is rendered statically by some poorly designed Haskell, here's the source code (it's too ugly to post anywhere but here):

@hs_quine

@h2{Source Code of This Page}
And now just for fun, here's the source code of this page which you're reading right now.

@cat_file[txt]`content/posts/quine.txt`

Well that's weird.