module Text.GrammarCombinators.Parser.UUParse (
parseUU,
parseUUR,
parseUURule,
parseUUE
) where
import Text.GrammarCombinators.Base
import Text.GrammarCombinators.Transform.UnfoldRecursion
import Text.GrammarCombinators.Transform.UnfoldLoops
import Text.ParserCombinators.UU
import Text.ParserCombinators.UU.BasicInstances
import Data.Enumerable (enumerate)
newtype WrapP t loc ct v = WP { unWP :: P (Str (ConcreteToken t) [ConcreteToken t] loc) v }
instance (Token t) => ProductionRule (WrapP t loc ct) where
a >>> b = WP $ unWP a <*> unWP b
a ||| b = WP $ unWP a <|> unWP b
endOfInput = WP $ const () <$> pEnd
die = WP empty
instance (Token t) => EpsProductionRule (WrapP t loc ct) where
epsilon v = WP $ pure v
instance (Token t) => LiftableProductionRule (WrapP t loc ct) where
epsilonL v _ = epsilon v
instance (Token t, Show ct, ConcreteToken t ~ ct, IsLocationUpdatedBy loc ct) =>
TokenProductionRule (WrapP t loc ct) t where
token tt =
let
sat :: ConcreteToken t -> Bool
sat t = classify t == tt
in WP $ pSatisfy sat $ Insertion (show tt) (head $ enumConcreteTokens tt) 1
anyToken = WP $ pSatisfy (const True :: ConcreteToken t -> Bool) $ Insertion "anyToken" (head $ enumConcreteTokens (head enumerate :: t)) 1
parseUUR :: forall loc phi t r ix.
(Token t, IsLocationUpdatedBy loc (ConcreteToken t)) =>
ProcessingRegularGrammar phi t r ->
phi ix -> loc -> [ConcreteToken t] -> r ix
parseUUR gram idx = parseUURule $ gram idx
parseUU :: forall loc phi t r ix.
(Token t, IsLocationUpdatedBy loc (ConcreteToken t)) =>
ProcessingContextFreeGrammar phi t r ->
phi ix -> loc -> [ConcreteToken t] -> r ix
parseUU gram = parseUUR (unfoldRecursion gram)
parseUURule :: forall loc phi t r v.
(Token t, IsLocationUpdatedBy loc (ConcreteToken t)) =>
RegularRule phi r t v -> loc ->
[ConcreteToken t] -> v
parseUURule rule loc s =
parse (unWP rule <* pEnd) $ createStr loc s
parseUUE :: forall loc phi t r ix.
(Token t, IsLocationUpdatedBy loc (ConcreteToken t)) =>
ProcessingExtendedContextFreeGrammar phi t r ->
phi ix -> loc -> [ConcreteToken t] -> r ix
parseUUE gram = parseUU (unfoldLoops gram)