github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-30 02:14:20 +03:00
Code Issues Projects Releases Wiki Activity

Define a combinator requiring exhaustiveness.

Browse Source
This commit is contained in:
Rob Rix 2017-07-22 13:44:51 -04:00
parent 15b7735874
commit 07b132e631
1 changed files with 7 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Data/Syntax/Assignment.hs
View File

@ -308,6 +308,13 @@ runAssignment source toNode = go
| otherwise -> ([a], state')
{-# INLINE runMany #-}
requireExhaustive :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Node grammar) -> (a, AssignmentState ast grammar) -> Either (Error grammar) (a, AssignmentState ast grammar)
requireExhaustive toNode (a, state) = case stateNodes (dropAnonymous toNode state) of
[] -> Right (a, state)
node : _ | Node nodeSymbol _ (Info.Span spanStart _) <- toNode (F.project node) ->
Left $ fromMaybe (Error spanStart (UnexpectedSymbol [] nodeSymbol)) (stateError state)
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) }