module Data.BAByNF.ABNF.Rules.CNl
    ( 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.Rules.Comment qualified as Comment
import Data.BAByNF.ABNF.Model qualified as Model


ref :: Model.Rulename
ref :: Rulename
ref = ByteString -> Rulename
Model.Rulename (String -> ByteString
Ascii.stringAsBytesUnsafe String
"c-nl")

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] -> 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
Comment.ref
        , [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.crlfRef
        ]