1
1
mirror of https://github.com/github/semantic.git synced 2025-01-05 22:28:10 +03:00

Merge pull request from github/fast-markdown-assignment

Fast Markdown assignment
This commit is contained in:
Rob Rix 2017-06-26 12:23:46 -04:00 committed by GitHub
commit fc4760335f
5 changed files with 58 additions and 62 deletions

View File

@ -21,12 +21,15 @@ module Data.Source
-- Conversion -- Conversion
, spanToRange , spanToRange
, spanToRangeInLineRanges , spanToRangeInLineRanges
, sourceLineRangesByLineNumber
, rangeToSpan , rangeToSpan
-- Listable -- Listable
, ListableByteString(..) , ListableByteString(..)
) where ) where
import Data.Array
import qualified Data.ByteString as B import qualified Data.ByteString as B
import Data.Char (ord)
import Data.List (span) import Data.List (span)
import Data.Range import Data.Range
import Data.Span import Data.Span
@ -35,7 +38,7 @@ import qualified Data.Text as T
import Prologue import Prologue
import Test.LeanCheck import Test.LeanCheck
-- | The contents of a source file, represented as a ByteString. -- | The contents of a source file, represented as a 'ByteString'.
newtype Source = Source { sourceBytes :: B.ByteString } newtype Source = Source { sourceBytes :: B.ByteString }
deriving (Eq, IsString, Show) deriving (Eq, IsString, Show)
@ -90,43 +93,33 @@ takeSource i = Source . take . sourceBytes
-- Splitting -- Splitting
-- | Split the source into the longest prefix of elements that do not satisfy the predicate and the rest without copying.
breakSource :: (Word8 -> Bool) -> Source -> (Source, Source)
breakSource predicate (Source text) = let (start, remainder) = B.break predicate text in (Source start, Source remainder)
-- | Split the contents of the source after newlines. -- | Split the contents of the source after newlines.
sourceLines :: Source -> [Source] sourceLines :: Source -> [Source]
sourceLines source sourceLines source = (`slice` source) <$> sourceLineRanges source
| nullSource source = [ source ]
| otherwise = case breakSource (== toEnum (fromEnum '\n')) source of
(line, rest)
| nullSource rest -> [ line ]
| otherwise -> (line <> "\n") : sourceLines (dropSource 1 rest)
-- | Compute the 'Range's of each line in a 'Source'. -- | Compute the 'Range's of each line in a 'Source'.
sourceLineRanges :: Source -> [Range] sourceLineRanges :: Source -> [Range]
sourceLineRanges = drop 1 . scanl toRange (Range 0 0) . sourceLines sourceLineRanges source = sourceLineRangesWithin (totalRange source) source
where toRange previous source = Range (end previous) $ end previous + sourceLength source
-- | Compute the 'Range's of each line in a 'Range' of a 'Source'. -- | Compute the 'Range's of each line in a 'Range' of a 'Source'.
sourceLineRangesWithin :: Range -> Source -> [Range] sourceLineRangesWithin :: Range -> Source -> [Range]
sourceLineRangesWithin range = drop 1 . scanl toRange (Range (start range) (start range)) . sourceLines . slice range sourceLineRangesWithin range = uncurry (zipWith Range) . ((start range:) &&& (<> [ end range ])) . fmap (+ succ (start range)) . B.elemIndices (toEnum (ord '\n')) . sourceBytes . slice range
where toRange previous source = Range (end previous) $ end previous + sourceLength source
-- Conversion -- Conversion
-- | Compute the byte 'Range' corresponding to a given 'Span' in a 'Source'. -- | Compute the byte 'Range' corresponding to a given 'Span' in a 'Source'.
spanToRange :: Source -> Span -> Range spanToRange :: Source -> Span -> Range
spanToRange source = spanToRangeInLineRanges (sourceLineRanges source) spanToRange = spanToRangeInLineRanges . sourceLineRangesByLineNumber
spanToRangeInLineRanges :: [Range] -> Span -> Range spanToRangeInLineRanges :: Array Int Range -> Span -> Range
spanToRangeInLineRanges lineRanges Span{..} = Range start end spanToRangeInLineRanges lineRanges Span{..} = Range
where start = pred (sumLengths leadingRanges + posColumn spanStart) (start (lineRanges ! posLine spanStart) + pred (posColumn spanStart))
end = start + sumLengths (take (posLine spanEnd - posLine spanStart) remainingRanges) + (posColumn spanEnd - posColumn spanStart) (start (lineRanges ! posLine spanEnd) + pred (posColumn spanEnd))
(leadingRanges, remainingRanges) = splitAt (pred (posLine spanStart)) lineRanges
sumLengths = sum . fmap rangeLength sourceLineRangesByLineNumber :: Source -> Array Int Range
sourceLineRangesByLineNumber source = listArray (1, length lineRanges) lineRanges
where lineRanges = sourceLineRanges source
-- | Compute the 'Span' corresponding to a given byte 'Range' in a 'Source'. -- | Compute the 'Span' corresponding to a given byte 'Range' in a 'Source'.
rangeToSpan :: Source -> Range -> Span rangeToSpan :: Source -> Range -> Span

