diff options
| -rw-r--r-- | src/MdBlocks/Parser.hs | 305 |
1 files changed, 233 insertions, 72 deletions
diff --git a/src/MdBlocks/Parser.hs b/src/MdBlocks/Parser.hs index f2f184d..b5ca193 100644 --- a/src/MdBlocks/Parser.hs +++ b/src/MdBlocks/Parser.hs @@ -1,95 +1,256 @@ {-# LANGUAGE OverloadedStrings #-} -module MdBlocks.Parser where +module MdBlocks.Parser + ( parseFile + ) +where -import Data.Text (Text) import qualified Data.Text as T +import Data.Text (Text) import MdBlocks.Metadata import MdBlocks.Types -parseFile :: FilePath -> Text -> [Block] + +data State + = Normal + | InFence FenceState + | InIndented IndentedState + +data FenceState = FenceState + { fsStartLine :: !Int + , fsFenceTok :: !Text + , fsHeader :: !Text + , fsLines :: [Text] + } + +data IndentedState = IndentedState + { isStartLine :: !Int + , isLines :: [Text] + } + +data ParseState = ParseState + { psFile :: FilePath + , psMode :: State + , psBlocks :: [Block] + } + + +parseFile + :: FilePath + -> Text + -> [Block] parseFile fp txt = - numberBlocks $ - parseFenced fp ls - ++ parseIndented fp ls + assignNumbers + $ finalize + $ foldl step initial numbered where - ls = zip [1..] (T.lines txt) + numbered = + zip [1..] (T.lines txt) -numberBlocks :: [Block] -> [Block] -numberBlocks = - zipWith (\n b -> b { blockNumber = n }) [1..] + initial = + ParseState + { psFile = fp + , psMode = Normal + , psBlocks = [] + } -parseFenced :: FilePath -> [(Int,Text)] -> [Block] -parseFenced fp = - go False 0 "" [] - where - go _ _ _ acc [] = reverse acc - go False _ _ acc ((ln,t):xs) - | "```" `T.isPrefixOf` T.stripStart t = - go True ln t acc xs - | otherwise = - go False 0 "" acc xs +assignNumbers :: [Block] -> [Block] +assignNumbers = + zipWith + (\n b -> b { blockNumber = n }) + [1..] + + +isIndented :: Text -> Bool +isIndented = + (" " `T.isPrefixOf`) + +stripIndent :: Text -> Text +stripIndent = + T.drop 4 + + +fenceStart :: Text -> Maybe (Text, Text) +fenceStart line = + let s = T.stripStart line + in if "```" `T.isPrefixOf` s + then Just ("```", T.drop 3 s) + else Nothing + + +fenceEnd :: Text -> Text -> Bool +fenceEnd marker line = + marker `T.isPrefixOf` + T.stripStart line + + +step + :: ParseState + -> (Int, Text) + -> ParseState + +step st@(ParseState _ Normal _) (ln,txt) - go True start hdr acc ((ln,t):xs) - | "```" `T.isPrefixOf` T.stripStart t = - let body = - T.unlines $ - map snd $ - takeWhile - (\(_,x) -> - not ("```" - `T.isPrefixOf` - T.stripStart x)) - ((ln,t):xs) - in go False 0 "" (mk start ln hdr body:acc) xs + | Just (marker,hdr) <- fenceStart txt = + st + { psMode = + InFence + FenceState + { fsStartLine = ln + , fsFenceTok = marker + , fsHeader = T.strip hdr + , fsLines = [] + } + } - | otherwise = - go True start hdr acc xs + | isIndented txt = + st + { psMode = + InIndented + IndentedState + { isStartLine = ln + , isLines = + [stripIndent txt] + } + } - mk s e hdr body = - let meta = - parseMetadataLine $ - "@" <> T.drop 3 (T.strip hdr) - in Block fp 0 Fenced meta s e body + | otherwise = + st -parseIndented :: FilePath -> [(Int,Text)] -> [Block] -parseIndented fp = - go +step st@(ParseState fp (InFence fs) acc) (ln,txt) + + | fenceEnd (fsFenceTok fs) txt = + st + { psMode = Normal + , psBlocks = + mkFenceBlock fp fs ln + : acc + } + + | otherwise = + st + { psMode = + InFence + fs + { fsLines = + txt : fsLines fs + } + } + +step st@(ParseState fp (InIndented is) acc) current@(ln,txt) + + | isIndented txt = + st + { psMode = + InIndented + is + { isLines = + stripIndent txt + : isLines is + } + } + + | otherwise = + let block = + mkIndentedBlock + fp + is + (ln - 1) + + reset = + st + { psMode = Normal + , psBlocks = block : acc + } + + in step reset current + + +finalize :: ParseState -> [Block] + +finalize (ParseState _ Normal xs) = + reverse xs + +finalize (ParseState fp (InFence fs) xs) = + reverse + ( mkFenceBlock fp fs (fsStartLine fs) + : xs + ) + +finalize (ParseState fp (InIndented is) xs) = + reverse + ( mkIndentedBlock fp is (isStartLine is) + : xs + ) + + +mkFenceBlock + :: FilePath + -> FenceState + -> Int + -> Block +mkFenceBlock fp fs endLine = + Block + { blockFile = fp + , blockNumber = 0 + , blockKind = Fenced + , blockMeta = meta + , blockStart = fsStartLine fs + , blockEnd = endLine + , blockContent = body + } where - go [] = [] + body = + T.unlines + (reverse (fsLines fs)) + + meta = + parseMetadataLine + ("@" <> fsHeader fs) + + +mkIndentedBlock + :: FilePath + -> IndentedState + -> Int + -> Block +mkIndentedBlock fp is endLine = + Block + { blockFile = fp + , blockNumber = 0 + , blockKind = Indented + , blockMeta = meta + , blockStart = isStartLine is + , blockEnd = endLine + , blockContent = code + } + where + raw = + T.unlines + (reverse (isLines is)) + + (meta, code) = + splitIndentedMetadata raw - go ((ln,t):xs) - | isIndented t = - let (blk,rest) = span (isIndented . snd) xs - chunk = - T.unlines $ - map (T.drop 4 . snd) - ((ln,t):blk) - meta = - case T.lines chunk of - [] -> emptyMetadata - (x:_) - | "@" `T.isPrefixOf` x -> - parseMetadataLine x - | otherwise -> - emptyMetadata +splitIndentedMetadata + :: Text + -> (Metadata, Text) +splitIndentedMetadata txt = + case T.lines txt of - code = - case T.lines chunk of - [] -> "" - (x:rs) - | "@" `T.isPrefixOf` x -> - T.unlines rs - | otherwise -> - chunk - in Block fp 0 Indented meta ln (fst $ last (blk++[(ln,t)])) code - : go rest + [] -> + (emptyMetadata, "") - | otherwise = - go xs + firstLine : rest + | "@" `T.isPrefixOf` firstLine -> + ( parseMetadataLine firstLine + , T.unlines rest + ) - isIndented t = - " " `T.isPrefixOf` t + | otherwise -> + ( emptyMetadata + , txt + ) |