started on Djot implementation

TODO.md

@@ -1,3 +1,7 @@
+- [ ] Add DJOT as an alternate syntax
+    - [ ] Change auto id/section link logic to match djot spec
+    - [ ] Add in functionality for footnotes
+        - There should be a per footnote template as well and also either the default or post template should have an attribute which handles footnotes
 - [ ] process source code blocks to syntax highlight them
     - skylighting https://hackage.haskell.org/package/skylighting
         - More boring therefore more better
@@ -7,9 +11,6 @@
 - [ ] setup font subsetting (font file minimization)
     - `pyftsubset` (`fonttools subset`) is an external tool I can and probably should use for this
 - [ ] Fix time via timestamps potentially meaning something (via preshim?) and use local offset instead of absolute time https://www.rfc-editor.org/rfc/rfc3339#section-4.2
-- [ ] Add DJOT as an alternate syntax
-    - [ ] Add in functionality for footnotes
-        - There should be a per footnote template as well and also either the default or post template should have an attribute which handles footnotes
 - [ ] dev server setup (with live reloading)
     - https://hackage-content.haskell.org/package/warp-3.4.10
     - https://hackage.haskell.org/package/file-embed

psb.cabal

@@ -27,7 +27,7 @@ common warnings
 
 library
     hs-source-dirs: src
-    exposed-modules: Markdown HTML Logger IR Logger.Shake Psb.Main Utilities Utilities.FilePath Utilities.Action Utilities.Javascript Utilities.CSS Templates Types Config Utilities.Bundling
+    exposed-modules: Djot Markdown HTML Logger IR Logger.Shake Psb.Main Utilities Utilities.FilePath Utilities.Action Utilities.Javascript Utilities.CSS Templates Types Config Utilities.Bundling
     other-modules: Utilities.Parsing
     build-depends:    base, mustache >=2.4.2, shake >= 0.19.8, deriving-aeson >= 0.2.9, aeson, text >= 2.1.2, time, unordered-containers, yaml, megaparsec >= 9.7.0, transformers >= 0.6.2, bytestring
     default-extensions: ApplicativeDo DataKinds NamedFieldPuns DerivingVia LambdaCase TypeApplications DeriveGeneric OverloadedRecordDot NamedFieldPuns DuplicateRecordFields DisambiguateRecordFields FlexibleInstances

src/Djot.hs

@@ -0,0 +1,110 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Djot
+  ( document,
+    metadata,
+  )
+where
+
+import Control.Applicative (many, some, (<|>))
+import Control.Monad.Trans.Accum (accum)
+import Data.Functor (void, (<$>), (<&>))
+import Data.Text (Text)
+import qualified Data.Text as T
+import IR
+import Logger (Logger (logCallStack, logDebug))
+import Text.Megaparsec (MonadParsec (lookAhead, notFollowedBy, try), anySingle, choice, manyTill, sepBy)
+import Text.Megaparsec.Char (char, newline, space, string)
+import Utilities.Parsing
+
+(.>) :: (a -> b) -> (b -> c) -> a -> c
+(.>) = flip (.)
+
+metadata :: (Logger m, Characters s) => Parser s m Text
+metadata = T.pack <$> many (notFollowedBy (string "---") *> anySingle)
+
+document :: (Logger m, Characters s) => Parser s m Document
+document = Doc <$> blockElement mempty `sepBy` blockSeparator
+
+blockElement :: (Logger m, Characters s) => Attrs -> Parser s m Element
+-- skip is for blockQuote to allow
+blockElement accumulated_attributes =
+  choice
+    [ lookAhead (char '#') *> header accumulated_attributes,
+      lookAhead (char '>') *> blockQuote accumulated_attributes,
+      lookAhead listMarker
+        *> (lookAhead taskMarker *> taskListBlock accumulated_attributes)
+        <|> listBlock accumulated_attributes,
+      lookAhead codeFence
+        *> (lookAhead rawLang *> rawBlock accumulated_attributes)
+        <|> codeBlock accumulated_attributes,
+      -- Why lookAhead when checking is fully equivalent to parsing
+      try $ thematicBreak accumulated_attributes,
+      lookAhead (string ":::") *> containerBlock accumulated_attributes,
+      lookAhead tableRow *> tableBlock accumulated_attributes,
+      lookAhead (char '[')
+        *> (lookAhead (char '^') *> footnoteDefinition accumulated_attributes)
+        <|> referenceDef accumulated_attributes,
+      lookAhead (char '{') *> blockAttribute accumulated_attributes,
+      paragraph accumulated_attributes
+    ]
+  where
+    rawLang = space *> char '=' *> some (notFollowedBy newline *> anySingle)
+    taskMarker = void $ char '[' *> choice (map char " xX") *> char ']'
+
+header :: (Logger m, Characters s) => Attrs -> Parser s m Element
+header = error "todo"
+
+blockQuote :: (Logger m, Characters s) => Attrs -> Parser s m Element
+blockQuote = error "todo"
+
+listBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
+listBlock = error "todo"
+
+listMarker :: (Logger m, Characters s) => Parser s m ListType
+listMarker = error "todo"
+
+codeFence :: (Logger m, Characters s) => Parser s m ()
+codeFence = void $ string "```"
+
+codeBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
+codeBlock = error "todo"
+
+paragraph :: (Logger m, Characters s) => Attrs -> Parser s m Element
+paragraph = error "todo"
+
+blockAttribute :: (Logger m, Characters s) => Attrs -> Parser s m Element
+blockAttribute attrs = blockAttribute' <&> (attrs <>) >>= blockElement <|> error "eof handle"
+
+blockAttribute' :: (Logger m, Characters s) => Parser s m Attrs
+blockAttribute' = error "todo"
+
+blockSeparator :: (Logger m, Characters s) => Parser s m ()
+blockSeparator = void $ newline *> newline
+
+taskListBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
+taskListBlock = error "todo"
+
+referenceDef :: (Logger m, Characters s) => Attrs -> Parser s m Element
+referenceDef = error "todo"
+
+rawBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
+rawBlock = error "todo"
+
+thematicBreak :: (Logger m, Characters s) => Attrs -> Parser s m Element
+thematicBreak = error "todo"
+
+containerBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
+containerBlock = error "todo"
+
+tableBlock :: (Logger m, Characters s) => Attrs -> Parser s m Element
+tableBlock = error "todo"
+
+tableRow :: (Logger m, Characters s) => Parser s m Element
+tableRow = error "todo"
+
+footnoteDefinition :: (Logger m, Characters s) => Attrs -> Parser s m Element
+footnoteDefinition = error "todo"

