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

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

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

fromTree :: Tree Model.Rulename -> Either [String] Model.Rulelist
fromTree :: Tree Rulename -> Either [String] Rulelist
fromTree Tree Rulename
tree =
    let errorsAndDecls :: ([String], [Rule])
errorsAndDecls = [Either String Rule] -> ([String], [Rule])
forall l r. [Either l r] -> ([l], [r])
groupBySide ([Either String Rule] -> ([String], [Rule]))
-> [Either String Rule] -> ([String], [Rule])
forall a b. (a -> b) -> a -> b
$ (Tree Rulename -> Either String Rule)
-> [Tree Rulename] -> [Either String Rule]
forall a b. (a -> b) -> [a] -> [b]
map Tree Rulename -> Either String Rule
Rule.fromTree ([Tree Rulename] -> [Either String Rule])
-> [Tree Rulename] -> [Either String Rule]
forall a b. (a -> b) -> a -> b
$
            Rulename -> Tree Rulename -> [Tree Rulename]
forall a. a -> Tree a -> [Tree a]
Tree.getChildrenWithRef Rulename
Rule.ref Tree Rulename
tree
     in case ([String], [Rule])
errorsAndDecls of
        (String
err:[String]
errors, [Rule]
_) -> [String] -> Either [String] Rulelist
forall a b. a -> Either a b
Left ([String] -> Either [String] Rulelist)
-> [String] -> Either [String] Rulelist
forall a b. (a -> b) -> a -> b
$ String
err String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
errors
        ([], [Rule]
decls) -> Rulelist -> Either [String] Rulelist
forall a b. b -> Either a b
Right (Rulelist -> Either [String] Rulelist)
-> Rulelist -> Either [String] Rulelist
forall a b. (a -> b) -> a -> b
$ [Rule] -> Rulelist
Model.Rulelist [Rule]
decls
    where groupBySide :: [Either l r] -> ([l], [r])
          groupBySide :: forall l r. [Either l r] -> ([l], [r])
groupBySide = (Either l r -> ([l], [r]) -> ([l], [r]))
-> ([l], [r]) -> [Either l r] -> ([l], [r])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Either l r
lr ([l]
ls, [r]
rs) -> case Either l r
lr of Left l
l -> (l
ll -> [l] -> [l]
forall a. a -> [a] -> [a]
:[l]
ls, [r]
rs); Right r
r -> ([l]
ls, r
rr -> [r] -> [r]
forall a. a -> [a] -> [a]
:[r]
rs)) ([], [])