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

import Data.List qualified as List

import Data.ByteString qualified as ByteString

import Data.BAByNF.ABNF.Core qualified as Core
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.Util.List qualified as Util.List
import Data.BAByNF.Util.Hex qualified as Hex
import Data.BAByNF.ABNF.Model qualified as Model


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

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
            (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
"x"
        , Repeat -> Element -> Repetition
Model.Repetition (Bound -> Bound -> Repeat
Model.RangedRepeat (Integer -> Bound
Model.FixedBound Integer
1) Bound
Model.UnBound) (Rulename -> Element
Model.RulenameElement Rulename
Core.hexdigRef)
        , Repeat -> Element -> Repetition
Model.Repetition Repeat
Model.NoRepeat
            (Element -> Repetition) -> Element -> Repetition
forall a b. (a -> b) -> a -> b
$ Option -> Element
Model.OptionElement
            (Option -> Element)
-> ([Concatenation] -> Option) -> [Concatenation] -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Alternation -> Option
Model.Option
            (Alternation -> Option)
-> ([Concatenation] -> Alternation) -> [Concatenation] -> Option
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Concatenation] -> Alternation
Model.Alternation
            ([Concatenation] -> Element) -> [Concatenation] -> Element
forall a b. (a -> b) -> a -> b
$
                [ [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 (Bound -> Bound -> Repeat
Model.RangedRepeat (Integer -> Bound
Model.FixedBound Integer
1) 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] -> Concatenation) -> [Repetition] -> Concatenation
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
. 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
"."
                        , Repeat -> Element -> Repetition
Model.Repetition (Bound -> Bound -> Repeat
Model.RangedRepeat (Integer -> Bound
Model.FixedBound Integer
1) Bound
Model.UnBound) (Rulename -> Element
Model.RulenameElement Rulename
Core.hexdigRef)
                        ]
                , [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 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
"-"
                        , Repeat -> Element -> Repetition
Model.Repetition (Bound -> Bound -> Repeat
Model.RangedRepeat (Integer -> Bound
Model.FixedBound Integer
1) Bound
Model.UnBound) (Rulename -> Element
Model.RulenameElement Rulename
Core.hexdigRef)
                        ]
                ]
        ]

fromTree :: Tree Model.Rulename -> Either String Model.HexVal
fromTree :: Tree Rulename -> Either String HexVal
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 (case [Node Rulename] -> Maybe (Node Rulename, [Node Rulename])
forall a. [a] -> Maybe (a, [a])
List.uncons [Node Rulename]
nodes of
        Just (Node Rulename
h, [Node Rulename]
rest) -> 
            if Node Rulename -> Bool
forall {a}. Ref a => Node a -> Bool
isB Node Rulename
h
                then [Node Rulename] -> Either String [Node Rulename]
forall a b. b -> Either a b
Right [Node Rulename]
rest
                else String -> Either String [Node Rulename]
forall a b. a -> Either a b
Left String
"hex-val must start with x | X"
        Maybe (Node Rulename, [Node Rulename])
_ -> String -> Either String [Node Rulename]
forall a b. a -> Either a b
Left String
"structural mismatch for <hex-val>")
        Either String [Node Rulename]