src/IR.hs

@@ -1,5 +1,6 @@
 module IR where
 
+import Control.Applicative ((<|>))
 import Data.Text
 
 newtype Document = Doc [Element]
@@ -23,6 +24,7 @@ data Element
   | DescriptionList DescriptionList Attrs
   | RawBlock RawBlock Attrs
   | TaskList TaskList Attrs
+  | ReferenceDefinition RefDef
   deriving (Show)
 
 -- Removed: BlankLine
@@ -70,12 +72,18 @@ data InlineText
   | Crossed [InlineText] Attrs
   | Underlined [InlineText]
   | InlineCode Text Attrs
-  | Link
+  | -- TODO: redo this to rename misc_attrs and remove title
+    Link
       { linkText :: [InlineText],
         url :: Text,
         title :: Maybe Text,
         misc_attrs :: Attrs
       }
+  | ReferenceLink
+      { linkText :: [InlineText],
+        label :: Text,
+        attrs :: Attrs
+      }
   | Image
       { altText :: Text,
         url :: Text,
@@ -104,8 +112,16 @@ data Attrs = Attrs
   }
   deriving (Show)
 
-emptyAttrs :: Attrs
+instance Semigroup Attrs where
-emptyAttrs = Attrs {attrId = Nothing, attrClasses = [], attrKV = []}
+  a <> b =
+    Attrs
+      { attrId = b.attrId <|> a.attrId,
+        attrClasses = a.attrClasses <> b.attrClasses,
+        attrKV = a.attrKV <> b.attrKV
+      }
+
+instance Monoid Attrs where
+  mempty = Attrs {attrId = Nothing, attrClasses = [], attrKV = []}
 
 data Math
   = InlineLaTeX Text
@@ -148,16 +164,24 @@ data Task = Ta
   }
   deriving (Show)
 
+-- TODO
 data RawInline = RI
   {
   }
   deriving (Show)
 
+-- TODO
 data RawBlock = RB
   {
   }
   deriving (Show)
 
+-- TODO
+data RefDef = RD
+  {
+  }
+  deriving (Show)
+
 -- for processing math
 -- https://hackage.haskell.org/package/typst-0.6.1/docs/Typst-Parse.html#v:parseTypst
 -- and

src/Markdown.hs

@@ -2,9 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeOperators #-}
 
--- (document, metadata)
 module Markdown (document, metadata) where
 
 import Control.Applicative (many, optional, some, (<|>))
@@ -16,7 +14,6 @@ import Data.Proxy (Proxy (Proxy))
 import Data.String (IsString)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Data.Void (Void)
 import GHC.Stack (HasCallStack, callStack, prettyCallStack)
 import IR
 import Logger (Logger (logCallStack, logDebug))