module Data.BAByNF.Core.Parseable ( Parseable (..) , toParser , Dict , TreeParser ) where import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as List.NonEmpty import Data.Attoparsec.ByteString qualified as Attoparsec import Data.BAByNF.Core.Tree (Tree) import Data.BAByNF.Core.Tree qualified as Tree import Data.BAByNF.Core.Ref (Ref) import Data.BAByNF.Core.Ref qualified as Ref import Data.BAByNF.Core.RefDict (RefDict) import Data.BAByNF.Core.RefDict qualified as RefDict import Data.BAByNF.Core.Repeat (Repeat, RepeatCount) import Data.BAByNF.Core.Repeat qualified as Repeat type Dict a = RefDict a (Parseable a) type TreeParser a = Attoparsec.Parser (Tree a) data ParserEnvironment a where ParserEnvironment :: (Ref a) => { forall a. ParserEnvironment a -> Dict a parserGrammar :: Dict a, forall a. ParserEnvironment a -> [ParserContext a] parserContextStack :: [ParserContext a] } -> ParserEnvironment a deriving instance (Show a) => Show (ParserEnvironment a) data ParserState a where ParserState :: (Ref a) => { forall a. ParserState a -> ParserEnvironment a parserEnvironment :: ParserEnvironment a , forall a. ParserState a -> ParserFocus a parserFocus :: ParserFocus a } -> ParserState a deriving instance (Show a) => Show (ParserState a) data ParserContext a where SeqContext :: (Ref a) => { forall a. ParserContext a -> Tree a seqPrev :: Tree a, forall a. ParserContext a -> [Parseable a] seqNext :: [Parseable a]} -> ParserContext a RepContext :: (Ref a) => { forall a. ParserContext a -> Tree a repPrev :: Tree a, forall a. ParserContext a -> Parseable a repParse :: Parseable a, forall a. ParserContext a -> RepeatCount repCount :: RepeatCount} -> ParserContext a AltContext :: (Ref a) => { forall a. ParserContext a -> [Parseable a] altNext :: [Parseable a]} -> ParserContext a RuleContext :: (Ref a) => { forall a. ParserContext a -> a ruleRef :: a } -> ParserContext a deriving instance (Show a) => Show (ParserContext a) data Parseable a where Seq :: (Ref a) => NonEmpty (Parseable a) -> Parseable a Alt :: (Ref a) => NonEmpty (Parseable a) -> Parseable a Rep :: (Ref a) => (Parseable a) -> Repeat -> Parseable a Rule :: (Ref a) => a -> Parseable a Unit :: String -> (TreeParser a) -> Parseable a instance (Show a) => Show (Parseable a) where show :: Parseable a -> String show :: Parseable a -> String show Parseable a x = case Parseable a x of Seq NonEmpty (Parseable a) y -> String "Seq( " String -> ShowS forall a. [a] -> [a] -> [a] ++ [Parseable a] -> String forall a. Show a => a -> String show (NonEmpty (Parseable a) -> [Parseable a] forall a. NonEmpty a -> [a] List.NonEmpty.toList NonEmpty (Parseable a) y) String -> ShowS forall a. [a] -> [a] -> [a] ++ String " )" Alt NonEmpty (Parseable a) y -> String "Alt( " String -> ShowS forall a. [a] -> [a] -> [a] ++ [Parseable a] -> String forall a. Show a => a -> String show (NonEmpty (Parseable a) -> [Parseable a] forall a. NonEmpty a -> [a] List.NonEmpty.toList NonEmpty (Parseable a) y) String -> ShowS forall a. [a] -> [a] -> [a] ++ String " )" Rep Parseable a a Repeat b -> String "Rep( {" String -> ShowS forall a. [a] -> [a] -> [a] ++ Natural -> String forall a. Show a => a -> String show (Repeat -> Natural Repeat.required Repeat b) String -> ShowS forall a. [a] -> [a] -> [a] ++ String "," String -> ShowS forall a. [a] -> [a] -> [a] ++ Maybe Natural -> String forall a. Show a => a -> String show (Repeat -> Maybe Natural Repeat.optional Repeat b) String -> ShowS forall a. [a] -> [a] -> [a] ++ String "}->" String -> ShowS forall a. [a] -> [a] -> [a] ++ Parseable a -> String forall a. Show a => a -> String show Parseable a a String -> ShowS forall a. [a] -> [a] -> [a] ++ String ")" Rule a r -> String "Rule (" String -> ShowS forall a. [a] -> [a] -> [a] ++ a -> String forall a. Show a => a -> String show a r String -> ShowS forall a. [a] -> [a] -> [a] ++ String ")" Unit String desc TreeParser a _ -> String "Unit <" String -> ShowS forall a. [a] -> [a] -> [a] ++ String desc String -> ShowS forall a. [a] -> [a] -> [a] ++ String ">" data ParserFocus a where Before :: Ref a => Parseable a -> ParserFocus a OnReturn :: Ref a => ParserContext a -> Tree a -> ParserFocus a OnFailure :: Ref a => ParserContext a -> ParserFocus a After :: Ref a => Tree a -> ParserFocus a deriving instance (Show a) => Show (ParserFocus a) toParser :: (Ref a, Show a) => Dict a -> Parseable a -> TreeParser a toParser :: forall a. (Ref a, Show a) => Dict a -> Parseable a -> TreeParser a toParser Dict a grammar Parseable a parseable = ParserState a -> TreeParser a forall a. (Ref a, Show a) => ParserState a -> TreeParser a toParser' (ParserState a -> TreeParser a) -> ParserState a -> TreeParser a forall a b. (a -> b) -> a -> b $ ParserState { parserEnvironment :: ParserEnvironment a parserEnvironment = ParserEnvironment { parserGrammar :: Dict a parserGrammar = Dict a grammar, parserContextStack :: [ParserContext a] parserContextStack = []}, parserFocus :: ParserFocus a parserFocus = Parseable a -> ParserFocus a forall a. Ref a => Parseable a -> ParserFocus a Before (NonEmpty (Parseable a) -> Parseable a forall a. Ref a => NonEmpty (Parseable a) -> Parseable a Seq (NonEmpty (Parseable a) -> Parseable a) -> NonEmpty (Parseable a) -> Parseable a forall a b. (a -> b) -> a -> b $ Parseable a parseable Parseable a -> [Parseable a] -> NonEmpty (Parseable a) forall a. a -> [a] -> NonEmpty a :| [String -> TreeParser a -> Parseable a forall a. String -> TreeParser a -> Parseable a Unit String "endOfInput" (TreeParser a -> Parseable a) -> TreeParser a -> Parseable a forall a b. (a -> b) -> a -> b $ Parser ByteString () forall t. Chunk t => Parser t () Attoparsec.endOfInput Parser ByteString () -> TreeParser a -> TreeParser a forall a b. Parser ByteString a -> Parser ByteString b -> Parser ByteString b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Tree a -> TreeParser a forall a. a -> Parser ByteString a forall (m :: * -> *) a. Monad m => a -> m a return Tree a forall a. Ref a => Tree a Tree.empty]) } alts :: (Ref a) => [Parseable a] -> Maybe (Parseable a) alts :: forall a. Ref a => [Parseable a] -> Maybe (Parseable a) alts [] = Maybe (Parseable a) forall a. Maybe a Nothing alts [Parseable a x] = Parseable a -> Maybe (Parseable a) forall a. a -> Maybe a Just Parseable a x alts (Parseable a x:[Parseable a] xs) = Parseable a -> Maybe (Parseable a) forall a. a -> Maybe a Just (Parseable a -> Maybe (Parseable a)) -> Parseable a -> Maybe (Parseable a) forall a b. (a -> b) -> a -> b $ NonEmpty (Parseable a) -> Parseable a forall a. Ref a => NonEmpty (Parseable a) -> Parseable a Alt (Parseable a x Parseable a -> [Parseable a] -> NonEmpty (Parseable a) forall a. a -> [a] -> NonEmpty a :| [Parseable a] xs) data Action a where Return :: Ref a => Tree a -> Action a Split :: Ref a => ParserContext a -> Parseable a -> Action a Branch :: Ref a => ParserContext a -> Parseable a -> Action a Parse :: Ref a => TreeParser a -> Action a Panic :: String -> Action a applyAction :: (Ref a, Show a) => ParserEnvironment a -> Action a -> TreeParser a applyAction :: forall a. (Ref a, Show a) => ParserEnvironment a -> Action a -> TreeParser a applyAction ParserEnvironment a env (Return Tree a tree) = case ParserEnvironment a -> Maybe (ParserEnvironment a, ParserContext a) forall a. Ref a => ParserEnvironment a -> Maybe (ParserEnvironment a, ParserContext a) pop ParserEnvironment a env of Maybe (ParserEnvironment a, ParserContext a) Nothing -> Tree a -> TreeParser a forall a. a -> Parser ByteString a forall (m :: * -> *) a. Monad m => a -> m a return Tree a tree Just (ParserEnvironment a env', ParserContext a ctx) -> ParserState a -> TreeParser a forall a. (Ref a, Show a) => ParserState a -> TreeParser a toParser' ParserState { parserEnvironment :: ParserEnvironment a parserEnvironment = ParserEnvironment a env' , parserFocus :: ParserFocus a parserFocus = ParserContext a -> Tree a -> ParserFocus a forall a. Ref a => ParserContext a -> Tree a -> ParserFocus a OnReturn ParserContext a ctx Tree a tree } applyAction ParserEnvironment a env (Split ParserContext a ctx Parseable a p) = let env' :: ParserEnvironment a env' = ParserEnvironment a -> ParserContext a -> ParserEnvironment a forall a. Ref a => ParserEnvironment a -> ParserContext a -> ParserEnvironment a push ParserEnvironment a env ParserContext a ctx in ParserState a -> TreeParser a forall a. (Ref a, Show a) => ParserState a -> TreeParser a toParser' ParserState { parserEnvironment :: ParserEnvironment a parserEnvironment = ParserEnvironment a env' , parserFocus :: ParserFocus a parserFocus = Parseable a -> ParserFocus a forall a. Ref a => Parseable a -> ParserFocus a Before Parseable a p } applyAction ParserEnvironment a env (Branch ParserContext a ctx Parseable a p) = [TreeParser a] -> TreeParser a forall (f :: * -> *) a. Alternative f => [f a] -> f a Attoparsec.choice [ ParserEnvironment a -> Action a -> TreeParser a forall a. (Ref a, Show a) => ParserEnvironment a -> Action a -> TreeParser a applyAction ParserEnvironment a env (ParserContext a -> Parseable a -> Action a forall a. Ref a => ParserContext a -> Parseable a -> Action a Split ParserContext a ctx Parseable a p) , ParserState a -> TreeParser a forall a. (Ref a, Show a) => ParserState a -> TreeParser a toParser' ParserState { parserEnvironment :: ParserEnvironment a parserEnvironment = ParserEnvironment a env, parserFocus :: ParserFocus a parserFocus = ParserContext a -> ParserFocus a forall a. Ref a => ParserContext a -> ParserFocus a OnFailure ParserContext a ctx } ] applyAction ParserEnvironment a env (Parse TreeParser a p) = TreeParser a p TreeParser a -> (Tree a -> TreeParser a) -> TreeParser a forall a b. Parser ByteString a -> (a -> Parser ByteString b) -> Parser ByteString b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \Tree a tree -> ParserState a -> TreeParser a forall a. (Ref a, Show a) => ParserState a -> TreeParser a toParser' ParserState { parserEnvironment :: ParserEnvironment a parserEnvironment = ParserEnvironment a env , parserFocus :: ParserFocus a parserFocus = Tree a -> ParserFocus a forall a. Ref a => Tree a -> ParserFocus a After Tree a tree } applyAction ParserEnvironment a _ (Panic String withMsg) = String -> TreeParser a forall a. String -> Parser ByteString a forall (m :: * -> *) a. MonadFail m => String -> m a fail String withMsg pop :: (Ref a) => ParserEnvironment a -> Maybe (ParserEnvironment a, ParserContext a) pop :: forall a. Ref a => ParserEnvironment a -> Maybe (ParserEnvironment a, ParserContext a) pop ParserEnvironment { parserGrammar :: forall a. ParserEnvironment a -> Dict a parserGrammar = Dict a grammar, parserContextStack :: forall a. ParserEnvironment a -> [ParserContext a] parserContextStack = [ParserContext a] contextStack } = case [ParserContext a] contextStack of [] -> Maybe (ParserEnvironment a, ParserContext a) forall a. Maybe a Nothing ParserContext a ctx : [ParserContext a] rest -> (ParserEnvironment a, ParserContext a) -> Maybe (ParserEnvironment a, ParserContext a) forall a. a -> Maybe a Just (ParserEnvironment { parserGrammar :: Dict a parserGrammar = Dict a grammar, parserContextStack :: [ParserContext a] parserContextStack = [ParserContext a] rest }, ParserContext a ctx) push :: (Ref a) => ParserEnvironment a -> ParserContext a -> ParserEnvironment a push :: forall a. Ref a => ParserEnvironment a -> ParserContext a -> ParserEnvironment a push ParserEnvironment { parserGrammar :: forall a. ParserEnvironment a -> Dict a parserGrammar = Dict a grammar, parserContextStack :: forall a. ParserEnvironment a -> [ParserContext a] parserContextStack = [ParserContext a] contextStack} ParserContext a ctx = ParserEnvironment { parserGrammar :: Dict a parserGrammar = Dict a grammar, parserContextStack :: [ParserContext a] parserContextStack = ParserContext a ctx ParserContext a -> [ParserContext a] -> [ParserContext a] forall a. a -> [a] -> [a] : [ParserContext a] contextStack } toParser' :: (Ref a, Show a) => ParserState a -> TreeParser a toParser' :: forall a. (Ref a, Show a) => ParserState a -> TreeParser a toParser' ParserState a state = let action :: Action a action = case ParserState a -> ParserFocus a forall a. ParserState a -> ParserFocus a parserFocus ParserState a state of Before (Unit String _ TreeParser a p) -> TreeParser a -> Action a forall a. Ref a => TreeParser a -> Action a Parse TreeParser a p Before (Rule a ref) -> let maybeP :: Maybe (Parseable a) maybeP = a -> ParserEnvironment a -> Maybe (Parseable a) forall a. Ref a => a -> ParserEnvironment a -> Maybe (Parseable a) lookupDef a ref (ParserState a -> ParserEnvironment a forall a. ParserState a -> ParserEnvironment a parserEnvironment ParserState a state) in Action a -> (Parseable a -> Action a) -> Maybe (Parseable a) -> Action a forall b a. b -> (a -> b) -> Maybe a -> b maybe (String -> Action a forall a. String -> Action a Panic (String -> Action a) -> String -> Action a forall a b. (a -> b) -> a -> b $ String "undefined " String -> ShowS forall a. [a] -> [a] -> [a] ++ a -> String forall a. Ref a => a -> String Ref.display a ref) (ParserContext a -> Parseable a -> Action a forall a. Ref a => ParserContext a -> Parseable a -> Action a Split RuleContext { ruleRef :: a ruleRef = a ref }) Maybe (Parseable a) maybeP Before (Seq (Parseable a p :| [Parseable a] ps)) -> ParserContext a -> Parseable a -> Action a forall a. Ref a => ParserContext a -> Parseable a -> Action a Split SeqContext { seqPrev :: Tree a seqPrev = Tree a forall a. Ref a => Tree a Tree.empty, seqNext :: [Parseable a] seqNext = [Parseable a] ps } Parseable a p Before (Alt (Parseable a p :| [Parseable a] ps)) -> ParserContext a -> Parseable a -> Action a forall a. Ref a => ParserContext a -> Parseable a -> Action a Branch AltContext { altNext :: [Parseable a] altNext = [Parseable a] ps} Parseable a p Before (Rep Parseable a p Repeat rep) -> let rc :: RepeatCount rc = Repeat -> RepeatCount Repeat.initCount Repeat rep in case RepeatCount -> State Repeat.state RepeatCount rc of State Repeat.Satisfied -> Tree a -> Action a forall a. Ref a => Tree a -> Action a Return Tree a forall a. Ref a => Tree a Tree.empty State Repeat.WantMore -> ParserContext a -> Parseable a -> Action a forall a. Ref a => ParserContext a -> Parseable a -> Action a Branch RepContext { repPrev :: Tree a repPrev = Tree a forall a. Ref a => Tree a Tree.empty, repParse :: Parseable a repParse = Parseable a p, repCount :: RepeatCount repCount = RepeatCount rc } Parseable a p State Repeat.NeedMore -> ParserContext a -> Parseable a -> Action a forall a. Ref a => ParserContext a -> Parseable a -> Action a Split RepContext { repPrev :: Tree a repPrev = Tree a forall a. Ref a => Tree a Tree.empty, repParse :: Parseable a repParse = Parseable a p, repCount :: RepeatCount repCount = RepeatCount rc} Parseable a p OnReturn SeqContext { seqPrev :: forall a. ParserContext a -> Tree a seqPrev = Tree a prev, seqNext :: forall a. ParserContext a -> [Parseable a] seqNext = [Parseable a] next } Tree a tree -> case [Parseable a] next of [] -> Tree a -> Action a forall a. Ref a => Tree a -> Action a Return (Tree a -> Action a) -> Tree a -> Action a forall a b. (a -> b) -> a -> b $ Tree a prev Tree a -> Tree a -> Tree a forall a. Semigroup a => a -> a -> a <> Tree a tree Parseable a p : [Parseable a] next' -> ParserContext a -> Parseable a -> Action a forall a. Ref a => ParserContext a -> Parseable a -> Action a Split SeqContext { seqPrev :: Tree a seqPrev = Tree a prev Tree a -> Tree a -> Tree a forall a. Semigroup a => a -> a -> a <> Tree a tree, seqNext :: [Parseable a] seqNext = [Parseable a] next' } Parseable a p OnReturn AltContext { altNext :: forall a. ParserContext a -> [Parseable a] altNext = [Parseable a] _ } Tree a tree -> Tree a -> Action a forall a. Ref a => Tree a -> Action a Return Tree a tree OnReturn RepContext { repParse :: forall a. ParserContext a -> Parseable a repParse = Parseable a p, repPrev :: forall a. ParserContext a -> Tree a repPrev = Tree a prev, repCount :: forall a. ParserContext a -> RepeatCount repCount = RepeatCount rc } Tree a tree -> case RepeatCount -> Maybe RepeatCount Repeat.tryIncrementCount RepeatCount rc of Maybe RepeatCount Nothing -> String -> Action a forall a. String -> Action a Panic String "repetitions already satisfied" Just RepeatCount rc' -> case RepeatCount -> State Repeat.state RepeatCount rc' of State Repeat.Satisfied -> Tree a -> Action a forall a. Ref a => Tree a -> Action a Return (Tree a -> Action a) -> Tree a -> Action a forall a b. (a -> b) -> a -> b $ Tree a prev Tree a -> Tree a -> Tree a forall a. Semigroup a => a -> a -> a <> Tree a tree State Repeat.WantMore -> ParserContext a -> Parseable a -> Action a forall a. Ref a => ParserContext a -> Parseable a -> Action a Branch RepContext { repPrev :: Tree a repPrev = Tree a prev Tree a -> Tree a -> Tree a forall a. Semigroup a => a -> a -> a <> Tree a tree, repParse :: Parseable a repParse = Parseable a p, repCount :: RepeatCount repCount = RepeatCount rc' } Parseable a p State Repeat.NeedMore -> ParserContext a -> Parseable a -> Action a forall a. Ref a => ParserContext a -> Parseable a -> Action a Split RepContext { repPrev :: Tree a repPrev = Tree a prev Tree a -> Tree a -> Tree a forall a. Semigroup a => a -> a -> a <> Tree a tree, repParse :: Parseable a repParse = Parseable a p, repCount :: RepeatCount repCount = RepeatCount rc' } Parseable a p OnReturn RuleContext { ruleRef :: forall a. ParserContext a -> a ruleRef = a ref } Tree a tree -> Tree a -> Action a forall a. Ref a => Tree a -> Action a Return (Tree a -> Action a) -> Tree a -> Action a forall a b. (a -> b) -> a -> b $ Node a -> Tree a forall a. Ref a => Node a -> Tree a Tree.singleton (Node a -> Tree a) -> Node a -> Tree a forall a b. (a -> b) -> a -> b $ a -> Tree a -> Node a forall a. Ref a => a -> Tree a -> Node a Tree.RefNode a ref Tree a tree OnFailure AltContext { altNext :: forall a. ParserContext a -> [Parseable a] altNext = [Parseable a] next } -> case [Parseable a] next of [] -> String -> Action a forall a. String -> Action a Panic String "no more alts" Parseable a p : [Parseable a] next' -> ParserContext a -> Parseable a -> Action a forall a. Ref a => ParserContext a -> Parseable a -> Action a Branch AltContext { altNext :: [Parseable a] altNext = [Parseable a] next' } Parseable a p OnFailure RepContext { repParse :: forall a. ParserContext a -> Parseable a repParse = Parseable a _, repPrev :: forall a. ParserContext a -> Tree a repPrev = Tree a prev, repCount :: forall a. ParserContext a -> RepeatCount repCount = RepeatCount rc } -> case RepeatCount -> State Repeat.state RepeatCount rc of State Repeat.NeedMore -> String -> Action a forall a. String -> Action a Panic String "more repetitions required" State _ -> Tree a -> Action a forall a. Ref a => Tree a -> Action a Return Tree a prev OnFailure ParserContext a _ -> String -> Action a forall a. String -> Action a Panic String "failure in non-safeguarded context" After Tree a tree -> Tree a -> Action a forall a. Ref a => Tree a -> Action a Return Tree a tree in ParserEnvironment a -> Action a -> TreeParser a forall a. (Ref a, Show a) => ParserEnvironment a -> Action a -> TreeParser a applyAction (ParserState a -> ParserEnvironment a forall a. ParserState a -> ParserEnvironment a parserEnvironment ParserState a state) Action a action lookupDef :: Ref a => a -> ParserEnvironment a -> Maybe (Parseable a) lookupDef :: forall a. Ref a => a -> ParserEnvironment a -> Maybe (Parseable a) lookupDef a ref ParserEnvironment a env = a -> Dict a -> Maybe (Parseable a) forall a. Ref a => a -> Dict a -> Maybe (Parseable a) lookupDef' a ref (ParserEnvironment a -> Dict a forall a. ParserEnvironment a -> Dict a parserGrammar ParserEnvironment a env) lookupDef' :: Ref a => a -> Dict a -> Maybe (Parseable a) lookupDef' :: forall a. Ref a => a -> Dict a -> Maybe (Parseable a) lookupDef' a ref Dict a grammar = [Parseable a] -> Maybe (Parseable a) forall a. Ref a => [Parseable a] -> Maybe (Parseable a) alts ([Parseable a] -> Maybe (Parseable a)) -> [Parseable a] -> Maybe (Parseable a) forall a b. (a -> b) -> a -> b $ a -> Dict a -> [Parseable a] forall a b. a -> RefDict a b -> [b] RefDict.lookup a ref Dict a grammar