-> ([Node Rulename] -> Either String (Seq, [Node Rulename]))
-> Either String (Seq, [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
>>= [Node Rulename] -> Either String (Seq, [Node Rulename])
takeHexSeq
        Either String (Seq, [Node Rulename])
-> ((Seq, [Node Rulename]) -> Either String HexVal)
-> Either String HexVal
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
>>= \(Seq
firstSeq, [Node Rulename]
rest) -> 
            case [Node Rulename] -> Maybe (Node Rulename, [Node Rulename])
forall a. [a] -> Maybe (a, [a])
List.uncons [Node Rulename]
rest of
                Maybe (Node Rulename, [Node Rulename])
Nothing -> HexVal -> Either String HexVal
forall a b. b -> Either a b
Right ([Seq] -> HexVal
Model.SeqHexVal [Seq
firstSeq])
                Just (Node Rulename
c, [Node Rulename]
rest') | Node Rulename -> Bool
forall {a}. Ref a => Node a -> Bool
isDash Node Rulename
c -> [Node Rulename] -> Either String (Seq, [Node Rulename])
takeHexSeq [Node Rulename]
rest' Either String (Seq, [Node Rulename])
-> ((Seq, [Node Rulename]) -> Either String HexVal)
-> Either String HexVal
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
>>= \(Seq
secondSeq, [Node Rulename]
end) -> 
                                        case [Node Rulename]
end of 
                                            [] -> HexVal -> Either String HexVal
forall a b. b -> Either a b
Right (Seq -> Seq -> HexVal
Model.RangeHexVal Seq
firstSeq Seq
secondSeq)
                                            [Node Rulename]
_ -> String -> Either String HexVal
forall a b. a -> Either a b
Left String
"structural mismatch for <hex-val>"
                                | Node Rulename -> Bool
forall {a}. Ref a => Node a -> Bool
isDot Node Rulename
c -> let takeSeq :: [Node Rulename] -> Either String [Seq]
takeSeq [Node Rulename]
x = [Node Rulename] -> Either String (Seq, [Node Rulename])
takeHexSeq [Node Rulename]
x Either String (Seq, [Node Rulename])
-> ((Seq, [Node Rulename]) -> Either String [Seq])
-> Either String [Seq]
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
>>= (\(Seq
nextSeq, [Node Rulename]
rest'') -> case [Node Rulename]
rest'' of
                                                    [] -> [Seq] -> Either String [Seq]
forall a b. b -> Either a b
Right [Seq
nextSeq]
                                                    Node Rulename
c':[Node Rulename]
rest''' -> if Node Rulename -> Bool
forall {a}. Ref a => Node a -> Bool
isDot Node Rulename
c' 
                                                                    then [Node Rulename] -> Either String [Seq]
takeSeq [Node Rulename]
rest''' Either String [Seq]
-> ([Seq] -> Either String [Seq]) -> Either String [Seq]
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
>>= \[Seq]
seqs -> [Seq] -> Either String [Seq]
forall a b. b -> Either a b
Right (Seq
nextSeq Seq -> [Seq] -> [Seq]
forall a. a -> [a] -> [a]
: [Seq]
seqs)
                                                                    else String -> Either String [Seq]
forall a b. a -> Either a b
Left String
"structural mismatch for <hex-val>")
                                              in [Node Rulename] -> Either String [Seq]
takeSeq [Node Rulename]
rest' Either String [Seq]
-> ([Seq] -> Either String HexVal) -> Either String HexVal
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
>>= \[Seq]
seqs -> HexVal -> Either String HexVal
forall a b. b -> Either a b
Right ([Seq] -> HexVal
Model.SeqHexVal ([Seq] -> HexVal) -> [Seq] -> HexVal
forall a b. (a -> b) -> a -> b
$ Seq
firstSeq Seq -> [Seq] -> [Seq]
forall a. a -> [a] -> [a]
: [Seq]
seqs)
                                | Bool
otherwise -> String -> Either String HexVal
forall a b. a -> Either a b
Left String
"structural mismatch for <hex-val>"
    where takeHexSeq :: [Tree.Node Model.Rulename] -> Either String (Hex.Seq, [Tree.Node Model.Rulename])
          takeHexSeq :: [Node Rulename] -> Either String (Seq, [Node Rulename])
takeHexSeq [Node Rulename]
nodes = case [Node Rulename]
-> (Node Rulename -> Bool) -> ([Node Rulename], [Node Rulename])
forall a. [a] -> (a -> Bool) -> ([a], [a])
Util.List.lsplitWhenNot [Node Rulename]
nodes Node Rulename -> Bool
isHexDig  of 
                (hexno :: [Node Rulename]
hexno@(Node Rulename
_:[Node Rulename]
_), [Node Rulename]
rest) -> 
                    case ByteString -> Maybe Seq
Ascii.toHexSeq (ByteString -> Maybe Seq) -> ByteString -> Maybe Seq
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
ByteString.concat ((Node Rulename -> ByteString) -> [Node Rulename] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Node Rulename -> ByteString
forall a. Node a -> ByteString
Tree.stringifyNode [Node Rulename]
hexno) of
                        Just Seq
hexseq -> (Seq, [Node Rulename]) -> Either String (Seq, [Node Rulename])
forall a b. b -> Either a b
Right (Seq
hexseq, [Node Rulename]
rest)
                        Maybe Seq
Nothing -> String -> Either String (Seq, [Node Rulename])
forall a b. a -> Either a b
Left String
"invalid hex digits in <hex-val>"
                ([Node Rulename], [Node Rulename])
_ -> String -> Either String (Seq, [Node Rulename])
forall a b. a -> Either a b
Left String
"structural mismatch for <hex-val>"
          isB :: Node a -> Bool
isB Node a
node = Node a -> ByteString -> Bool
forall a. Ref a => Node a -> ByteString -> Bool
Tree.isStringEq Node a
node (Char -> ByteString
Ascii.bs Char
'x') Bool -> Bool -> Bool
|| Node a -> ByteString -> Bool
forall a. Ref a => Node a -> ByteString -> Bool
Tree.isStringEq Node a
node (Char -> ByteString
Ascii.bs Char
'X')
          isHexDig :: Node Rulename -> Bool
isHexDig Node Rulename
node = Node Rulename -> Rulename -> Bool
forall a. Ref a => Node a -> a -> Bool
Tree.isRefOf Node Rulename
node Rulename
Core.hexdigRef 
          isDot :: Node a -> Bool
isDot Node a
node = Node a -> ByteString -> Bool
forall a. Ref a => Node a -> ByteString -> Bool
Tree.isStringEq Node a
node (String -> ByteString
Ascii.stringAsBytesUnsafe String
".")
          isDash :: Node a -> Bool
isDash Node a
node = Node a -> ByteString -> Bool
forall a. Ref a => Node a -> ByteString -> Bool
Tree.isStringEq Node a
node (String -> ByteString
Ascii.stringAsBytesUnsafe String
"-")