From 4370de23fdc785b0ff403f8bbbc778de95781ac3 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Thu, 28 Jun 2018 11:21:56 -0400 Subject: [PATCH] Define branchNode. --- src/Assigning/Assignment/Deterministic.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/src/Assigning/Assignment/Deterministic.hs b/src/Assigning/Assignment/Deterministic.hs index 3ee32a3cf..ba1b83489 100644 --- a/src/Assigning/Assignment/Deterministic.hs +++ b/src/Assigning/Assignment/Deterministic.hs @@ -11,8 +11,8 @@ import Prologue class (Alternative f, Ord s, Show s) => Assigning s f | f -> s where sym :: s -> f s - leafNode :: s -> f Text - -- TODO: branchNode + leafNode :: s -> f Text + branchNode :: s -> f a -> f a -- TODO: toTerm combine :: Ord s => Bool -> Set s -> Set s -> Set s @@ -86,5 +86,13 @@ instance (Ord s, Show s) => Assigning s (Assignment s) where Left err -> Left (Error (astSpan s) [Left "valid utf-8"] (Just (Left (show err)))) Right text -> Right (advanceState state, text)) + branchNode s a = Assignment Nothing (Set.singleton s) (\ src state _ -> case stateInput state of + [] -> Left (Error (stateSpan state) [Right s] Nothing) + s:_ -> case runAssignment a src state { stateInput = astChildren s } of + Left err -> Left err + Right (state', a') -> case stateInput state' of + [] -> Right (advanceState state, a') + s':_ -> Left (Error (stateSpan state') [] (Just (Right (astSymbol s'))))) + runAssignment :: Assignment s a -> Source -> State s -> Either (Error (Either String s)) (State s, a) runAssignment (Assignment _ _ p) src inp = p src inp lowerBound