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

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

import Data.BAByNF.Core.Ref qualified as Ref
import Data.BAByNF.Core.Tree (Tree)
import Data.BAByNF.Core.Tree qualified as Tree
import Data.BAByNF.ABNF.Rules.Alternation qualified as Alternation
import Data.BAByNF.ABNF.Rules.CWsp qualified as CWsp
import Data.BAByNF.Util.Ascii qualified as Ascii
import Data.BAByNF.ABNF.Model qualified as Model

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

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.Option
fromTree :: Tree Rulename -> Either String Option
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
"option must contain alternation"
                [Node Rulename]
_ -> String -> Either String (Tree Rulename, [Node Rulename])
forall a b. a -> Either a b
Left String
"structural mismatch for <option>"
            ) ([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 Option)
-> Either String Option
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 Option)
-> Either String Option
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 -> Option) -> Either String Option
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Alternation -> Option
Model.Option
            [Node Rulename]
_ -> String -> Either String Option
forall a b. a -> Either a b
Left String
"structural mismatch for <option>"
    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 <option>"
                [Node a]
_ -> String -> Either String [Node a]
forall a b. a -> Either a b
Left String
"structural mismatch for <option>"
          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>"