module Data.BAByNF.ABNF.Rules.Rulelist ( ref , rule , fromTree ) where import Data.List qualified as List import Data.BAByNF.Util.Ascii qualified as Ascii import Data.BAByNF.Core.Tree (Tree) import Data.BAByNF.Core.Tree qualified as Tree import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp import Data.BAByNF.ABNF.Rules.CNl qualified as CNl import Data.BAByNF.ABNF.Rules.Rule qualified as Rule import Data.BAByNF.ABNF.Model qualified as Model ref :: Model.Rulename ref :: Rulename ref = ByteString -> Rulename Model.Rulename (String -> ByteString Ascii.stringAsBytesUnsafe String "rulelist") rule :: Model.Rule rule :: Rule rule = Rulename -> DefinedAs -> Elements -> Rule Model.Rule Rulename ref DefinedAs Model.BasicDefinition (Elements -> Rule) -> Elements -> Rule forall a b. (a -> b) -> a -> b $ Alternation -> Elements Model.Elements (Alternation -> Elements) -> ([Concatenation] -> Alternation) -> [Concatenation] -> Elements forall b c a. (b -> c) -> (a -> b) -> a -> c . [Concatenation] -> Alternation Model.Alternation ([Concatenation] -> Alternation) -> ([Concatenation] -> [Concatenation]) -> [Concatenation] -> Alternation forall b c a. (b -> c) -> (a -> b) -> a -> c . Concatenation -> [Concatenation] forall a. a -> [a] List.singleton (Concatenation -> [Concatenation]) -> ([Concatenation] -> Concatenation) -> [Concatenation] -> [Concatenation] forall b c a. (b -> c) -> (a -> b) -> a -> c . [Repetition] -> Concatenation Model.Concatenation ([Repetition] -> Concatenation) -> ([Concatenation] -> [Repetition]) -> [Concatenation] -> Concatenation forall b c a. (b -> c) -> (a -> b) -> a -> c . Repetition -> [Repetition] forall a. a -> [a] List.singleton (Repetition -> [Repetition]) -> ([Concatenation] -> Repetition) -> [Concatenation] -> [Repetition] forall b c a. (b -> c) -> (a -> b) -> a -> c . Repeat -> Element -> Repetition Model.Repetition (Bound -> Bound -> Repeat Model.RangedRepeat (Integer -> Bound Model.FixedBound Integer 1) Bound Model.UnBound) (Element -> Repetition) -> ([Concatenation] -> Element) -> [Concatenation] -> Repetition forall b c a. (b -> c) -> (a -> b) -> a -> c . Group -> Element Model.GroupElement (Group -> Element) -> ([Concatenation] -> Group) -> [Concatenation] -> Element forall b c a. (b -> c) -> (a -> b) -> a -> c . Alternation -> Group Model.Group (Alternation -> Group) -> ([Concatenation] -> Alternation) -> [Concatenation] -> Group forall b c a. (b -> c) -> (a -> b) -> a -> c . [Concatenation] -> Alternation Model.Alternation ([Concatenation] -> Elements) -> [Concatenation] -> Elements forall a b. (a -> b) -> a -> b $ [ [Repetition] -> Concatenation Model.Concatenation ([Repetition] -> Concatenation) -> (Rulename -> [Repetition]) -> Rulename -> Concatenation forall b c a. (b -> c) -> (a -> b) -> a -> c . Repetition -> [Repetition] forall a. a -> [a] List.singleton (Repetition -> [Repetition]) -> (Rulename -> Repetition) -> Rulename -> [Repetition] forall b c a. (b -> c) -> (a -> b) -> a -> c . Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Element -> Repetition) -> (Rulename -> Element) -> Rulename -> Repetition forall b c a. (b -> c) -> (a -> b) -> a -> c . Rulename -> Element Model.RulenameElement (Rulename -> Concatenation) -> Rulename -> Concatenation forall a b. (a -> b) -> a -> b $ Rulename Rule.ref , [Repetition] -> Concatenation Model.Concatenation ([Repetition] -> Concatenation) -> ([Repetition] -> [Repetition]) -> [Repetition] -> Concatenation forall b c a. (b -> c) -> (a -> b) -> a -> c . Repetition -> [Repetition] forall a. a -> [a] List.singleton (Repetition -> [Repetition]) -> ([Repetition] -> Repetition) -> [Repetition] -> [Repetition] forall b c a. (b -> c) -> (a -> b) -> a -> c . Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Element -> Repetition) -> ([Repetition] -> Element) -> [Repetition] -> Repetition forall b c a. (b -> c) -> (a -> b) -> a -> c . Group -> Element Model.GroupElement (Group -> Element) -> ([Repetition] -> Group) -> [Repetition] -> Element forall b c a. (b -> c) -> (a -> b) -> a -> c . Alternation -> Group Model.Group (Alternation -> Group) -> ([Repetition] -> Alternation) -> [Repetition] -> Group 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] -> Concatenation) -> [Repetition] -> Concatenation forall a b. (a -> b) -> a -> b $ [ Repeat -> Element -> Repetition Model.Repetition (Bound -> Bound -> Repeat Model.RangedRepeat Bound Model.UnBound Bound Model.UnBound) (Element -> Repetition) -> Element -> Repetition forall a b. (a -> b) -> a -> b $ Rulename -> Element Model.RulenameElement Rulename CWsp.ref , Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Element -> Repetition) -> Element -> Repetition forall a b. (a -> b) -> a -> b $ Rulename -> Element Model.RulenameElement Rulename CNl.ref ] ] fromTree :: Tree Model.Rulename -> Either [String] Model.Rulelist fromTree :: Tree Rulename -> Either [String] Rulelist fromTree Tree Rulename tree = let errorsAndDecls :: ([String], [Rule]) errorsAndDecls = [Either String Rule] -> ([String], [Rule]) forall l r. [Either l r] -> ([l], [r]) groupBySide ([Either String Rule] -> ([String], [Rule])) -> [Either String Rule] -> ([String], [Rule]) forall a b. (a -> b) -> a -> b $ (Tree Rulename -> Either String Rule) -> [Tree Rulename] -> [Either String Rule] forall a b. (a -> b) -> [a] -> [b] map Tree Rulename -> Either String Rule Rule.fromTree ([Tree Rulename] -> [Either String Rule]) -> [Tree Rulename] -> [Either String Rule] forall a b. (a -> b) -> a -> b $ Rulename -> Tree Rulename -> [Tree Rulename] forall a. a -> Tree a -> [Tree a] Tree.getChildrenWithRef Rulename Rule.ref Tree Rulename tree in case ([String], [Rule]) errorsAndDecls of (String err:[String] errors, [Rule] _) -> [String] -> Either [String] Rulelist forall a b. a -> Either a b Left ([String] -> Either [String] Rulelist) -> [String] -> Either [String] Rulelist forall a b. (a -> b) -> a -> b $ String err String -> [String] -> [String] forall a. a -> [a] -> [a] : [String] errors ([], [Rule] decls) -> Rulelist -> Either [String] Rulelist forall a b. b -> Either a b Right (Rulelist -> Either [String] Rulelist) -> Rulelist -> Either [String] Rulelist forall a b. (a -> b) -> a -> b $ [Rule] -> Rulelist Model.Rulelist [Rule] decls where groupBySide :: [Either l r] -> ([l], [r]) groupBySide :: forall l r. [Either l r] -> ([l], [r]) groupBySide = (Either l r -> ([l], [r]) -> ([l], [r])) -> ([l], [r]) -> [Either l r] -> ([l], [r]) forall a b. (a -> b -> b) -> b -> [a] -> b forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr (\Either l r lr ([l] ls, [r] rs) -> case Either l r lr of Left l l -> (l ll -> [l] -> [l] forall a. a -> [a] -> [a] :[l] ls, [r] rs); Right r r -> ([l] ls, r rr -> [r] -> [r] forall a. a -> [a] -> [a] :[r] rs)) ([], [])