{-# LANGUAGE LambdaCase #-} module Data.BAByNF.ABNF.Rules.BinVal ( ref , rule , fromTree ) where import Data.Functor ((<&>)) import Data.List qualified as List import Data.BAByNF.Util.Ascii qualified as Ascii import Data.BAByNF.Util.Binary qualified as Binary import Data.BAByNF.Util.Stream (Stream) import Data.BAByNF.Util.Stream qualified as Stream import Data.BAByNF.Core.Tree (Tree) import Data.BAByNF.Core.Tree qualified as Tree import Data.BAByNF.ABNF.Model qualified as Model import Data.BAByNF.ABNF.Core qualified as Core ref :: Model.Rulename ref :: Rulename ref = ByteString -> Rulename Model.Rulename (String -> ByteString Ascii.stringAsBytesUnsafe String "bin-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 "b" , 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.bitRef) , 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.bitRef) ] , [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.bitRef) ] ] ] fromTree :: Tree Model.Rulename -> Either String Model.BinVal fromTree :: Tree Rulename -> Either String BinVal fromTree Tree Rulename tree = Stream (Node Rulename) (Either String BinVal) -> [Node Rulename] -> Either String BinVal forall e a. Stream e a -> [e] -> a Stream.runStream_ Stream (Node Rulename) (Either String BinVal) 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.BinVal) stream :: Stream (Node Rulename) (Either String BinVal) stream = Stream (Node Rulename) (Either String ()) expectB 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 BinVal)) -> Stream (Node Rulename) (Either String BinVal) 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 BinVal)) -> Stream (Node Rulename) (Either String BinVal) 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 BinVal -> Stream (Node Rulename) (Either String BinVal) forall a. a -> Stream (Node Rulename) a forall (m :: * -> *) a. Monad m => a -> m a return (Either String BinVal -> Stream (Node Rulename) (Either String BinVal)) -> (Seq -> Either String BinVal) -> Seq -> Stream (Node Rulename) (Either String BinVal) forall b c a. (b -> c) -> (a -> b) -> a -> c . BinVal -> Either String BinVal forall a b. b -> Either a b Right (BinVal -> Either String BinVal) -> (Seq -> BinVal) -> Seq -> Either String BinVal forall b c a. (b -> c) -> (a -> b) -> a -> c . Seq -> BinVal singleByte (Seq -> Stream (Node Rulename) (Either String BinVal)) -> Seq -> Stream (Node Rulename) (Either String BinVal) 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) dashBits Stream (Node Rulename) (Either String Seq) -> (Either String Seq -> Either String BinVal) -> Stream (Node Rulename) (Either String BinVal) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> (Either String Seq -> (Seq -> BinVal) -> Either String BinVal forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> Seq -> Seq -> BinVal Model.RangeBinVal 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) dotBits [] Stream (Node Rulename) (Either String [Seq]) -> (Either String [Seq] -> Either String BinVal) -> Stream (Node Rulename) (Either String BinVal) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> ([Seq] -> BinVal) -> Either String [Seq] -> Either String BinVal 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] -> BinVal Model.SeqBinVal [Seq] bytes ) | Bool otherwise -> Either String BinVal -> Stream (Node Rulename) (Either String BinVal) forall a. a -> Stream (Node Rulename) a forall (m :: * -> *) a. Monad m => a -> m a return (String -> Either String BinVal forall a b. a -> Either a b Left String "unexpected char") Maybe (Node Rulename) _ -> Either String BinVal -> Stream (Node Rulename) (Either String BinVal) forall a. a -> Stream (Node Rulename) a forall (m :: * -> *) a. Monad m => a -> m a return (String -> Either String BinVal forall a b. a -> Either a b Left String "bin-num pattern not matched") ) ) expectB :: Stream (Node Rulename) (Either String ()) expectB = (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 isB 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 b or B") (Either String () -> Node Rulename -> Either String () forall a b. a -> b -> a const (() -> Either String () forall a b. b -> Either a b Right ())) 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 'b') 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 'B') nodeToBit :: Node Rulename -> Maybe Digit nodeToBit 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.bitRef) 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 if ByteString b ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == Char -> ByteString Ascii.bs Char '0' then Digit -> Maybe Digit forall a. a -> Maybe a Just Digit Binary.B0 else if ByteString b ByteString -> ByteString -> Bool forall a. Eq a => a -> a -> Bool == Char -> ByteString Ascii.bs Char '1' then Digit -> Maybe Digit forall a. a -> Maybe a Just Digit Binary.B1 else Maybe Digit forall a. Maybe a Nothing 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 nodeToBit 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] bits -> Seq -> Maybe Seq forall a. a -> Maybe a Just ([Digit] -> Seq Binary.Seq [Digit] bits) 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 bits") Seq -> Either String Seq forall a b. b -> Either a b Right dashBits :: Stream (Node Rulename) (Either String Seq) dashBits = ((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 dotBits :: Stream (Node Rulename) (Either String Seq) dotBits = ((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 -> BinVal singleByte = [Seq] -> BinVal Model.SeqBinVal ([Seq] -> BinVal) -> (Seq -> [Seq]) -> Seq -> BinVal forall b c a. (b -> c) -> (a -> b) -> a -> c . Seq -> [Seq] forall a. a -> [a] List.singleton