module Data.BAByNF.ABNF.Rules.Rulename
    ( 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.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
"rulename")

rule :: Model.Rule
rule :: Rule
rule = Rulename -> DefinedAs -> Elements -> Rule
Model.Rule Rulename
ref DefinedAs
Model.BasicDefinition 
    (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 (Rulename -> Element
Model.RulenameElement Rulename
Core.alphaRef)
        , 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)
-> (Repetition -> [Repetition]) -> Repetition -> Concatenation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repetition -> [Repetition]
forall a. a -> [a]
List.singleton (Repetition -> Concatenation) -> Repetition -> Concatenation
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
$ Rulename -> Element
Model.RulenameElement Rulename
Core.alphaRef
                , [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 -> Concatenation) -> Repetition -> Concatenation
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
$ Rulename -> Element
Model.RulenameElement Rulename
Core.digitRef
                , [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 -> Concatenation) -> Repetition -> Concatenation
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
"-"
                ]
        
    ])

fromTree :: Tree Model.Rulename -> Model.Rulename
fromTree :: Tree Rulename -> Rulename
fromTree = ByteString -> Rulename
Model.Rulename (ByteString -> Rulename)
-> (Tree Rulename -> ByteString) -> Tree Rulename -> Rulename
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree Rulename -> ByteString
forall a. Tree a -> ByteString
Tree.stringify