{-# LANGUAGE LambdaCase #-}
module Data.BAByNF.ABNF.Rules.Group
    ( ref
    , rule
    , fromTree
    ) where

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

import Data.BAByNF.Util.Ascii qualified as Ascii

import Data.BAByNF.Core.Ref qualified as Ref
import Data.BAByNF.Core.Tree (Tree)
import Data.BAByNF.Core.Tree qualified as Tree

import {-# SOURCE #-} Data.BAByNF.ABNF.Rules.Alternation qualified as Alternation
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
"group")

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)
-> (QuotedString -> Element) -> QuotedString -> Repetition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharVal -> Element
Model.CharValElement
            (CharVal -> Element)
-> (QuotedString -> CharVal) -> QuotedString -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaseInsensitiveString -> CharVal
Model.CaseInsensitiveCharVal
            (CaseInsensitiveString -> CharVal)
-> (QuotedString -> CaseInsensitiveString)
-> QuotedString
-> CharVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuotedString -> CaseInsensitiveString
Model.CaseInsensitiveString
            (QuotedString -> Repetition) -> QuotedString -> Repetition
forall a b. (a -> b) -> a -> b
$ ByteString -> QuotedString
Model.QuotedString (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)
        , Repeat -> Element -> Repetition
Model.Repetition Repeat
Model.NoRepeat (Rulename -> Element
Model.RulenameElement Rulename
Alternation.ref)
        , 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)
-> (QuotedString -> Element) -> QuotedString -> Repetition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CharVal -> Element
Model.CharValElement
            (CharVal -> Element)
-> (QuotedString -> CharVal) -> QuotedString -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CaseInsensitiveString -> CharVal
Model.CaseInsensitiveCharVal
            (CaseInsensitiveString -> CharVal)
-> (QuotedString -> CaseInsensitiveString)
-> QuotedString
-> CharVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QuotedString -> CaseInsensitiveString
Model.CaseInsensitiveString
            (QuotedString -> Repetition) -> QuotedString -> Repetition
forall a b. (a -> b) -> a -> b
$ ByteString -> QuotedString
Model.QuotedString (String -> ByteString
Ascii.stringAsBytesUnsafe String
")")
        ]

fromTree :: Tree Model.Rulename -> Either String Model.Group
fromTree :: Tree Rulename -> Either String Group
fromTree Tree Rulename
tree =
    let nodes :: [Node Rulename]
nodes = Tree Rulename -> [Node Rulename]
forall a. Ref a => Tree a -> [Node a]
Tree.nodes Tree Rulename
tree
     in ([Node Rulename] -> Either String [Node Rulename]
forall {a}. [Node a] -> Either String [Node a]
tryDropLeftParens [Node Rulename]
nodes
        Either String [Node Rulename]
-> ([Node Rulename]
    -> Either String (Tree Rulename, [Node Rulename]))
-> Either String (Tree Rulename, [Node Rulename])
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
                (Tree.RefNode Rulename
r Tree Rulename
subtree):[Node Rulename]
rest
                     | Rulename -> Rulename -> Bool
forall a. Ref a => a -> a -> Bool
Ref.eq Rulename
Alternation.ref Rulename
r -> (Tree Rulename, [Node Rulename])
-> Either String (Tree Rulename, [Node Rulename])
forall a b. b -> Either a b
Right (Tree Rulename
subtree, [Node Rulename]
rest)
                     | Bool
otherwise -> String -> Either String (Tree Rulename, [Node Rulename])
forall a b. a -> Either a b
Left String
"group must contain alternation"
                [Node Rulename]
_ -> String -> Either String (Tree Rulename, [Node Rulename])
forall a b. a -> Either a b
Left String
"structural mismatch for <group>"
            ) ([Node Rulename] -> Either String (Tree Rulename, [Node Rulename]))
-> ([Node Rulename] -> [Node Rulename])
-> [Node Rulename]
-> Either String (Tree Rulename, [Node Rulename])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node Rulename] -> [Node Rulename]
dropCWsp)
        Either String (Tree Rulename, [Node Rulename])
-> ((Tree Rulename, [Node Rulename]) -> Either String Group)
-> Either String Group
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
>>= \(Tree Rulename
altSubtree, [Node Rulename]
rest) -> ([Node Rulename] -> Either String [Node Rulename]
forall {a}. [Node a] -> Either String [Node a]
tryDropRightParens ([Node Rulename] -> Either String [Node Rulename])
-> ([Node Rulename] -> [Node Rulename])
-> [Node Rulename]
-> Either String [Node Rulename]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Node Rulename] -> [Node Rulename]
dropCWsp ([Node Rulename] -> Either String [Node Rulename])
-> [Node Rulename] -> Either String [Node Rulename]
forall a b. (a -> b) -> a -> b
$ [Node Rulename]
rest)
        Either String [Node Rulename]
-> ([Node Rulename] -> Either String Group) -> Either String Group
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
            [] -> Tree Rulename -> Either String Alternation
Alternation.fromTree Tree Rulename
altSubtree Either String Alternation
-> (Alternation -> Group) -> Either String Group
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Alternation -> Group
Model.Group
            [Node Rulename]
_ -> String -> Either String Group
forall a b. a -> Either a b
Left String
"structural mismatch for <group>"
    where tryDropLeftParens :: [Node a] -> Either String [Node a]
tryDropLeftParens [Node a]
nodes =
            case [Node a]
nodes of
                (Tree.StringNode ByteString
bs):[Node a]
rest | ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
Ascii.stringAsBytesUnsafe String
"(" -> [Node a] -> Either String [Node a]
forall a b. b -> Either a b
Right [Node a]
rest
                                          | Bool
otherwise -> String -> Either String [Node a]
forall a b. a -> Either a b
Left String
"structural mismatch for <group>"
                [Node a]
_ -> String -> Either String [Node a]
forall a b. a -> Either a b
Left String
"structural mismatch for <group>"
          dropCWsp :: [Node Rulename] -> [Node Rulename]
dropCWsp = (Node Rulename -> Bool) -> [Node Rulename] -> [Node Rulename]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Node Rulename -> Rulename -> Bool
forall a. Ref a => Node a -> a -> Bool
`Tree.isRefOf` Rulename
CWsp.ref)
          tryDropRightParens :: [Node a] -> Either String [Node a]
tryDropRightParens [Node a]
nodes =
            case [Node a]
nodes of
                (Tree.StringNode ByteString
bs):[Node a]
rest | ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== String -> ByteString
Ascii.stringAsBytesUnsafe String
")" -> [Node a] -> Either String [Node a]
forall a b. b -> Either a b
Right [Node a]
rest
                                          | Bool
otherwise -> String -> Either String [Node a]
forall a b. a -> Either a b
Left String
"structural mismatch for <group>"
                [Node a]
_ -> String -> Either String [Node a]
forall a b. a -> Either a b
Left String
"structural mismatch for <group>"