From 5073fdb04b81412c807405ae36510bf449c37ecd Mon Sep 17 00:00:00 2001 From: Pagwin Date: Mon, 6 Apr 2026 21:18:15 -0400 Subject: [PATCH] started on Djot implementation --- TODO.md | 7 +-- psb.cabal | 2 +- src/Djot.hs | 110 ++++++++++++++++++++++++++++++++++++++++++++++++ src/IR.hs | 30 +++++++++++-- src/Markdown.hs | 3 -- 5 files changed, 142 insertions(+), 10 deletions(-) create mode 100644 src/Djot.hs diff --git a/TODO.md b/TODO.md index ddda7b3..3ad2209 100644 --- a/TODO.md +++ b/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 diff --git a/psb.cabal b/psb.cabal index 44c0b79..ed96c30 100644 --- a/psb.cabal +++ b/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 diff --git a/src/Djot.hs b/src/Djot.hs new file mode 100644 index 0000000..61fcdec --- /dev/null +++ b/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" diff --git a/src/IR.hs b/src/IR.hs index 55d4152..38fd25d 100644 --- a/src/IR.hs +++ b/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 -emptyAttrs = Attrs {attrId = Nothing, attrClasses = [], attrKV = []} +instance Semigroup Attrs where + 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 diff --git a/src/Markdown.hs b/src/Markdown.hs index 1fd1977..59b2bfe 100644 --- a/src/Markdown.hs +++ b/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))