View File

@ -115,6 +115,7 @@ data AssignmentF ast grammar a where
Source :: HasCallStack => AssignmentF ast grammar ByteString Source :: HasCallStack => AssignmentF ast grammar ByteString
Children :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar a Children :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar a
Choose :: HasCallStack => IntMap.IntMap a -> AssignmentF ast grammar a Choose :: HasCallStack => IntMap.IntMap a -> AssignmentF ast grammar a
Many :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar [a]
Alt :: HasCallStack => a -> a -> AssignmentF ast grammar a Alt :: HasCallStack => a -> a -> AssignmentF ast grammar a
Empty :: HasCallStack => AssignmentF ast grammar a Empty :: HasCallStack => AssignmentF ast grammar a
Throw :: HasCallStack => Error grammar -> AssignmentF ast grammar a Throw :: HasCallStack => Error grammar -> AssignmentF ast grammar a
@ -128,13 +129,13 @@ location = Location `Then` return
-- | Zero-width projection of the current node. -- | Zero-width projection of the current node.
-- --
-- Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (project f *> b)' is fine, but 'many (project f)' is not. -- Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. @many (project f *> b)@ is fine, but @many (project f)@ is not.
project :: HasCallStack => (forall x. Base ast x -> a) -> Assignment ast grammar a project :: HasCallStack => (forall x. Base ast x -> a) -> Assignment ast grammar a
project projection = Project projection `Then` return project projection = Project projection `Then` return
-- | Zero-width match of a node with the given symbol, producing the current nodes location. -- | Zero-width match of a node with the given symbol, producing the current nodes location.
-- --
-- Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (symbol A *> b)' is fine, but 'many (symbol A)' is not. -- Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. @many (symbol A *> b)@ is fine, but @many (symbol A)@ is not.
symbol :: (Enum grammar, Eq grammar, HasCallStack) => grammar -> Assignment ast grammar (Record Location) symbol :: (Enum grammar, Eq grammar, HasCallStack) => grammar -> Assignment ast grammar (Record Location)
symbol s = withFrozenCallStack $ Choose (IntMap.singleton (fromEnum s) ()) `Then` (const location) symbol s = withFrozenCallStack $ Choose (IntMap.singleton (fromEnum s) ()) `Then` (const location)
@ -182,12 +183,10 @@ data ErrorCause grammar
-- | Pretty-print an Error with reference to the source where it occurred. -- | Pretty-print an Error with reference to the source where it occurred.
printError :: Show grammar => Source.Source -> Error grammar -> IO () printError :: Show grammar => Source.Source -> Error grammar -> IO ()
printError source error@Error{..} printError source error@Error{..} = do
= do withSGRCode [SetConsoleIntensity BoldIntensity] . putStrErr . showPos Nothing errorPos . showString ": " $ ""
withSGRCode [SetConsoleIntensity BoldIntensity] . putStrErr . (showPos Nothing errorPos) . showString ": " $ "" withSGRCode [SetColor Foreground Vivid Red] . putStrErr . showString "error" . showString ": " . showExpectation error . showChar '\n' . showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n') . showString (replicate (succ (Info.posColumn errorPos + lineNumberDigits)) ' ') $ ""
withSGRCode [SetColor Foreground Vivid Red] . putStrErr . (showString "error") . showString ": " . showExpectation error . showChar '\n' . showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n') . showString (replicate (succ (Info.posColumn errorPos + lineNumberDigits)) ' ') $ "" withSGRCode [SetColor Foreground Vivid Green] . putStrErr . showChar '^' . showChar '\n' . showString (prettyCallStack callStack) $ ""
withSGRCode [SetColor Foreground Vivid Green] . putStrErr . (showChar '^') . showChar '\n' . showString (prettyCallStack callStack) $ ""
where context = maybe "\n" (Source.sourceBytes . sconcat) (nonEmpty [ Source.fromBytes (toS (showLineNumber i)) <> Source.fromBytes ": " <> l | (i, l) <- zip [1..] (Source.sourceLines source), inRange (Info.posLine errorPos - 2, Info.posLine errorPos) i ]) where context = maybe "\n" (Source.sourceBytes . sconcat) (nonEmpty [ Source.fromBytes (toS (showLineNumber i)) <> Source.fromBytes ": " <> l | (i, l) <- zip [1..] (Source.sourceLines source), inRange (Info.posLine errorPos - 2, Info.posLine errorPos) i ])
showLineNumber n = let s = show n in replicate (lineNumberDigits - length s) ' ' <> s showLineNumber n = let s = show n in replicate (lineNumberDigits - length s) ' ' <> s
lineNumberDigits = succ (floor (logBase 10 (fromIntegral (Info.posLine errorPos) :: Double))) lineNumberDigits = succ (floor (logBase 10 (fromIntegral (Info.posLine errorPos) :: Double)))
@ -248,7 +247,9 @@ runAssignment toRecord = iterFreer run . fmap ((pure .) . (,))
Result _ (Just (a, state')) -> yield a (advanceState (rtail . toRecord) state' { stateNodes = stateNodes }) Result _ (Just (a, state')) -> yield a (advanceState (rtail . toRecord) state' { stateNodes = stateNodes })
Result err Nothing -> Result err Nothing Result err Nothing -> Result err Nothing
(Choose choices, node : _) | Just symbol :. _ <- toRecord (F.project node), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state (Choose choices, node : _) | Just symbol :. _ <- toRecord (F.project node), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state
-- Nullability: some rules, e.g. 'pure a' and 'many a', should match at the end of input. Either side of an alternation may be nullable, ergo Alt can match at the end of input. (Many _, []) -> yield [] state
(Many rule, _) -> uncurry yield (runMany rule state)
-- Nullability: some rules, e.g. @pure a@ and @many a@, should match at the end of input. Either side of an alternation may be nullable, ergo Alt can match at the end of input.
(Alt a b, _) -> yield a state <|> yield b state (Alt a b, _) -> yield a state <|> yield b state
(Throw e, _) -> Result (Just e) Nothing (Throw e, _) -> Result (Just e) Nothing
(Catch during handler, _) -> case yield during state of (Catch during handler, _) -> case yield during state of
@ -263,6 +264,10 @@ runAssignment toRecord = iterFreer run . fmap ((pure .) . (,))
Choose choices -> choiceSymbols choices Choose choices -> choiceSymbols choices
_ -> [] _ -> []
choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices
runMany :: Assignment ast grammar v -> AssignmentState ast -> ([v], AssignmentState ast)
runMany rule state = case runAssignment toRecord rule state of
Result _ (Just (a, state')) -> first (a :) (runMany rule state')
_ -> ([], state)
dropAnonymous :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Maybe grammar) -> AssignmentState ast -> AssignmentState ast dropAnonymous :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Maybe grammar) -> AssignmentState ast -> AssignmentState ast
dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . F.project) (stateNodes state) } dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . F.project) (stateNodes state) }
@ -284,7 +289,7 @@ data AssignmentState ast = AssignmentState
deriving (Eq, Show) deriving (Eq, Show)
makeState :: Source.Source -> [ast] -> AssignmentState ast makeState :: Source.Source -> [ast] -> AssignmentState ast
makeState source nodes = AssignmentState 0 (Info.Pos 1 1) source nodes makeState = AssignmentState 0 (Info.Pos 1 1)
-- Instances -- Instances
@ -293,11 +298,16 @@ instance Enum grammar => Alternative (Assignment ast grammar) where
empty :: HasCallStack => Assignment ast grammar a empty :: HasCallStack => Assignment ast grammar a
empty = Empty `Then` return empty = Empty `Then` return
(<|>) :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a -> Assignment ast grammar a (<|>) :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a -> Assignment ast grammar a
a <|> b = case (a, b) of Return a <|> _ = Return a
(_, Empty `Then` _) -> a a <|> b | Just c <- (liftA2 (<>) `on` choices) a b = Choose c `Then` identity
(Empty `Then` _, _) -> b | otherwise = wrap $ Alt a b
(Choose choices1 `Then` continue1, Choose choices2 `Then` continue2) -> Choose (IntMap.union (fmap continue1 choices1) (fmap continue2 choices2)) `Then` identity where choices :: Assignment ast grammar a -> Maybe (IntMap (Assignment ast grammar a))
_ -> wrap $ Alt a b choices (Choose choices `Then` continue) = Just (continue <$> choices)
choices (Empty `Then` _) = Just mempty
choices (Many rule `Then` continue) = fmap (const (Many rule `Then` continue)) <$> choices rule
choices _ = Nothing
many :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar [a]
many a = Many a `Then` return
instance Show grammar => Show1 (AssignmentF ast grammar) where instance Show grammar => Show1 (AssignmentF ast grammar) where
liftShowsPrec sp sl d a = case a of liftShowsPrec sp sl d a = case a of
@ -306,6 +316,7 @@ instance Show grammar => Show1 (AssignmentF ast grammar) where
Source -> showString "Source" . showChar ' ' . sp d "" Source -> showString "Source" . showChar ' ' . sp d ""
Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a
Choose choices -> showsUnaryWith (liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl)) "Choose" d (IntMap.toList choices) Choose choices -> showsUnaryWith (liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl)) "Choose" d (IntMap.toList choices)
Many a -> showsUnaryWith (liftShowsPrec (\ d a -> sp d [a]) (sl . pure)) "Many" d a
Alt a b -> showsBinaryWith sp sp "Alt" d a b Alt a b -> showsBinaryWith sp sp "Alt" d a b
Empty -> showString "Empty" Empty -> showString "Empty"
Throw e -> showsUnaryWith showsPrec "Throw" d e Throw e -> showsUnaryWith showsPrec "Throw" d e

