module Data.BAByNF.ABNF.Rules.QuotedString ( ref , rule , fromTree ) where import Data.Functor ((<&>)) import Data.Word (Word8) import Data.ByteString (ByteString) import Data.ByteString qualified as ByteString import Data.BAByNF.Util.Ascii qualified as Ascii import Data.BAByNF.Util.Hex qualified as Hex 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.ABNF.Model qualified as Model ref :: Model.Rulename ref :: Rulename ref = ByteString -> Rulename Model.Rulename (String -> ByteString Ascii.stringAsBytesUnsafe String "quoted-string") rule :: Model.Rule rule :: Rule rule = Rulename -> DefinedAs -> Elements -> Rule Model.Rule Rulename ref DefinedAs Model.BasicDefinition ( Alternation -> Elements Model.Elements (Alternation -> Elements) -> Alternation -> Elements forall a b. (a -> b) -> a -> b $ [Concatenation] -> Alternation Model.Alternation [[Repetition] -> Concatenation Model.Concatenation [ Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Rulename -> Element Model.RulenameElement Rulename Core.dquoteRef) , Repeat -> Element -> Repetition Model.Repetition (Bound -> Bound -> Repeat Model.RangedRepeat Bound Model.UnBound Bound Model.UnBound) (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] -> Element) -> [Concatenation] -> Element forall a b. (a -> b) -> a -> b $ [ [Repetition] -> Concatenation Model.Concatenation [ Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Element -> Repetition) -> Element -> Repetition forall a b. (a -> b) -> a -> b $ 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 -> Element) -> HexVal -> Element 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.X2, Digit Hex.X1])] , [Repetition] -> Concatenation Model.Concatenation [ Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Element -> Repetition) -> Element -> Repetition forall a b. (a -> b) -> a -> b $ 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 -> Element) -> HexVal -> Element forall a b. (a -> b) -> a -> b $ Seq -> Seq -> HexVal Model.RangeHexVal ([Digit] -> Seq Hex.Seq [Digit Hex.X2, Digit Hex.X3]) ([Digit] -> Seq Hex.Seq [Digit Hex.X7, Digit Hex.XE])] ]) , Repeat -> Element -> Repetition Model.Repetition Repeat Model.NoRepeat (Rulename -> Element Model.RulenameElement Rulename Core.dquoteRef) ] ] ) fromTree :: Tree Model.Rulename -> Either String Model.QuotedString fromTree :: Tree Rulename -> Either String QuotedString fromTree Tree Rulename tree = Either String QuotedString -> (QuotedString -> Either String QuotedString) -> Maybe QuotedString -> Either String QuotedString forall b a. b -> (a -> b) -> Maybe a -> b maybe (String -> Either String QuotedString forall a b. a -> Either a b Left String "quoted-string must be between \" and \"") QuotedString -> Either String QuotedString forall a b. b -> Either a b Right (Maybe QuotedString -> Either String QuotedString) -> Maybe QuotedString -> Either String QuotedString forall a b. (a -> b) -> a -> b $ ByteString -> Maybe (Word8, ByteString, Word8) unconsnoc (Tree Rulename -> ByteString forall a. Tree a -> ByteString Tree.stringify Tree Rulename tree) Maybe (Word8, ByteString, Word8) -> ((Word8, ByteString, Word8) -> Maybe QuotedString) -> Maybe QuotedString 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 m, Word8 l) -> if Word8 h Word8 -> Word8 -> Bool forall a. Eq a => a -> a -> Bool == Word8 34 Bool -> Bool -> Bool && Word8 l Word8 -> Word8 -> Bool forall a. Eq a => a -> a -> Bool == Word8 34 then QuotedString -> Maybe QuotedString forall a. a -> Maybe a Just (ByteString -> QuotedString Model.QuotedString ByteString m) else Maybe QuotedString forall a. Maybe a Nothing unconsnoc :: ByteString -> Maybe (Word8, ByteString, Word8) unconsnoc :: ByteString -> Maybe (Word8, ByteString, Word8) unconsnoc ByteString bs = ByteString -> Maybe (Word8, ByteString) ByteString.uncons ByteString bs Maybe (Word8, ByteString) -> ((Word8, ByteString) -> Maybe (Word8, ByteString, Word8)) -> Maybe (Word8, ByteString, Word8) 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) -> (Word8, ByteString, Word8)) -> Maybe (Word8, ByteString, Word8) forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \(ByteString m, Word8 l) -> (Word8 h, ByteString m, Word8 l)