module Data.BAByNF.ABNF.Rules.ProseVal
    ( ref
    , rule
    , fromTree
    ) where

import Data.Functor ((<&>))

import Data.Maybe qualified as Maybe
import Data.List qualified as List

import Data.ByteString qualified as ByteString

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

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

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)
-> (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 Bound
Model.UnBound 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] -> Repetition) -> [Concatenation] -> Repetition
forall a b. (a -> b) -> a -> b
$ 
                [ [Repetition] -> Concatenation
Model.Concatenation
                    ([Repetition] -> Concatenation)
-> (HexVal -> [Repetition]) -> HexVal -> Concatenation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repetition -> [Repetition]
forall a. a -> [a]
List.singleton
                    (Repetition -> [Repetition])
-> (HexVal -> Repetition) -> HexVal -> [Repetition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repeat -> Element -> Repetition
Model.Repetition Repeat
Model.NoRepeat
                    (Element -> Repetition)
-> (HexVal -> Element) -> HexVal -> Repetition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumVal -> Element
Model.NumValElement
                    (NumVal -> Element) -> (HexVal -> NumVal) -> HexVal -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexVal -> NumVal
Model.HexNumVal
                    (HexVal -> Concatenation) -> HexVal -> Concatenation
forall a b. (a -> b) -> a -> b
$ Seq -> Seq -> HexVal
Model.RangeHexVal ([Digit] -> Seq
Hex.Seq [Digit
Hex.X2, Digit
Hex.X0]) ([Digit] -> Seq
Hex.Seq [Digit
Hex.X3, Digit
Hex.XD])
                , [Repetition] -> Concatenation
Model.Concatenation
                    ([Repetition] -> Concatenation)
-> (HexVal -> [Repetition]) -> HexVal -> Concatenation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repetition -> [Repetition]
forall a. a -> [a]
List.singleton
                    (Repetition -> [Repetition])
-> (HexVal -> Repetition) -> HexVal -> [Repetition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repeat -> Element -> Repetition
Model.Repetition Repeat
Model.NoRepeat
                    (Element -> Repetition)
-> (HexVal -> Element) -> HexVal -> Repetition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NumVal -> Element
Model.NumValElement
                    (NumVal -> Element) -> (HexVal -> NumVal) -> HexVal -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HexVal -> NumVal
Model.HexNumVal
                    (HexVal -> Concatenation) -> HexVal -> Concatenation
forall a b. (a -> b) -> a -> b
$ Seq -> Seq -> HexVal
Model.RangeHexVal ([Digit] -> Seq
Hex.Seq [Digit
Hex.X3, Digit
Hex.XF]) ([Digit] -> Seq
Hex.Seq [Digit
Hex.X7, Digit
Hex.XE])
                ]
        , 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
">"
        
        ] 

fromTree :: Tree Model.Rulename -> Either String Model.ProseVal
fromTree :: Tree Rulename -> Either String ProseVal
fromTree Tree Rulename
tree =
    let whole :: ByteString
whole = Tree Rulename -> ByteString
forall a. Tree a -> ByteString
Tree.stringify Tree Rulename
tree
        proseOrErr :: Either String ByteString
proseOrErr = Either String ByteString
-> Maybe (Either String ByteString) -> Either String ByteString
forall a. a -> Maybe a -> a
Maybe.fromMaybe (String -> Either String ByteString
forall a b. a -> Either a b
Left String
"prose must be between < and >") (Maybe (Either String ByteString) -> Either String ByteString)
-> Maybe (Either String ByteString) -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (Word8, ByteString)
ByteString.uncons ByteString
whole Maybe (Word8, ByteString)
-> ((Word8, ByteString) -> Maybe (Either String ByteString))
-> Maybe (Either String ByteString)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Word8
h, ByteString
t) ->
             ByteString -> Maybe (ByteString, Word8)
ByteString.unsnoc ByteString
t Maybe (ByteString, Word8)
-> ((ByteString, Word8) -> Either String ByteString)
-> Maybe (Either String ByteString)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(ByteString
prose', Word8
l) ->
                if Word8
h Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
60 Bool -> Bool -> Bool
&& Word8
l Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
62 then ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
prose' else String -> Either String ByteString
forall a b. a -> Either a b
Left String
"prose must be between < and >"
     in Either String ByteString
proseOrErr Either String ByteString
-> (ByteString -> ProseVal) -> Either String ProseVal
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ByteString -> ProseVal
Model.ProseVal