View File

@ -44,9 +44,9 @@ cmarkParser source = toTerm (totalRange source) (totalSpan source) $ commonmarkT
span = maybe withinSpan toSpan position span = maybe withinSpan toSpan position
in cofree $ (t :. range :. span :. Nil) :< (toTerm range span <$> children) in cofree $ (t :. range :. span :. Nil) :< (toTerm range span <$> children)
toSpan PosInfo{..} = Span (Pos startLine startColumn) (Pos endLine (succ endColumn)) toSpan PosInfo{..} = Span (Pos startLine startColumn) (Pos (max startLine endLine) (succ (if endLine <= startLine then max startColumn endColumn else endColumn)))
lineRanges = sourceLineRanges source lineRanges = sourceLineRangesByLineNumber source
toGrammar :: NodeType -> Grammar toGrammar :: NodeType -> Grammar
toGrammar DOCUMENT{} = Document toGrammar DOCUMENT{} = Document

View File

@ -62,7 +62,7 @@ paragraph :: Assignment
paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement) paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
list :: Assignment list :: Assignment
list = (cofree .) . (:<) <$> symbol List <*> (project (\ (((CMark.LIST CMark.ListAttributes{..}) :. _) :< _) -> case listType of list = (cofree .) . (:<) <$> symbol List <*> (project (\ ((CMark.LIST CMark.ListAttributes{..} :. _) :< _) -> case listType of
CMark.BULLET_LIST -> inj . Markup.UnorderedList CMark.BULLET_LIST -> inj . Markup.UnorderedList
CMark.ORDERED_LIST -> inj . Markup.OrderedList) <*> children (many item)) CMark.ORDERED_LIST -> inj . Markup.OrderedList) <*> children (many item))
@ -71,7 +71,7 @@ item = makeTerm <$> symbol Item <*> children (many blockElement)
section :: Assignment section :: Assignment
section = makeTerm <$> symbol Heading <*> (heading >>= \ headingTerm -> Markup.Section headingTerm <$> while (((<) `on` level) headingTerm) blockElement) section = makeTerm <$> symbol Heading <*> (heading >>= \ headingTerm -> Markup.Section headingTerm <$> while (((<) `on` level) headingTerm) blockElement)
where heading = makeTerm <$> symbol Heading <*> (Markup.Heading <$> project (\ ((CMark.HEADING level :. _) :< _) -> level) <*> children (many inlineElement)) where heading = makeTerm <$> symbol Heading <*> (project (\ ((CMark.HEADING level :. _) :< _) -> Markup.Heading level) <*> children (many inlineElement))
level term = case term of level term = case term of
_ | Just section <- prj (unwrap term) -> level (Markup.sectionHeading section) _ | Just section <- prj (unwrap term) -> level (Markup.sectionHeading section)
_ | Just heading <- prj (unwrap term) -> Markup.headingLevel heading _ | Just heading <- prj (unwrap term) -> Markup.headingLevel heading
@ -81,10 +81,10 @@ blockQuote :: Assignment
blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement) blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement)
codeBlock :: Assignment codeBlock :: Assignment
codeBlock = makeTerm <$> symbol CodeBlock <*> (Markup.Code <$> project (\ (((CMark.CODE_BLOCK language _) :. _) :< _) -> nullText language) <*> source) codeBlock = makeTerm <$> symbol CodeBlock <*> (project (\ ((CMark.CODE_BLOCK language _ :. _) :< _) -> Markup.Code (nullText language)) <*> source)
thematicBreak :: Assignment thematicBreak :: Assignment
thematicBreak = makeTerm <$> symbol ThematicBreak <*> (Markup.ThematicBreak <$ source) thematicBreak = makeTerm <$> symbol ThematicBreak <*> pure Markup.ThematicBreak <* source
htmlBlock :: Assignment htmlBlock :: Assignment
htmlBlock = makeTerm <$> symbol HTMLBlock <*> (Markup.HTMLBlock <$> source) htmlBlock = makeTerm <$> symbol HTMLBlock <*> (Markup.HTMLBlock <$> source)
@ -105,19 +105,19 @@ text :: Assignment
text = makeTerm <$> symbol Text <*> (Markup.Text <$> source) text = makeTerm <$> symbol Text <*> (Markup.Text <$> source)
link :: Assignment link :: Assignment
link = makeTerm <$> symbol Link <*> (uncurry Markup.Link <$> project (\ (((CMark.LINK url title) :. _) :< _) -> (toS url, nullText title))) <* source link = makeTerm <$> symbol Link <*> project (\ ((CMark.LINK url title :. _) :< _) -> Markup.Link (toS url) (nullText title)) <* source
image :: Assignment image :: Assignment
image = makeTerm <$> symbol Image <*> (uncurry Markup.Image <$> project (\ (((CMark.IMAGE url title) :. _) :< _) -> (toS url, nullText title))) <* source image = makeTerm <$> symbol Image <*> project (\ ((CMark.IMAGE url title :. _) :< _) -> Markup.Image (toS url) (nullText title)) <* source
code :: Assignment code :: Assignment
code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source) code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
lineBreak :: Assignment lineBreak :: Assignment
lineBreak = makeTerm <$> symbol LineBreak <*> (Markup.LineBreak <$ source) lineBreak = makeTerm <$> symbol LineBreak <*> pure Markup.LineBreak <* source
softBreak :: Assignment softBreak :: Assignment
softBreak = makeTerm <$> symbol SoftBreak <*> (Markup.LineBreak <$ source) softBreak = makeTerm <$> symbol SoftBreak <*> pure Markup.LineBreak <* source
-- Implementation details -- Implementation details

