{-# LANGUAGE LambdaCase #-}
module Data.BAByNF.ABNF.Rules.Concatenation
    ( 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.Rules.Repetition qualified as Repetition
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
"concatenation")

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 (Rulename -> Element
Model.RulenameElement Rulename
Repetition.ref)
        , Repeat -> Element -> Repetition
Model.Repetition (Bound -> Bound -> Repeat
Model.RangedRepeat Bound
Model.UnBound Bound
Model.UnBound) 
            (Element -> Repetition)
-> ([Repetition] -> Element) -> [Repetition] -> Repetition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Group -> Element
Model.GroupElement
            (Group -> Element)
-> ([Repetition] -> Group) -> [Repetition] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alternation -> Group
Model.Group
            (Alternation -> Group)
-> ([Repetition] -> Alternation) -> [Repetition] -> Group
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] -> Repetition) -> [Repetition] -> Repetition
forall a b. (a -> b) -> a -> b
$
                [ Repeat -> Element -> Repetition
Model.Repetition (Bound -> Bound -> Repeat
Model.RangedRepeat (Integer -> Bound
Model.FixedBound Integer
1) Bound
Model.UnBound) (Rulename -> Element
Model.RulenameElement Rulename
CWsp.ref) 
                , Repeat -> Element -> Repetition
Model.Repetition Repeat
Model.NoRepeat (Rulename -> Element
Model.RulenameElement Rulename
Repetition.ref)
                ]
        ]

fromTree :: Tree Model.Rulename -> Either String Model.Concatenation
fromTree :: Tree Rulename -> Either String Concatenation
fromTree Tree Rulename
tree = (Tree Rulename -> Either String Repetition)
-> [Tree Rulename] -> Either String [Repetition]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Tree Rulename -> Either String Repetition
Repetition.fromTree 
    ( 
        Rulename -> Tree Rulename -> [Tree Rulename]
forall a. a -> Tree a -> [Tree a]
Tree.getChildrenWithRef Rulename
Repetition.ref Tree Rulename
tree
    ) Either String [Repetition]
-> ([Repetition] -> Either String Concatenation)
-> Either String Concatenation
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case 
        [] -> String -> Either String Concatenation
forall a b. a -> Either a b
Left String
"empty concat"
        [Repetition]
x -> Concatenation -> Either String Concatenation
forall a b. b -> Either a b
Right (Concatenation -> Either String Concatenation)
-> Concatenation -> Either String Concatenation
forall a b. (a -> b) -> a -> b
$ [Repetition] -> Concatenation
Model.Concatenation [Repetition]
x