110 lines
3.9 KiB
Haskell
110 lines
3.9 KiB
Haskell
{-# 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"
|