.github/workflows/build-container.yml

@@ -44,7 +44,7 @@ jobs:
         with:
           context: .
           push: true
-          tags: ghcr.io/pagwin2/psb:v1.1
+          tags: ghcr.io/pagwin2/psb:v1
           labels: ${{ steps.meta.outputs.labels }}
 
       - name: Build and push Docker image (latest)

TODO.md

@@ -1,12 +1,14 @@
-- [ ] add rst support and convert markdown handling to custom parser instead of pandoc
+- add rst support and convert markdown handling to custom parser instead of pandoc
 
-- [ ] process source code blocks with tree sitter https://hackage.haskell.org/package/tree-sitter
+- process source code blocks with tree sitter https://hackage.haskell.org/package/tree-sitter
     - Alternatively consider skylighting https://hackage.haskell.org/package/skylighting
 
-- [ ] minify js and css when copying over instead of just copying
+- minify js and css when copying over instead of just copying
 
-- [ ] setup fingerprinting in file names for css and js
+- setup fingerprinting in file names for css and js
 
-- [ ] dev server setup (with live reloading)
+- dev server setup (with live reloading)
 
--  [ ] see if performance can be improved (it isn't slow atm but it definitely feels like there's a bottleneck)
+- see if performance can be improved (it isn't slow atm but it definitely feels like there's a bottleneck)
+
+- look into adding postcss support perhaps

app/HTML.hs

@@ -2,7 +2,6 @@
 
 module HTML (compileToHTML) where
 
-import Data.Char (isAlphaNum, toLower)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import IR
@@ -20,23 +19,6 @@ escapeChar c = T.singleton c
 escapeText :: T.Text -> T.Text
 escapeText = T.concat . map escapeChar . T.unpack
 
-genHeaderId :: Heading -> T.Text
-genHeaderId header =
-  T.concat
-    [ " id=\"",
-      T.map (toLower . textSub) $
-        T.strip $
-          T.filter (\c -> isAlphaNum c || c == ' ') $
-            serializeInlineToHTML header.text,
-      "\" "
-    ]
-  where
-    textSub ' ' = '-'
-    textSub c = c
-
-genHeaderClasses :: Heading -> T.Text
-genHeaderClasses = const ""
-
 tshow :: (Show s) => s -> T.Text
 tshow = T.pack . show
 
@@ -44,7 +26,7 @@ compileToHTML :: Document -> T.Text
 compileToHTML (Doc elements) = T.concat $ map elementToHTML elements
 
 elementToHTML :: Element -> T.Text
-elementToHTML (Heading header) = T.concat ["<h", tshow header.level, genHeaderId header, genHeaderClasses header, ">", serializeInlineToHTML header.text, "</h", tshow header.level, ">"]
+elementToHTML (Heading header) = T.concat ["<h", tshow header.level, ">", serializeInlineToHTML header.text, "</h", tshow header.level, ">"]
 --
 elementToHTML (Code code_block) = T.concat ["<pre class=\"sourceCode ", language, "\"><code class=\"sourceCode ", language, "\">", escapeText code_block.code, "</code>", "</pre>"]
   where
@@ -76,6 +58,6 @@ serializeInlineToHTML (Bold elems : remaining) = T.concat ["<b>", serializeInlin
 serializeInlineToHTML (Italic elems : remaining) = T.concat ["<i>", serializeInlineToHTML elems, "</i>", serializeInlineToHTML remaining]
 serializeInlineToHTML (Crossed elems : remaining) = T.concat ["<s>", serializeInlineToHTML elems, "</s>", serializeInlineToHTML remaining]
 serializeInlineToHTML (InlineCode code : remaining) = T.concat ["<code>", escapeText code, "</code>", serializeInlineToHTML remaining]
-serializeInlineToHTML (Link {linkText, url, title} : remaining) = T.concat ["<a href=\"", url, "\"", maybe "" (\t -> T.concat ["title=\"", escapeText t, "\""]) title, ">", serializeInlineToHTML linkText, "</a>", serializeInlineToHTML remaining]
+serializeInlineToHTML (Link {linkText, url, title} : remaining) = T.concat ["<a href=\"", url, "\" ", maybe "" (\t -> T.concat ["title=\"", escapeText t, "\""]) title, "\">", serializeInlineToHTML linkText, "</a>", serializeInlineToHTML remaining]
 serializeInlineToHTML (Image {altText, url, title} : remaining) = T.concat ["<img src=\">", url, "\" alt=\"", escapeText altText, "\"", maybe "" (\t -> T.concat ["title=\"", escapeText t, "\""]) title, ">", serializeInlineToHTML remaining]
 serializeInlineToHTML (HTMLInline {inline_html_content} : remaining) = inline_html_content <> serializeInlineToHTML remaining

app/Markdown.hs

@@ -253,7 +253,7 @@ strongUnderscore = do
 crossedText :: Parser InlineText
 crossedText = do
   string "~~"
-  content <- some (notFollowedBy (string "~~") >> inlineElement)
+  content <- some (notFollowedBy (string "~~") >> inlineElementNo '~')
   string "~~"
   pure $ Crossed content
 
@@ -284,23 +284,35 @@ inlineElementNo c =
       try link,
       try htmlInline,
       try escapedChar,
-      plainTextNo [c]
+      plainTextNo c
     ]
 
