module Data.BAByNF.ABNF.Rules.Repeat
    ( 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.ByteString.Char8 qualified as ByteString.Char8

import Data.BAByNF.Core.Tree (Tree)
import Data.BAByNF.Core.Tree qualified as Tree
import Data.BAByNF.ABNF.Core qualified as Core
import Data.BAByNF.Util.Stream qualified as Stream
import Data.BAByNF.Util.Ascii qualified as Ascii
import Data.BAByNF.Core.Ref qualified as Ref
import Data.BAByNF.ABNF.Model qualified as Model

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

rule :: Model.Rule
rule :: Rule
rule = Rulename -> DefinedAs -> Elements -> Rule
Model.Rule Rulename
ref DefinedAs
Model.BasicDefinition
    (Elements -> Rule)
-> ([Concatenation] -> Elements) -> [Concatenation] -> Rule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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] -> Rule) -> [Concatenation] -> Rule
forall a b. (a -> b) -> a -> b
$ 
        [ [Repetition] -> Concatenation
Model.Concatenation
            ([Repetition] -> Concatenation)
-> (Element -> [Repetition]) -> Element -> Concatenation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Repetition -> [Repetition]
forall a. a -> [a]
List.singleton
            (Repetition -> [Repetition])
-> (Element -> Repetition) -> Element -> [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 -> Concatenation) -> Element -> Concatenation
forall a b. (a -> b) -> a -> b
$ Rulename -> Element
Model.RulenameElement Rulename
Core.digitRef 
        , [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
Core.digitRef
                , 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) -> Element -> Repetition
forall a b. (a -> b) -> a -> b
$ Rulename -> Element
Model.RulenameElement Rulename
Core.digitRef 
                ]
        ]

fromTree :: Tree Model.Rulename -> Either String Model.Repeat
fromTree :: Tree Rulename -> Either String Repeat
fromTree Tree Rulename
tree =
    let stream :: Stream (Node Rulename) (Either String Repeat)
stream = do
            Maybe ByteString
mnOpt <- Stream (Node Rulename) (Maybe ByteString)
takeDigits
            Bool
hasStar <- Stream (Node Rulename) (Maybe (Node Rulename))
forall e. Stream e (Maybe e)
Stream.take Stream (Node Rulename) (Maybe (Node Rulename))
-> (Maybe (Node Rulename) -> Bool) -> Stream (Node Rulename) Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Maybe (Node Rulename) -> Bool
forall a. Maybe a -> Bool
Maybe.isJust
            Maybe ByteString
mxOpt <- if Bool
hasStar then Stream (Node Rulename) (Maybe ByteString)
takeDigits else Maybe ByteString -> Stream (Node Rulename) (Maybe ByteString)
forall a. a -> Stream (Node Rulename) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ByteString
forall a. Maybe a
Nothing
            case (Maybe ByteString
mnOpt, Bool
hasStar, Maybe ByteString
mxOpt) of
                (Just ByteString
mns, Bool
False, Maybe ByteString
_) -> Either String Repeat
-> Stream (Node Rulename) (Either String Repeat)
forall a. a -> Stream (Node Rulename) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Repeat
 -> Stream (Node Rulename) (Either String Repeat))
-> Either String Repeat
-> Stream (Node Rulename) (Either String Repeat)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Integer
tryToInteger ByteString
mns Either String Integer
-> (Integer -> Either String Repeat) -> Either String Repeat
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
>>= \Integer
mn -> Repeat -> Either String Repeat
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Repeat -> Either String Repeat) -> Repeat -> Either String Repeat
forall a b. (a -> b) -> a -> b
$ Integer -> Repeat
Model.FixedRepeat Integer
mn
                (Maybe ByteString
_, Bool
True, Maybe ByteString
_) -> Either String Repeat
-> Stream (Node Rulename) (Either String Repeat)
forall a. a -> Stream (Node Rulename) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Repeat
 -> Stream (Node Rulename) (Either String Repeat))
-> Either String Repeat
-> Stream (Node Rulename) (Either String Repeat)
forall a b. (a -> b) -> a -> b
$
                    let toBound :: Maybe ByteString -> Either String Bound
