module Data.BAByNF.ABNF.Rules.DefinedAs
    ( ref
    , rule
    , fromTree
    ) where

import Data.List qualified as List

import Data.BAByNF.Util.Ascii qualified as Ascii
import Data.BAByNF.Util.List qualified as Util.List
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.Model qualified as Model

ref :: Model.Rulename
ref :: Rulename
ref = ByteString -> Rulename
Model.Rulename (String -> ByteString
Ascii.stringAsBytesUnsafe String
"defined-as")

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 (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) -> 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)
-> (ByteString -> [Repetition]) -> ByteString -> Concatenation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repetition -> [Repetition]
forall a. a -> [a]
List.singleton
                    (Repetition -> [Repetition])
-> (ByteString -> Repetition) -> ByteString -> [Repetition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repeat -> Element -> Repetition
Model.Repetition Repeat
Model.NoRepeat
                    (Element -> Repetition)
-> (ByteString -> Element) -> ByteString -> Repetition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Concatenation) -> ByteString -> Concatenation
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Ascii.stringAsBytesUnsafe String
"="
                , [Repetition] -> Concatenation
Model.Concatenation
                    ([Repetition] -> Concatenation)
-> (ByteString -> [Repetition]) -> ByteString -> Concatenation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repetition -> [Repetition]
forall a. a -> [a]
List.singleton
                    (Repetition -> [Repetition])
-> (ByteString -> Repetition) -> ByteString -> [Repetition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repeat -> Element -> Repetition
Model.Repetition Repeat
Model.NoRepeat
                    (Element -> Repetition)
-> (ByteString -> Element) -> ByteString -> Repetition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> Concatenation) -> ByteString -> Concatenation
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) (Rulename -> Element
Model.RulenameElement Rulename
CWsp.ref)
    ]

fromTree :: Tree Model.Rulename -> Either String Model.DefinedAs
fromTree :: Tree Rulename -> Either String DefinedAs
fromTree Tree Rulename
tree =
    let ([Node Rulename]
_, [Node Rulename]
mid, [Node Rulename]
_) = [Node Rulename]
-> (Node Rulename -> Bool)
-> ([Node Rulename], [Node Rulename], [Node Rulename])
forall a. Show a => [a] -> (a -> Bool) -> ([a], [a], [a])
Util.List.lrsplitWhenNot (Tree Rulename -> [Node Rulename]
forall a. Ref a => Tree a -> [Node a]
Tree.nodes Tree Rulename
tree) Node Rulename -> Bool
isCWsp
     in case [Node Rulename]
mid of
        [Tree.StringNode ByteString
x] | ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
Ascii.stringAsBytesUnsafe String
"=" -> DefinedAs -> Either String DefinedAs
forall a b. b -> Either a b
Right DefinedAs
Model.BasicDefinition
                            | ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
Ascii.stringAsBytesUnsafe String
"=/" -> DefinedAs -> Either String DefinedAs
forall a b. b -> Either a b
Right DefinedAs
Model.IncrementalAlternative
                            | Bool
otherwise -> String -> Either String DefinedAs
forall a b. a -> Either a b
Left String
"DefinedAs must be \'=\' | \'=/\'"
        [Node Rulename]
_ -> String -> Either String DefinedAs
forall a b. a -> Either a b
Left String
"structural mismatch for <defined-as>"
    where isCWsp :: Node Rulename -> Bool
isCWsp Node Rulename
node = Node Rulename -> Rulename -> Bool
forall a. Ref a => Node a -> a -> Bool
Tree.isRefOf Node Rulename
node Rulename
CWsp.ref