-plainTextNo :: [Char] -> Parser InlineText
-plainTextNo disallow = do
-  firstChar <- noneOf disallow
-  remChars <- some $ plainTextCharNo disallow <* notFollowedBy lineEnding
-  pure $ Text $ T.map wspHandler $ T.pack $ firstChar : remChars
-  where
-    wspHandler '\n' = ' '
-    wspHandler c = c
+plainTextNo :: Char -> Parser InlineText
+plainTextNo c = fmap (Text . T.pack) $ some $ noneOf [c, '\n']
 
 inlineElementNoAsterisk :: Parser InlineText
-inlineElementNoAsterisk = inlineElementNo '*'
+inlineElementNoAsterisk =
+  choice
+    [ try strong,
+      try codeSpan,
+      try image,
+      try link,
+      try htmlInline,
+      try escapedChar,
+      plainTextNo '*'
+    ]
 
 inlineElementNoUnderscore :: Parser InlineText
-inlineElementNoUnderscore = inlineElementNo '_'
+inlineElementNoUnderscore =
+  choice
+    [ try strong,
+      try codeSpan,
+      try image,
+      try link,
+      try htmlInline,
+      try escapedChar,
+      plainTextNo '_'
+    ]
 
 -- Code Span
 codeSpan :: Parser InlineText
@@ -396,27 +408,29 @@ escapedChar = do
   pure $ Text (T.singleton c)
 
 -- Plain Text
+-- TODO: this eats stuff it shouldn't, inefficient solution is to try other inline elements and exit if they succeed
 plainText :: Parser InlineText
-plainText = plainTextNo []
+plainText = fmap (Text . T.pack) (liftA2 (:) (noneOf "\n") $ many plainTextChar)
 
-plainTextBaseDisallow :: [Char]
-plainTextBaseDisallow = "[~`_*<"
-
-plainTextCharNo :: [Char] -> Parser Char
-plainTextCharNo additional = noneOf $ additional <> plainTextBaseDisallow
+plainTextChar :: Parser Char
+plainTextChar = noneOf "\n[~`_*"
 
 plainTextNoAsterisk :: Parser InlineText
-plainTextNoAsterisk = plainTextNo "*"
+plainTextNoAsterisk = fmap (Text . T.pack) $ some $ noneOf "*\n"
 
 plainTextNoUnderscore :: Parser InlineText
-plainTextNoUnderscore = plainTextNo "_"
+plainTextNoUnderscore = fmap (Text . T.pack) $ some $ noneOf "_\n"
 
 plainTextNoBracket :: Parser InlineText
-plainTextNoBracket = plainTextNo "[]"
+plainTextNoBracket =
+  fmap (Text . T.pack) $
+    some $
+      satisfy
+        (`notElem` ("[]" :: String))
 
 -- Helper Parsers
 lineEnding :: Parser ()
-lineEnding = void $ count 2 (try (string "\r\n") <|> try (string "\n") <|> string "\r")
+lineEnding = void (try (string "\r\n") <|> try (string "\n") <|> string "\r")
 
 wsParser :: Parser ()
 wsParser = void $ some (char ' ' <|> char '\t')