View File

@ -16,7 +16,6 @@ import Data.Record
import Data.Source as Source import Data.Source as Source
import qualified Data.Syntax as Syntax import qualified Data.Syntax as Syntax
import Data.Syntax.Assignment import Data.Syntax.Assignment
import qualified Data.Text as T
import Data.Union import Data.Union
import Info hiding (Empty, Go) import Info hiding (Empty, Go)
import Language import Language
@ -93,7 +92,7 @@ runParser parser = case parser of
Nothing -> pure (errorTerm source err) Nothing -> pure (errorTerm source err)
TreeSitterParser language tslanguage -> treeSitterParser language tslanguage TreeSitterParser language tslanguage -> treeSitterParser language tslanguage
MarkdownParser -> pure . cmarkParser MarkdownParser -> pure . cmarkParser
LineByLineParser -> lineByLineParser LineByLineParser -> pure . lineByLineParser
errorTerm :: Syntax.Error (Error grammar) :< fs => Source -> Maybe (Error grammar) -> Term (Union fs) (Record Location) errorTerm :: Syntax.Error (Error grammar) :< fs => Source -> Maybe (Error grammar) -> Term (Union fs) (Record Location)
errorTerm source err = cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error (fromMaybe (Error (Pos 0 0) (UnexpectedEndOfInput [])) err))) errorTerm source err = cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error (fromMaybe (Error (Pos 0 0) (UnexpectedEndOfInput [])) err)))
@ -104,13 +103,6 @@ termErrors = cata $ \ (_ :< s) -> case s of
_ -> fold s _ -> fold s
-- | A fallback parser that treats a file simply as rows of strings. -- | A fallback parser that treats a file simply as rows of strings.
lineByLineParser :: Source -> IO (SyntaxTerm Text DefaultFields) lineByLineParser :: Source -> SyntaxTerm Text DefaultFields
lineByLineParser source = pure . cofree . root $ case foldl' annotateLeaves ([], 0) lines of lineByLineParser source = cofree $ (totalRange source :. Program :. totalSpan source :. Nil) :< Indexed (zipWith toLine [1..] (sourceLineRanges source))
(leaves, _) -> cofree <$> leaves where toLine line range = cofree $ (range :. Program :. Span (Pos line 1) (Pos line (end range)) :. Nil) :< Leaf (toText (slice range source))
where
lines = sourceLines source
root children = (sourceRange :. Program :. rangeToSpan source sourceRange :. Nil) :< Indexed children
sourceRange = totalRange source
leaf byteIndex line = (Range byteIndex (byteIndex + T.length line) :. Program :. rangeToSpan source (Range byteIndex (byteIndex + T.length line)) :. Nil) :< Leaf line
annotateLeaves (accum, byteIndex) line =
(accum <> [ leaf byteIndex (toText line) ] , byteIndex + sourceLength line)