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

import Data.List qualified as List
import Data.Functor ( (<&>) )

import Data.BAByNF.Core.Tree (Tree)
import Data.BAByNF.Core.Tree qualified as Tree
import Data.BAByNF.Util.Ascii qualified as Ascii
import Data.BAByNF.ABNF.Rules.QuotedString qualified as QuotedString
import Data.BAByNF.ABNF.Model qualified as Model

ref :: Model.Rulename
ref :: Rulename
ref = ByteString -> Rulename
Model.Rulename (String -> ByteString
Ascii.stringAsBytesUnsafe String
"case-insensitive-string")

rule :: Model.Rule
rule :: Rule
rule = Rulename -> DefinedAs -> Elements -> Rule
Model.Rule Rulename
ref DefinedAs
Model.BasicDefinition
    (Elements -> Rule)
-> ([Repetition] -> Elements) -> [Repetition] -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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] -> Rule) -> [Repetition] -> Rule
forall a b. (a -> b) -> a -> b
$
        [ Repeat -> Element -> Repetition
Model.Repetition Repeat
Model.NoRepeat
            (Element -> Repetition)
-> (ByteString -> Element) -> ByteString -> Repetition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Option -> Element
Model.OptionElement
            (Option -> Element)
-> (ByteString -> Option) -> ByteString -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alternation -> Option
Model.Option
            (Alternation -> Option)
-> (ByteString -> Alternation) -> ByteString -> Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Concatenation] -> Alternation
Model.Alternation
            ([Concatenation] -> Alternation)
-> (ByteString -> [Concatenation]) -> ByteString -> Alternation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Concatenation -> [Concatenation]
forall a. a -> [a]
List.singleton
            (Concatenation -> [Concatenation])
-> (ByteString -> Concatenation) -> ByteString -> [Concatenation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [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 -> Repetition) -> ByteString -> Repetition
forall a b. (a -> b) -> a -> b
$ String -> ByteString
Ascii.stringAsBytesUnsafe String
"%i"
        , 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 -> Repetition) -> Rulename -> Repetition
forall a b. (a -> b) -> a -> b
$ Rulename
QuotedString.ref
        ]

fromTree :: Tree Model.Rulename -> Either String Model.CaseInsensitiveString
fromTree :: Tree Rulename -> Either String CaseInsensitiveString
fromTree Tree Rulename
tree = Either String QuotedString
-> (Tree Rulename -> Either String QuotedString)
-> Maybe (Tree Rulename)
-> Either String QuotedString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String QuotedString
forall a b. a -> Either a b
Left String
"no quoted-string") 
    Tree Rulename -> Either String QuotedString
QuotedString.fromTree (Rulename -> Tree Rulename -> Maybe (Tree Rulename)
forall a. a -> Tree a -> Maybe (Tree a)
Tree.getChildWithRef Rulename
QuotedString.ref Tree Rulename
tree) 
    Either String QuotedString
-> (QuotedString -> CaseInsensitiveString)
-> Either String CaseInsensitiveString
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> QuotedString -> CaseInsensitiveString
Model.CaseInsensitiveString