mirror of
https://github.com/github/semantic.git
synced 2024-12-21 05:41:54 +03:00
Merge pull request #1224 from github/result-refactor
Better reporting of assignment errors
This commit is contained in:
Rob Rix
GitHub
commit
22f70ecc31
@ -74,7 +74,6 @@ module Data.Syntax.Assignment
|
||||
, children
|
||||
, while
|
||||
-- Results
|
||||
, Result(..)
|
||||
, Error(..)
|
||||
, ErrorCause(..)
|
||||
, printError
|
||||
@ -172,10 +171,6 @@ nodeLocation :: Node grammar -> Record Location
|
||||
nodeLocation Node{..} = nodeByteRange :. nodeSpan :. Nil
|
||||
|
||||
|
||||
-- | The result of assignment, possibly containing an error.
|
||||
data Result grammar a = Result { resultError :: Maybe (Error grammar), resultValue :: Maybe a }
|
||||
deriving (Eq, Foldable, Functor, Traversable)
|
||||
|
||||
data Error grammar where
|
||||
Error
|
||||
:: HasCallStack
|
||||
@ -232,44 +227,45 @@ showPos :: Maybe FilePath -> Info.Pos -> ShowS
|
||||
showPos path Info.Pos{..} = maybe (showParen True (showString "interactive")) showString path . showChar ':' . shows posLine . showChar ':' . shows posColumn
|
||||
|
||||
-- | Run an assignment over an AST exhaustively.
|
||||
assign :: (HasField fields Info.Range, HasField fields Info.Span, HasField fields grammar, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => Assignment (Cofree f (Record fields)) grammar a -> Source.Source -> Cofree f (Record fields) -> Result grammar a
|
||||
assign :: (HasField fields Info.Range, HasField fields Info.Span, HasField fields grammar, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => Assignment (Cofree f (Record fields)) grammar a -> Source.Source -> Cofree f (Record fields) -> Either (Error grammar) a
|
||||
assign = assignBy (\ (r :< _) -> Node (getField r) (getField r) (getField r))
|
||||
|
||||
assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> Source.Source -> ast -> Result grammar a
|
||||
assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> Source.Source -> ast -> Either (Error grammar) a
|
||||
assignBy toNode assignment source = fmap fst . assignAllFrom toNode assignment . makeState source . pure
|
||||
|
||||
assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
|
||||
assignAllFrom toNode assignment state = case runAssignment toNode assignment state of
|
||||
Result err (Just (a, state)) -> case stateNodes (dropAnonymous toNode state) of
|
||||
[] -> pure (a, state)
|
||||
node : _ -> let Node nodeSymbol _ (Info.Span spanStart _) = toNode (F.project node) in
|
||||
Result (err <|> Just (Error spanStart (UnexpectedSymbol [] nodeSymbol))) Nothing
|
||||
r -> r
|
||||
assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)
|
||||
assignAllFrom toNode assignment state = runAssignment toNode assignment state >>= go
|
||||
where
|
||||
go (a, state) = case stateNodes (dropAnonymous toNode state) of
|
||||
[] -> Right (a, state)
|
||||
node : _ -> let Node nodeSymbol _ (Info.Span spanStart _) = toNode (F.project node) in
|
||||
Left $ fromMaybe (Error spanStart (UnexpectedSymbol [] nodeSymbol)) (stateError state)
|
||||
|
||||
-- | Run an assignment of nodes in a grammar onto terms in a syntax.
|
||||
runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
|
||||
runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)
|
||||
runAssignment toNode = iterFreer run . fmap ((pure .) . (,))
|
||||
where run :: AssignmentF ast grammar x -> (x -> AssignmentState ast -> Result grammar (a, AssignmentState ast)) -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
|
||||
where run :: AssignmentF ast grammar x -> (x -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)) -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)
|
||||
run assignment yield initialState = case (assignment, stateNodes) of
|
||||
(Location, node : _) -> yield (nodeLocation (toNode (F.project node))) state
|
||||
(Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.Span statePos statePos :. Nil) state
|
||||
(Project projection, node : _) -> yield (projection (F.project node)) state
|
||||
(Source, node : _) -> yield (Source.sourceBytes (Source.slice (nodeByteRange (toNode (F.project node))) stateSource)) (advanceState toNode state)
|
||||
(Children childAssignment, node : _) -> case assignAllFrom toNode childAssignment state { stateNodes = toList (F.project node) } of
|
||||
Result _ (Just (a, state')) -> yield a (advanceState toNode state' { stateNodes = stateNodes })
|
||||
Result err Nothing -> Result err Nothing
|
||||
(Children childAssignment, node : _) -> do
|
||||
(a, state') <- assignAllFrom toNode childAssignment state { stateNodes = toList (F.project node) }
|
||||
yield a (advanceState toNode state' { stateNodes = stateNodes })
|
||||
(Choose choices, node : _) | Node symbol _ _ <- toNode (F.project node), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state
|
||||
(Many _, []) -> yield [] state
|
||||
(Many rule, _) -> let (e1, values, state') = runMany rule state
|
||||
Result e2 v = yield values state' in Result (e2 <|> e1) v
|
||||
(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
|
||||
(Throw e, _) -> Result (Just e) Nothing
|
||||
(Alt a b, _) -> case yield a state of
|
||||
Left err -> yield b state { stateError = Just err }
|
||||
r -> r
|
||||
(Throw e, _) -> Left e
|
||||
(Catch during handler, _) -> case yield during state of
|
||||
Result _ (Just (a, state')) -> pure (a, state')
|
||||
Result err Nothing -> maybe empty (flip yield state . handler) err
|
||||
(_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
|
||||
(_, ast:_) -> let Node symbol _ (Info.Span spanStart _) = toNode (F.project ast) in Result (Just (Error spanStart (UnexpectedSymbol expectedSymbols symbol))) Nothing
|
||||
Left err -> yield (handler err) state
|
||||
Right (a, state') -> Right (a, state')
|
||||
(_, []) -> Left (Error statePos (UnexpectedEndOfInput expectedSymbols))
|
||||
(_, ast:_) -> let Node symbol _ (Info.Span spanStart _) = toNode (F.project ast) in Left (Error spanStart (UnexpectedSymbol expectedSymbols symbol))
|
||||
where state@AssignmentState{..} = case assignment of
|
||||
Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous toNode initialState
|
||||
_ -> initialState
|
||||
@ -277,33 +273,34 @@ runAssignment toNode = iterFreer run . fmap ((pure .) . (,))
|
||||
Choose choices -> choiceSymbols choices
|
||||
_ -> []
|
||||
choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices
|
||||
runMany :: Assignment ast grammar v -> AssignmentState ast -> (Maybe (Error grammar), [v], AssignmentState ast)
|
||||
runMany :: Assignment ast grammar v -> AssignmentState ast grammar -> ([v], AssignmentState ast grammar)
|
||||
runMany rule state = case runAssignment toNode rule state of
|
||||
Result e1 (Just (a, state')) -> let (e2, as, state'') = runMany rule state' in as `seq` (e2 <|> e1, a : as, state'')
|
||||
Result err Nothing -> (err, [], state)
|
||||
Left e -> ([], state { stateError = Just e })
|
||||
Right (a, state') -> let (as, state'') = runMany rule state' in as `seq` (a : as, state'')
|
||||
{-# INLINE run #-}
|
||||
|
||||
dropAnonymous :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Node grammar) -> AssignmentState ast -> AssignmentState ast
|
||||
dropAnonymous :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Node grammar) -> AssignmentState ast grammar -> AssignmentState ast grammar
|
||||
dropAnonymous toNode state = state { stateNodes = dropWhile ((/= Regular) . symbolType . nodeSymbol . toNode . F.project) (stateNodes state) }
|
||||
|
||||
-- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
|
||||
advanceState :: Recursive ast => (forall x. Base ast x -> Node grammar) -> AssignmentState ast -> AssignmentState ast
|
||||
advanceState :: Recursive ast => (forall x. Base ast x -> Node grammar) -> AssignmentState ast grammar -> AssignmentState ast grammar
|
||||
advanceState toNode state@AssignmentState{..}
|
||||
| node : rest <- stateNodes
|
||||
, Node{..} <- toNode (F.project node) = AssignmentState (Info.end nodeByteRange) (Info.spanEnd nodeSpan) stateSource rest
|
||||
, Node{..} <- toNode (F.project node) = AssignmentState (Info.end nodeByteRange) (Info.spanEnd nodeSpan) stateError stateSource rest
|
||||
| otherwise = state
|
||||
|
||||
-- | State kept while running 'Assignment's.
|
||||
data AssignmentState ast = AssignmentState
|
||||
data AssignmentState ast grammar = AssignmentState
|
||||
{ stateOffset :: Int -- ^ The offset into the Source thus far reached, measured in bytes.
|
||||
, statePos :: Info.Pos -- ^ The (1-indexed) line/column position in the Source thus far reached.
|
||||
, stateError :: Maybe (Error grammar)
|
||||
, stateSource :: Source.Source -- ^ The remaining Source. Equal to dropping 'stateOffset' bytes off the original input Source.
|
||||
, stateNodes :: [ast] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
makeState :: Source.Source -> [ast] -> AssignmentState ast
|
||||
makeState = AssignmentState 0 (Info.Pos 1 1)
|
||||
makeState :: Source.Source -> [ast] -> AssignmentState ast grammar
|
||||
makeState = AssignmentState 0 (Info.Pos 1 1) Nothing
|
||||
|
||||
|
||||
-- Instances
|
||||
@ -334,12 +331,6 @@ instance Show grammar => Show1 (AssignmentF ast grammar) where
|
||||
Throw e -> showsUnaryWith showsPrec "Throw" d e
|
||||
Catch during handler -> showsBinaryWith sp (const (const (showChar '_'))) "Catch" d during handler
|
||||
|
||||
instance Show2 Result where
|
||||
liftShowsPrec2 sp1 sl1 sp2 sl2 d (Result es a) = showsBinaryWith (liftShowsPrec (liftShowsPrec sp1 sl1) (liftShowList sp1 sl1)) (liftShowsPrec sp2 sl2) "Result" d es a
|
||||
|
||||
instance (Show grammar, Show a) => Show (Result grammar a) where
|
||||
showsPrec = showsPrec2
|
||||
|
||||
instance Show1 Error where
|
||||
liftShowsPrec sp sl d (Error p c) = showsBinaryWith showsPrec (liftShowsPrec sp sl) "Error" d p c
|
||||
|
||||
@ -348,15 +339,6 @@ instance Show1 ErrorCause where
|
||||
UnexpectedSymbol expected actual -> showsBinaryWith (liftShowsPrec sp sl) sp "UnexpectedSymbol" d expected actual
|
||||
UnexpectedEndOfInput expected -> showsUnaryWith (liftShowsPrec sp sl) "UnexpectedEndOfInput" d expected
|
||||
|
||||
instance Applicative (Result grammar) where
|
||||
pure = Result Nothing . Just
|
||||
Result e1 f <*> Result e2 a = Result (e1 <|> e2) (f <*> a)
|
||||
|
||||
instance Alternative (Result grammar) where
|
||||
empty = Result Nothing Nothing
|
||||
Result e1 (Just a) <|> Result e2 _ = Result (e1 <|> e2) (Just a)
|
||||
Result e1 Nothing <|> Result e2 b = Result (e1 <|> e2) b
|
||||
|
||||
instance MonadError (Error grammar) (Assignment ast grammar) where
|
||||
throwError :: HasCallStack => Error grammar -> Assignment ast grammar a
|
||||
throwError error = withFrozenCallStack $ Throw error `Then` return
|
||||
|
||||
@ -77,9 +77,11 @@ runParser parser = case parser of
|
||||
ASTParser language -> parseToAST language
|
||||
AssignmentParser parser by assignment -> \ source -> do
|
||||
ast <- runParser parser source
|
||||
let Result err term = assignBy by assignment source ast
|
||||
traverse_ (printError source) err
|
||||
pure $! fromMaybe (errorTerm source) term
|
||||
case assignBy by assignment source ast of
|
||||
Left err -> do
|
||||
printError source err
|
||||
pure (errorTerm source)
|
||||
Right term -> pure term
|
||||
TreeSitterParser language tslanguage -> treeSitterParser language tslanguage
|
||||
MarkdownParser -> pure . cmarkParser
|
||||
LineByLineParser -> pure . lineByLineParser
|
||||
|
||||
@ -13,61 +13,77 @@ spec :: Spec
|
||||
spec = do
|
||||
describe "Applicative" $
|
||||
it "matches in sequence" $
|
||||
runAssignment headF ((,) <$> red <*> red) (makeState "helloworld" [node Red 0 5 [], node Red 5 10 []]) `shouldBe` Result Nothing (Just ((Out "hello", Out "world"), AssignmentState 10 (Info.Pos 1 11) "helloworld" []))
|
||||
runAssignment headF ((,) <$> red <*> red) (makeState "helloworld" [node Red 0 5 [], node Red 5 10 []])
|
||||
`shouldBe`
|
||||
Right ((Out "hello", Out "world"), AssignmentState 10 (Info.Pos 1 11) Nothing "helloworld" [])
|
||||
|
||||
describe "Alternative" $ do
|
||||
it "attempts multiple alternatives" $
|
||||
runAssignment headF (green <|> red) (makeState "hello" [node Red 0 5 []]) `shouldBe` Result Nothing (Just (Out "hello", AssignmentState 5 (Info.Pos 1 6) "hello" []))
|
||||
runAssignment headF (green <|> red) (makeState "hello" [node Red 0 5 []])
|
||||
`shouldBe`
|
||||
Right (Out "hello", AssignmentState 5 (Info.Pos 1 6) Nothing "hello" [])
|
||||
|
||||
it "matches repetitions" $
|
||||
let s = "colourless green ideas sleep furiously"
|
||||
w = words s
|
||||
(_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [node Red i (i + B.length word) []])) (0, []) w in
|
||||
resultValue (runAssignment headF (many red) (makeState (fromBytes s) nodes)) `shouldBe` Just (Out <$> w, AssignmentState (B.length s) (Info.Pos 1 (succ (B.length s))) (fromBytes s) [])
|
||||
runAssignment headF (many red) (makeState (fromBytes s) nodes)
|
||||
`shouldBe`
|
||||
Right (Out <$> w, AssignmentState (B.length s)
|
||||
(Info.Pos 1 (succ (B.length s)))
|
||||
(Just (Error (Info.Pos 1 39) (UnexpectedEndOfInput [Red])))
|
||||
(fromBytes s)
|
||||
[])
|
||||
|
||||
it "matches one-or-more repetitions against one or more input nodes" $
|
||||
resultValue (runAssignment headF (some red) (makeState "hello" [node Red 0 5 []])) `shouldBe` Just ([Out "hello"], AssignmentState 5 (Info.Pos 1 6) "hello" [])
|
||||
runAssignment headF (some red) (makeState "hello" [node Red 0 5 []])
|
||||
`shouldBe`
|
||||
Right ([Out "hello"], AssignmentState 5
|
||||
(Info.Pos 1 6)
|
||||
(Just (Error (Info.Pos 1 6) (UnexpectedEndOfInput [Red])))
|
||||
"hello"
|
||||
[])
|
||||
|
||||
describe "symbol" $ do
|
||||
it "matches nodes with the same symbol" $
|
||||
fst <$> runAssignment headF red (makeState "hello" [node Red 0 5 []]) `shouldBe` Result Nothing (Just (Out "hello"))
|
||||
fst <$> runAssignment headF red (makeState "hello" [node Red 0 5 []]) `shouldBe` Right (Out "hello")
|
||||
|
||||
it "does not advance past the current node" $
|
||||
let initialState = makeState "hi" [ node Red 0 2 [] ] in
|
||||
snd <$> runAssignment headF (symbol Red) initialState `shouldBe` Result Nothing (Just initialState)
|
||||
snd <$> runAssignment headF (symbol Red) initialState `shouldBe` Right initialState
|
||||
|
||||
describe "source" $ do
|
||||
it "produces the node’s source" $
|
||||
assignBy headF source "hi" (node Red 0 2 []) `shouldBe` Result Nothing (Just "hi")
|
||||
assignBy headF source "hi" (node Red 0 2 []) `shouldBe` Right "hi"
|
||||
|
||||
it "advances past the current node" $
|
||||
snd <$> runAssignment headF source (makeState "hi" [ node Red 0 2 [] ]) `shouldBe` Result Nothing (Just (AssignmentState 2 (Info.Pos 1 3) "hi" []))
|
||||
snd <$> runAssignment headF source (makeState "hi" [ node Red 0 2 [] ]) `shouldBe` Right (AssignmentState 2 (Info.Pos 1 3) Nothing "hi" [])
|
||||
|
||||
describe "children" $ do
|
||||
it "advances past the current node" $
|
||||
snd <$> runAssignment headF (children (pure (Out ""))) (makeState "a" [node Red 0 1 []]) `shouldBe` Result Nothing (Just (AssignmentState 1 (Info.Pos 1 2) "a" []))
|
||||
snd <$> runAssignment headF (children (pure (Out ""))) (makeState "a" [node Red 0 1 []]) `shouldBe` Right (AssignmentState 1 (Info.Pos 1 2) Nothing "a" [])
|
||||
|
||||
it "matches if its subrule matches" $
|
||||
() <$ runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Red 0 1 []]]) `shouldBe` Result Nothing (Just ())
|
||||
() <$ runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Red 0 1 []]]) `shouldBe` Right ()
|
||||
|
||||
it "does not match if its subrule does not match" $
|
||||
(runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Green 0 1 []]])) `shouldBe` Result (Just (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green))) Nothing
|
||||
runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Green 0 1 []]]) `shouldBe` Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green))
|
||||
|
||||
it "matches nested children" $
|
||||
runAssignment headF
|
||||
(symbol Red *> children (symbol Green *> children (symbol Blue *> source)))
|
||||
(makeState "1" [ node Red 0 1 [ node Green 0 1 [ node Blue 0 1 [] ] ] ])
|
||||
`shouldBe`
|
||||
Result Nothing (Just ("1", AssignmentState 1 (Info.Pos 1 2) "1" []))
|
||||
Right ("1", AssignmentState 1 (Info.Pos 1 2) Nothing "1" [])
|
||||
|
||||
it "continues after children" $
|
||||
resultValue (runAssignment headF
|
||||
runAssignment headF
|
||||
(many (symbol Red *> children (symbol Green *> source)
|
||||
<|> symbol Blue *> source))
|
||||
(makeState "BC" [ node Red 0 1 [ node Green 0 1 [] ]
|
||||
, node Blue 1 2 [] ]))
|
||||
, node Blue 1 2 [] ])
|
||||
`shouldBe`
|
||||
Just (["B", "C"], AssignmentState 2 (Info.Pos 1 3) "BC" [])
|
||||
Right (["B", "C"], AssignmentState 2 (Info.Pos 1 3) (Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Red, Blue]))) "BC" [])
|
||||
|
||||
it "matches multiple nested children" $
|
||||
runAssignment headF
|
||||
@ -75,20 +91,20 @@ spec = do
|
||||
(makeState "12" [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ]
|
||||
, node Green 1 2 [ node Blue 1 2 [] ] ] ])
|
||||
`shouldBe`
|
||||
Result Nothing (Just (["1", "2"], AssignmentState 2 (Info.Pos 1 3) "12" []))
|
||||
Right (["1", "2"], AssignmentState 2 (Info.Pos 1 3) (Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green]))) "12" [])
|
||||
|
||||
describe "runAssignment" $ do
|
||||
it "drops anonymous nodes before matching symbols" $
|
||||
runAssignment headF red (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Result Nothing (Just (Out "red", AssignmentState 11 (Info.Pos 1 12) "magenta red" []))
|
||||
runAssignment headF red (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Right (Out "red", AssignmentState 11 (Info.Pos 1 12) Nothing "magenta red" [])
|
||||
|
||||
it "does not drop anonymous nodes after matching" $
|
||||
runAssignment headF red (makeState "red magenta" [node Red 0 3 [], node Magenta 4 11 []]) `shouldBe` Result Nothing (Just (Out "red", AssignmentState 3 (Info.Pos 1 4) "red magenta" [node Magenta 4 11 []]))
|
||||
runAssignment headF red (makeState "red magenta" [node Red 0 3 [], node Magenta 4 11 []]) `shouldBe` Right (Out "red", AssignmentState 3 (Info.Pos 1 4) Nothing "red magenta" [node Magenta 4 11 []])
|
||||
|
||||
it "does not drop anonymous nodes when requested" $
|
||||
runAssignment headF ((,) <$> magenta <*> red) (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Result Nothing (Just ((Out "magenta", Out "red"), AssignmentState 11 (Info.Pos 1 12) "magenta red" []))
|
||||
runAssignment headF ((,) <$> magenta <*> red) (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Right ((Out "magenta", Out "red"), AssignmentState 11 (Info.Pos 1 12) Nothing "magenta red" [])
|
||||
|
||||
node :: symbol -> Int -> Int -> [AST symbol] -> AST symbol
|
||||
node symbol start end children = cofree $ (Node symbol (Range start end) (Info.Span (Info.Pos 1 (succ start)) (Info.Pos 1 (succ end)))) :< children
|
||||
node symbol start end children = cofree $ Node symbol (Range start end) (Info.Span (Info.Pos 1 (succ start)) (Info.Pos 1 (succ end))) :< children
|
||||
|
||||
data Grammar = Red | Green | Blue | Magenta
|
||||
deriving (Enum, Eq, Show)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user