module Data.BAByNF.ABNF.Rules.Comment ( ref , rule ) where import Data.List qualified as List import Data.BAByNF.Util.Ascii qualified as Ascii import Data.BAByNF.ABNF.Core qualified as Core import Data.BAByNF.ABNF.Model qualified as Model ref :: Model.Rulename ref :: Rulename ref = ByteString -> Rulename Model.Rulename (String -> ByteString Ascii.stringAsBytesUnsafe String "comment") 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) -> ([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] -> Elements) -> [Repetition] -> Elements forall a b. (a -> b) -> a -> b $ [ Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Element -> Repetition) -> Element -> Repetition forall a b. (a -> b) -> a -> b $ CharVal -> Element Model.CharValElement (CharVal -> Element) -> (ByteString -> CharVal) -> ByteString -> Element forall b c a. (b -> c) -> (a -> b) -> a -> c . CaseInsensitiveString -> CharVal Model.CaseInsensitiveCharVal (CaseInsensitiveString -> CharVal) -> (ByteString -> CaseInsensitiveString) -> ByteString -> CharVal forall b c a. (b -> c) -> (a -> b) -> a -> c . QuotedString -> CaseInsensitiveString Model.CaseInsensitiveString (QuotedString -> CaseInsensitiveString) -> (ByteString -> QuotedString) -> ByteString -> CaseInsensitiveString forall b c a. (b -> c) -> (a -> b) -> a -> c . ByteString -> QuotedString Model.QuotedString (ByteString -> Element) -> ByteString -> Element forall a b. (a -> b) -> a -> b $ String -> ByteString Ascii.stringAsBytesUnsafe String ";" , 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 $ 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] -> Element) -> [Concatenation] -> Element 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 Core.wspRef , [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 Core.vcharRef ] , Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Element -> Repetition) -> Element -> Repetition forall a b. (a -> b) -> a -> b $ Rulename -> Element Model.RulenameElement Rulename Core.crlfRef ]