toBound = Either String Bound
-> (ByteString -> Either String Bound)
-> Maybe ByteString
-> Either String Bound
forall b a. b -> (a -> b) -> Maybe a -> b
Maybe.maybe (Bound -> Either String Bound
forall a b. b -> Either a b
Right Bound
Model.UnBound) (\ByteString
x -> ByteString -> Either String Integer
tryToInteger ByteString
x Either String Integer
-> (Integer -> Either String Bound) -> Either String Bound
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
>>= Bound -> Either String Bound
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bound -> Either String Bound)
-> (Integer -> Bound) -> Integer -> Either String Bound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Bound
Model.FixedBound)
                     in do 
                        Bound
lo <- Maybe ByteString -> Either String Bound
toBound Maybe ByteString
mnOpt
                        Bound
hi <- Maybe ByteString -> Either String Bound
toBound Maybe ByteString
mxOpt
                        Repeat -> Either String Repeat
forall a b. b -> Either a b
Right (Bound -> Bound -> Repeat
Model.RangedRepeat Bound
lo Bound
hi)
                (Maybe ByteString, Bool, Maybe ByteString)
_ -> Either String Repeat
-> Stream (Node Rulename) (Either String Repeat)
forall a. a -> Stream (Node Rulename) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Repeat
 -> Stream (Node Rulename) (Either String Repeat))
-> Either String Repeat
-> Stream (Node Rulename) (Either String Repeat)
forall a b. (a -> b) -> a -> b
$ String -> Either String Repeat
forall a b. a -> Either a b
Left String
"structural mismatch for <repeat>"
     in Stream (Node Rulename) (Either String Repeat)
-> [Node Rulename] -> Either String Repeat
forall e a. Stream e a -> [e] -> a
Stream.runStream_ Stream (Node Rulename) (Either String Repeat)
stream (Tree Rulename -> [Node Rulename]
forall a. Ref a => Tree a -> [Node a]
Tree.nodes Tree Rulename
tree)
    where takeDigits :: Stream (Node Rulename) (Maybe ByteString)
takeDigits = (Node Rulename -> Maybe ByteString)
-> Stream (Node Rulename) [ByteString]
forall e a. (e -> Maybe a) -> Stream e [a]
Stream.takeWhileMap (\Node Rulename
e ->
            case Node Rulename
e of
                Tree.RefNode Rulename
r Tree Rulename
subtree ->
                    if Rulename -> Rulename -> Bool
forall a. Ref a => a -> a -> Bool
Ref.eq Rulename
r Rulename
Core.digitRef
                        then ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Tree Rulename -> ByteString
forall a. Tree a -> ByteString
Tree.stringify Tree Rulename
subtree
                        else Maybe ByteString
forall a. Maybe a
Nothing
                Node Rulename
_ -> Maybe ByteString
forall a. Maybe a
Nothing
            ) Stream (Node Rulename) [ByteString]
-> ([ByteString] -> Maybe ByteString)
-> Stream (Node Rulename) (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \[ByteString]
bs -> case [ByteString]
bs of [] -> Maybe ByteString
forall a. Maybe a
Nothing; [ByteString]
_ -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> ([ByteString] -> ByteString) -> [ByteString] -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
ByteString.concat ([ByteString] -> Maybe ByteString)
-> [ByteString] -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString]
bs
          tryToInteger :: ByteString -> Either String Integer
tryToInteger ByteString
bs =
              case ByteString -> Maybe (Integer, ByteString)
ByteString.Char8.readInteger ByteString
bs of
                  Maybe (Integer, ByteString)
Nothing -> String -> Either String Integer
forall a b. a -> Either a b
Left String
"not integer"
                  Just (Integer
no, ByteString
rest) | ByteString -> Bool
ByteString.null ByteString
rest  -> Integer -> Either String Integer
forall a b. b -> Either a b
Right Integer
no
                                  | Bool
otherwise -> String -> Either String Integer
forall a b. a -> Either a b
Left String
"more than an integer read"