{-# LANGUAGE LambdaCase #-} module Data.BAByNF.ABNF.Rules.Group ( ref , rule , fromTree ) where import Data.Functor ((<&>)) import Data.List qualified as List import Data.BAByNF.Util.Ascii qualified as Ascii import Data.BAByNF.Core.Ref qualified as Ref import Data.BAByNF.Core.Tree (Tree) import Data.BAByNF.Core.Tree qualified as Tree import {-# SOURCE #-} Data.BAByNF.ABNF.Rules.Alternation qualified as Alternation import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp import Data.BAByNF.ABNF.Model qualified as Model ref :: Model.Rulename ref :: Rulename ref = ByteString -> Rulename Model.Rulename (String -> ByteString Ascii.stringAsBytesUnsafe String "group") rule :: Model.Rule rule :: Rule rule = Rulename -> DefinedAs -> Elements -> Rule Model.Rule Rulename ref DefinedAs Model.BasicDefinition (Elements -> Rule) -> ([Repetition] -> Elements) -> [Repetition] -> Rule forall b c a. (b -> c) -> (a -> b) -> a -> c . Alternation -> Elements Model.Elements (Alternation -> Elements) -> ([Repetition] -> Alternation) -> [Repetition] -> Elements forall b c a. (b -> c) -> (a -> b) -> a -> c . [Concatenation] -> Alternation Model.Alternation ([Concatenation] -> Alternation) -> ([Repetition] -> [Concatenation]) -> [Repetition] -> Alternation forall b c a. (b -> c) -> (a -> b) -> a -> c . Concatenation -> [Concatenation] forall a. a -> [a] List.singleton (Concatenation -> [Concatenation]) -> ([Repetition] -> Concatenation) -> [Repetition] -> [Concatenation] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Repetition] -> Concatenation Model.Concatenation ([Repetition] -> Rule) -> [Repetition] -> Rule forall a b. (a -> b) -> a -> b $ [ Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Element -> Repetition) -> (QuotedString -> Element) -> QuotedString -> Repetition forall b c a. (b -> c) -> (a -> b) -> a -> c . CharVal -> Element Model.CharValElement (CharVal -> Element) -> (QuotedString -> CharVal) -> QuotedString -> Element forall b c a. (b -> c) -> (a -> b) -> a -> c . CaseInsensitiveString -> CharVal Model.CaseInsensitiveCharVal (CaseInsensitiveString -> CharVal) -> (QuotedString -> CaseInsensitiveString) -> QuotedString -> CharVal forall b c a. (b -> c) -> (a -> b) -> a -> c . QuotedString -> CaseInsensitiveString Model.CaseInsensitiveString (QuotedString -> Repetition) -> QuotedString -> Repetition forall a b. (a -> b) -> a -> b $ ByteString -> QuotedString Model.QuotedString (String -> ByteString Ascii.stringAsBytesUnsafe String "(") , Repeat -> Element -> Repetition Model.Repetition (Bound -> Bound -> Repeat Model.RangedRepeat Bound Model.UnBound Bound Model.UnBound) (Rulename -> Element Model.RulenameElement Rulename CWsp.ref) , Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Rulename -> Element Model.RulenameElement Rulename Alternation.ref) , Repeat -> Element -> Repetition Model.Repetition (Bound -> Bound -> Repeat Model.RangedRepeat Bound Model.UnBound Bound Model.UnBound) (Rulename -> Element Model.RulenameElement Rulename CWsp.ref) , Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Element -> Repetition) -> (QuotedString -> Element) -> QuotedString -> Repetition forall b c a. (b -> c) -> (a -> b) -> a -> c . CharVal -> Element Model.CharValElement (CharVal -> Element) -> (QuotedString -> CharVal) -> QuotedString -> Element forall b c a. (b -> c) -> (a -> b) -> a -> c . CaseInsensitiveString -> CharVal Model.CaseInsensitiveCharVal (CaseInsensitiveString -> CharVal) -> (QuotedString -> CaseInsensitiveString) -> QuotedString -> CharVal forall b c a. (b -> c) -> (a -> b) -> a -> c . QuotedString -> CaseInsensitiveString Model.CaseInsensitiveString (QuotedString -> Repetition) -> QuotedString -> Repetition forall a b. (a -> b) -> a -> b $ ByteString -> QuotedString Model.QuotedString (String -> ByteString Ascii.stringAsBytesUnsafe String ")") ] fromTree :: Tree Model.Rulename -> Either String Model.Group fromTree :: Tree Rulename -> Either String Group fromTree Tree Rulename tree = let nodes :: [Node Rulename] nodes = Tree Rulename -> [Node Rulename] forall a. Ref a => Tree a -> [Node a] Tree.nodes Tree Rulename tree in ([Node Rulename] -> Either String [Node Rulename] forall {a}. [Node a] -> Either String [Node a] tryDropLeftParens [Node Rulename] nodes Either String [Node Rulename] -> ([Node Rulename] -> Either String (Tree Rulename, [Node Rulename])) -> Either String (Tree Rulename, [Node Rulename]) forall a b. Either String a -> (a -> Either String b) -> Either String b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (\case (Tree.RefNode Rulename r Tree Rulename subtree):[Node Rulename] rest | Rulename -> Rulename -> Bool forall a. Ref a => a -> a -> Bool Ref.eq Rulename Alternation.ref Rulename r -> (Tree Rulename, [Node Rulename]) -> Either String (Tree Rulename, [Node Rulename]) forall a b. b -> Either a b Right (Tree Rulename subtree, [Node Rulename] rest) | Bool otherwise -> String -> Either String (Tree Rulename, [Node Rulename]) forall a b. a -> Either a b Left String "group must contain alternation" [Node Rulename] _ -> String -> Either String (Tree Rulename, [Node Rulename]) forall a b. a -> Either a b Left String "structural mismatch for <group>" ) ([Node Rulename] -> Either String (Tree Rulename, [Node Rulename])) -> ([Node Rulename] -> [Node Rulename]) -> [Node Rulename] -> Either String (Tree Rulename, [Node Rulename]) forall b c a. (b -> c) -> (a -> b) -> a -> c . [Node Rulename] -> [Node Rulename] dropCWsp) Either String (Tree Rulename, [Node Rulename]) -> ((Tree Rulename, [Node Rulename]) -> Either String Group) -> Either String Group forall a b. Either String a -> (a -> Either String b) -> Either String b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \(Tree Rulename altSubtree, [Node Rulename] rest) -> ([Node Rulename] -> Either String [Node Rulename] forall {a}. [Node a] -> Either String [Node a] tryDropRightParens ([Node Rulename] -> Either String [Node Rulename]) -> ([Node Rulename] -> [Node Rulename]) -> [Node Rulename] -> Either String [Node Rulename] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Node Rulename] -> [Node Rulename] dropCWsp ([Node Rulename] -> Either String [Node Rulename]) -> [Node Rulename] -> Either String [Node Rulename] forall a b. (a -> b) -> a -> b $ [Node Rulename] rest) Either String [Node Rulename] -> ([Node Rulename] -> Either String Group) -> Either String Group forall a b. Either String a -> (a -> Either String b) -> Either String b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case [] -> Tree Rulename -> Either String Alternation Alternation.fromTree Tree Rulename altSubtree Either String Alternation -> (Alternation -> Group) -> Either String Group forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> Alternation -> Group Model.Group [Node Rulename] _ -> String -> Either String Group forall a b. a -> Either a b Left String "structural mismatch for <group>" where tryDropLeftParens :: [Node a] -> Either String [Node a] tryDropLeftParens [Node a] nodes = case [Node a] nodes of (Tree.StringNode ByteString bs):[Node a] rest | ByteString bs ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == String -> ByteString Ascii.stringAsBytesUnsafe String "(" -> [Node a] -> Either String [Node a] forall a b. b -> Either a b Right [Node a] rest | Bool otherwise -> String -> Either String [Node a] forall a b. a -> Either a b Left String "structural mismatch for <group>" [Node a] _ -> String -> Either String [Node a] forall a b. a -> Either a b Left String "structural mismatch for <group>" dropCWsp :: [Node Rulename] -> [Node Rulename] dropCWsp = (Node Rulename -> Bool) -> [Node Rulename] -> [Node Rulename] forall a. (a -> Bool) -> [a] -> [a] dropWhile (Node Rulename -> Rulename -> Bool forall a. Ref a => Node a -> a -> Bool `Tree.isRefOf` Rulename CWsp.ref) tryDropRightParens :: [Node a] -> Either String [Node a] tryDropRightParens [Node a] nodes = case [Node a] nodes of (Tree.StringNode ByteString bs):[Node a] rest | ByteString bs ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == String -> ByteString Ascii.stringAsBytesUnsafe String ")" -> [Node a] -> Either String [Node a] forall a b. b -> Either a b Right [Node a] rest | Bool otherwise -> String -> Either String [Node a] forall a b. a -> Either a b Left String "structural mismatch for <group>" [Node a] _ -> String -> Either String [Node a] forall a b. a -> Either a b Left String "structural mismatch for <group>"