{-# LANGUAGE LambdaCase #-} module Data.BAByNF.ABNF.Rules.DecVal ( ref , rule , fromTree ) where import Data.Functor ((<&>)) 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.Stream (Stream) import Data.BAByNF.Util.Stream qualified as Stream import Data.List qualified as List import Data.BAByNF.Util.Ascii qualified as Ascii import Data.BAByNF.Util.Decimal qualified as Decimal import Data.BAByNF.ABNF.Model qualified as Model ref :: Model.Rulename ref :: Rulename ref = ByteString -> Rulename Model.Rulename (String -> ByteString Ascii.stringAsBytesUnsafe String "dec-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 "d" , 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.digitRef) , 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.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 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.digitRef) ] ] ] fromTree :: Tree Model.Rulename -> Either String Model.DecVal fromTree :: Tree Rulename -> Either String DecVal fromTree Tree Rulename tree = Stream (Node Rulename) (Either String DecVal) -> [Node Rulename] -> Either String DecVal forall e a. Stream e a -> [e] -> a Stream.runStream_ Stream (Node Rulename) (Either String DecVal) stream (Tree Rulename -> [Node Rulename] forall a. Ref a => Tree a -> [Node a] Tree.nodes Tree Rulename tree) where stream :: Stream (Tree.Node Model.Rulename) (Either String Model.DecVal) stream :: Stream (Node Rulename) (Either String DecVal) stream = Stream (Node Rulename) (Either String ()) expectD Stream (Node Rulename) (Either String ()) -> Stream (Node Rulename) (Either String Seq) -> Stream (Node Rulename) (Either String Seq) forall (p :: * -> *) (m :: * -> *) a b. (Propagate p, Monad m) => m (p a) -> m (p b) -> m (p b) `Stream.propagate'` Stream (Node Rulename) (Either String Seq) takeByteOrLeft Stream (Node Rulename) (Either String Seq) -> (Seq -> Stream (Node Rulename) (Either String DecVal)) -> Stream (Node Rulename) (Either String DecVal) forall (p :: * -> *) (m :: * -> *) a b. (Propagate p, Monad m) => m (p a) -> (a -> m (p b)) -> m (p b) forall (m :: * -> *) a b. Monad m => m (Either String a) -> (a -> m (Either String b)) -> m (Either String b) `Stream.propagate` (\Seq firstByte -> Stream (Node Rulename) (Maybe (Node Rulename)) forall e. Stream e (Maybe e) Stream.peek Stream (Node Rulename) (Maybe (Node Rulename)) -> (Maybe (Node Rulename) -> Stream (Node Rulename) (Either String DecVal)) -> Stream (Node Rulename) (Either String DecVal) forall a b. Stream (Node Rulename) a -> (a -> Stream (Node Rulename) b) -> Stream (Node Rulename) b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= (\case Maybe (Node Rulename) Nothing -> Either String DecVal -> Stream (Node Rulename) (Either String DecVal) forall a. a -> Stream (Node Rulename) a forall (m :: * -> *) a. Monad m => a -> m a return (Either String DecVal -> Stream (Node Rulename) (Either String DecVal)) -> (Seq -> Either String DecVal) -> Seq -> Stream (Node Rulename) (Either String DecVal) forall b c a. (b -> c) -> (a -> b) -> a -> c . DecVal -> Either String DecVal forall a b. b -> Either a b Right (DecVal -> Either String DecVal) -> (Seq -> DecVal) -> Seq -> Either String DecVal forall b c a. (b -> c) -> (a -> b) -> a -> c . Seq -> DecVal singleByte (Seq -> Stream (Node Rulename) (Either String DecVal)) -> Seq -> Stream (Node Rulename) (Either String DecVal) forall a b. (a -> b) -> a -> b $ Seq firstByte Just (Tree.StringNode ByteString s) | ByteString s ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == Char -> ByteString Ascii.bs Char '-' -> Stream (Node Rulename) (Either String Seq) dashDecimals Stream (Node Rulename) (Either String Seq) -> (Either String Seq -> Either String DecVal) -> Stream (Node Rulename) (Either String DecVal) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> (Either String Seq -> (Seq -> DecVal) -> Either String DecVal forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> Seq -> Seq -> DecVal Model.RangeDecVal Seq firstByte) | ByteString s ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == Char -> ByteString Ascii.bs Char '.' -> Stream (Node Rulename) (Either String Seq) -> [Seq] -> Stream (Node Rulename) (Either String [Seq]) forall {e} {a} {a}. Stream e (Either a a) -> [a] -> Stream e (Either a [a]) exhaust Stream (Node Rulename) (Either String Seq) dotDecimals [] Stream (Node Rulename) (Either String [Seq]) -> (Either String [Seq] -> Either String DecVal) -> Stream (Node Rulename) (Either String DecVal) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> ([Seq] -> DecVal) -> Either String [Seq] -> Either String DecVal forall a b. (a -> b) -> Either String a -> Either String b forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (\[Seq] byteRest -> let bytes :: [Seq] bytes = Seq firstByte Seq -> [Seq] -> [Seq] forall a. a -> [a] -> [a] : [Seq] byteRest in [Seq] -> DecVal Model.SeqDecVal [Seq] bytes ) | Bool otherwise -> Either String DecVal -> Stream (Node Rulename) (Either String DecVal) forall a. a -> Stream (Node Rulename) a forall (m :: * -> *) a. Monad m => a -> m a return (String -> Either String DecVal forall a b. a -> Either a b Left String "unexpected char") Maybe (Node Rulename) _ -> Either String DecVal -> Stream (Node Rulename) (Either String DecVal) forall a. a -> Stream (Node Rulename) a forall (m :: * -> *) a. Monad m => a -> m a return (String -> Either String DecVal forall a b. a -> Either a b Left String "dec-num pattern not matched") ) ) expectD :: Stream (Node Rulename) (Either String ()) expectD = (Node Rulename -> Bool) -> Stream (Node Rulename) (Maybe (Node Rulename)) forall e. (e -> Bool) -> Stream e (Maybe e) Stream.takeIf Node Rulename -> Bool forall {a}. Ref a => Node a -> Bool isD Stream (Node Rulename) (Maybe (Node Rulename)) -> (Maybe (Node Rulename) -> Either String ()) -> Stream (Node Rulename) (Either String ()) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> Either String () -> (Node Rulename -> Either String ()) -> Maybe (Node Rulename) -> Either String () forall b a. b -> (a -> b) -> Maybe a -> b maybe (String -> Either String () forall a b. a -> Either a b Left String "expected d or D") (Either String () -> Node Rulename -> Either String () forall a b. a -> b -> a const (() -> Either String () forall a b. b -> Either a b Right ())) isD :: Node a -> Bool isD 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 'd') 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 'D') nodeToDecimal :: Node Rulename -> Maybe Digit nodeToDecimal Node Rulename node = if Bool -> Bool not (Node Rulename -> Rulename -> Bool forall a. Ref a => Node a -> a -> Bool Tree.isRefOf Node Rulename node Rulename Core.digitRef) then Maybe Digit forall a. Maybe a Nothing else let b :: ByteString b = Node Rulename -> ByteString forall a. Node a -> ByteString Tree.stringifyNode Node Rulename node in ByteString -> Maybe Digit Ascii.bsToDecimalDigit ByteString b takeByte :: Stream (Node Rulename) (Maybe Seq) takeByte = (Node Rulename -> Maybe Digit) -> Stream (Node Rulename) [Digit] forall e a. (e -> Maybe a) -> Stream e [a] Stream.takeWhileMap Node Rulename -> Maybe Digit nodeToDecimal Stream (Node Rulename) [Digit] -> ([Digit] -> Maybe Seq) -> Stream (Node Rulename) (Maybe Seq) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \case [] -> Maybe Seq forall a. Maybe a Nothing [Digit] decimals -> Seq -> Maybe Seq forall a. a -> Maybe a Just ([Digit] -> Seq Decimal.Seq [Digit] decimals) takeByteOrLeft :: Stream (Node Rulename) (Either String Seq) takeByteOrLeft = Stream (Node Rulename) (Maybe Seq) takeByte Stream (Node Rulename) (Maybe Seq) -> (Maybe Seq -> Either String Seq) -> Stream (Node Rulename) (Either String Seq) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> Either String Seq -> (Seq -> Either String Seq) -> Maybe Seq -> Either String Seq forall b a. b -> (a -> b) -> Maybe a -> b maybe (String -> Either String Seq forall a b. a -> Either a b Left String "not digits") Seq -> Either String Seq forall a b. b -> Either a b Right dashDecimals :: Stream (Node Rulename) (Either String Seq) dashDecimals = ((Node Rulename -> Bool) -> Stream (Node Rulename) (Maybe (Node Rulename)) forall e. (e -> Bool) -> Stream e (Maybe e) Stream.takeIf (Node Rulename -> ByteString -> Bool forall a. Ref a => Node a -> ByteString -> Bool `Tree.isStringEq` Char -> ByteString Ascii.bs Char '-') Stream (Node Rulename) (Maybe (Node Rulename)) -> Stream (Node Rulename) (Maybe Seq) -> Stream (Node Rulename) (Maybe Seq) forall (p :: * -> *) (m :: * -> *) a b. (Propagate p, Monad m) => m (p a) -> m (p b) -> m (p b) `Stream.propagate'` Stream (Node Rulename) (Maybe Seq) takeByte) Stream (Node Rulename) (Maybe Seq) -> (Maybe Seq -> Either String Seq) -> Stream (Node Rulename) (Either String Seq) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> Either String Seq -> (Seq -> Either String Seq) -> Maybe Seq -> Either String Seq forall b a. b -> (a -> b) -> Maybe a -> b maybe (String -> Either String Seq forall a b. a -> Either a b Left String "not dash-bits") Seq -> Either String Seq forall a b. b -> Either a b Right dotDecimals :: Stream (Node Rulename) (Either String Seq) dotDecimals = ((Node Rulename -> Bool) -> Stream (Node Rulename) (Maybe (Node Rulename)) forall e. (e -> Bool) -> Stream e (Maybe e) Stream.takeIf (Node Rulename -> ByteString -> Bool forall a. Ref a => Node a -> ByteString -> Bool `Tree.isStringEq` Char -> ByteString Ascii.bs Char '.') Stream (Node Rulename) (Maybe (Node Rulename)) -> Stream (Node Rulename) (Maybe Seq) -> Stream (Node Rulename) (Maybe Seq) forall (p :: * -> *) (m :: * -> *) a b. (Propagate p, Monad m) => m (p a) -> m (p b) -> m (p b) `Stream.propagate'` Stream (Node Rulename) (Maybe Seq) takeByte) Stream (Node Rulename) (Maybe Seq) -> (Maybe Seq -> Either String Seq) -> Stream (Node Rulename) (Either String Seq) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> Either String Seq -> (Seq -> Either String Seq) -> Maybe Seq -> Either String Seq forall b a. b -> (a -> b) -> Maybe a -> b maybe (String -> Either String Seq forall a b. a -> Either a b Left String "not dot-bits") Seq -> Either String Seq forall a b. b -> Either a b Right exhaust :: Stream e (Either a a) -> [a] -> Stream e (Either a [a]) exhaust Stream e (Either a a) m [a] acc = Stream e Bool forall e. Stream e Bool Stream.hasNext Stream e Bool -> (Bool -> Stream e (Either a [a])) -> Stream e (Either a [a]) forall a b. Stream e a -> (a -> Stream e b) -> Stream e b forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \Bool cond -> if Bool cond then Stream e (Either a a) m Stream e (Either a a) -> (a -> Stream e (Either a [a])) -> Stream e (Either a [a]) forall (p :: * -> *) (m :: * -> *) a b. (Propagate p, Monad m) => m (p a) -> (a -> m (p b)) -> m (p b) forall (m :: * -> *) a b. Monad m => m (Either a a) -> (a -> m (Either a b)) -> m (Either a b) `Stream.propagate` (\a e -> Stream e (Either a a) -> [a] -> Stream e (Either a [a]) exhaust Stream e (Either a a) m (a ea -> [a] -> [a] forall a. a -> [a] -> [a] :[a] acc)) else Either a [a] -> Stream e (Either a [a]) forall a. a -> Stream e a forall (m :: * -> *) a. Monad m => a -> m a return ([a] -> Either a [a] forall a b. b -> Either a b Right ([a] -> [a] forall a. [a] -> [a] reverse [a] acc)) singleByte :: Seq -> DecVal singleByte = [Seq] -> DecVal Model.SeqDecVal ([Seq] -> DecVal) -> (Seq -> [Seq]) -> Seq -> DecVal forall b c a. (b -> c) -> (a -> b) -> a -> c . Seq -> [Seq] forall a. a -> [a] List.singleton