module Data.BAByNF.ABNF.ToParseable ( ToParseable , toParseable ) where import Data.Functor ((<&>)) import Data.List.NonEmpty qualified as List.NonEmpty import Data.ByteString qualified as ByteString import Data.Attoparsec.ByteString qualified as Attoparsec.ByteString import Data.BAByNF.Util.Ascii qualified as Ascii import Data.BAByNF.Util.Binary qualified as Binary import Data.BAByNF.Util.Decimal qualified as Decimal import Data.BAByNF.Util.Hex qualified as Hex import Data.BAByNF.Core.Parseable (Parseable) import Data.BAByNF.Core.Parseable qualified as Parseable import Data.BAByNF.Core.Repeat qualified as Core.Repeat import Data.BAByNF.Core.Tree (Tree (..)) import Data.BAByNF.Core.Tree qualified as Tree import Data.BAByNF.ABNF.Model import Data.BAByNF.ABNF.PrettyPrint class ToParseable a where toParseable :: a -> Parseable Rulename instance ToParseable Alternation where toParseable :: Alternation -> Parseable Rulename toParseable (Alternation [Concatenation] x) = case [Concatenation] x of [] -> [Char] -> Parseable Rulename forall a. HasCallStack => [Char] -> a error [Char] "empty alt" [Concatenation z'] -> Concatenation -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable Concatenation z' Concatenation _:[Concatenation] _ -> NonEmpty (Parseable Rulename) -> Parseable Rulename forall a. Ref a => NonEmpty (Parseable a) -> Parseable a Parseable.Alt (NonEmpty (Parseable Rulename) -> Parseable Rulename) -> ([Concatenation] -> NonEmpty (Parseable Rulename)) -> [Concatenation] -> Parseable Rulename forall b c a. (b -> c) -> (a -> b) -> a -> c . [Parseable Rulename] -> NonEmpty (Parseable Rulename) forall a. HasCallStack => [a] -> NonEmpty a List.NonEmpty.fromList ([Parseable Rulename] -> NonEmpty (Parseable Rulename)) -> ([Concatenation] -> [Parseable Rulename]) -> [Concatenation] -> NonEmpty (Parseable Rulename) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Concatenation -> Parseable Rulename) -> [Concatenation] -> [Parseable Rulename] forall a b. (a -> b) -> [a] -> [b] map Concatenation -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable ([Concatenation] -> Parseable Rulename) -> [Concatenation] -> Parseable Rulename forall a b. (a -> b) -> a -> b $ [Concatenation] x instance ToParseable Concatenation where toParseable :: Concatenation -> Parseable Rulename toParseable (Concatenation [Repetition] x) = case [Repetition] x of [] -> [Char] -> Parseable Rulename forall a. HasCallStack => [Char] -> a error [Char] "empty seq" [Repetition z'] -> Repetition -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable Repetition z' Repetition _:[Repetition] _ -> NonEmpty (Parseable Rulename) -> Parseable Rulename forall a. Ref a => NonEmpty (Parseable a) -> Parseable a Parseable.Seq (NonEmpty (Parseable Rulename) -> Parseable Rulename) -> ([Repetition] -> NonEmpty (Parseable Rulename)) -> [Repetition] -> Parseable Rulename forall b c a. (b -> c) -> (a -> b) -> a -> c . [Parseable Rulename] -> NonEmpty (Parseable Rulename) forall a. HasCallStack => [a] -> NonEmpty a List.NonEmpty.fromList ([Parseable Rulename] -> NonEmpty (Parseable Rulename)) -> ([Repetition] -> [Parseable Rulename]) -> [Repetition] -> NonEmpty (Parseable Rulename) forall b c a. (b -> c) -> (a -> b) -> a -> c . (Repetition -> Parseable Rulename) -> [Repetition] -> [Parseable Rulename] forall a b. (a -> b) -> [a] -> [b] map Repetition -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable ([Repetition] -> Parseable Rulename) -> [Repetition] -> Parseable Rulename forall a b. (a -> b) -> a -> b $ [Repetition] x instance ToParseable Repetition where toParseable :: Repetition -> Parseable Rulename toParseable (Repetition Repeat r Element x) = case Repeat r of Repeat NoRepeat -> Element -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable Element x Repeat _ -> Parseable Rulename -> Repeat -> Parseable Rulename forall a. Ref a => Parseable a -> Repeat -> Parseable a Parseable.Rep (Element -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable Element x) (Repeat -> Repeat toRepeat Repeat r) where toRepeat :: Repeat -> Repeat toRepeat Repeat NoRepeat = Repeat Core.Repeat.once toRepeat (FixedRepeat Integer i) = Natural -> Repeat Core.Repeat.exactly (Integer -> Natural forall a. Num a => Integer -> a fromInteger Integer i) toRepeat (RangedRepeat Bound lo Bound hi) = let req :: Natural req = case Bound lo of Bound UnBound -> Natural 0; (FixedBound Integer l) -> Integer -> Natural forall a. Num a => Integer -> a fromInteger Integer l opt :: Maybe Natural opt = case Bound hi of Bound UnBound -> Maybe Natural forall a. Maybe a Nothing; (FixedBound Integer h) -> if Natural req Natural -> Natural -> Bool forall a. Ord a => a -> a -> Bool > Integer -> Natural forall a. Num a => Integer -> a fromInteger Integer h then [Char] -> Maybe Natural forall a. HasCallStack => [Char] -> a error [Char] "fail" else Natural -> Maybe Natural forall a. a -> Maybe a Just (Natural -> Maybe Natural) -> Natural -> Maybe Natural forall a b. (a -> b) -> a -> b $ Integer -> Natural forall a. Num a => Integer -> a fromInteger Integer h Natural -> Natural -> Natural forall a. Num a => a -> a -> a - Natural req in Natural -> Maybe Natural -> Repeat Core.Repeat.from Natural req Maybe Natural opt instance ToParseable Element where toParseable :: Element -> Parseable Rulename toParseable Element e = case Element e of (RulenameElement Rulename r) -> Rulename -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable Rulename r (GroupElement Group g) -> Group -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable Group g (OptionElement Option o) -> Option -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable Option o (CharValElement CharVal c) -> CharVal -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable CharVal c (NumValElement NumVal n) -> NumVal -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable NumVal n (ProseValElement ProseVal p) -> ProseVal -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable ProseVal p instance ToParseable Rulename where toParseable :: Rulename -> Parseable Rulename toParseable = Rulename -> Parseable Rulename forall a. Ref a => a -> Parseable a Parseable.Rule instance ToParseable Group where toParseable :: Group -> Parseable Rulename toParseable (Group Alternation a) = Alternation -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable Alternation a instance ToParseable Option where toParseable :: Option -> Parseable Rulename toParseable (Option Alternation a) = Parseable Rulename -> Repeat -> Parseable Rulename forall a. Ref a => Parseable a -> Repeat -> Parseable a Parseable.Rep (Alternation -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable Alternation a) Repeat Core.Repeat.maybeOnce instance ToParseable CharVal where toParseable :: CharVal -> Parseable Rulename toParseable CharVal charVal = case CharVal charVal of CaseInsensitiveCharVal CaseInsensitiveString ci -> CaseInsensitiveString -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable CaseInsensitiveString ci CaseSensitiveCharVal CaseSensitiveString cs -> CaseSensitiveString -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable CaseSensitiveString cs instance ToParseable CaseInsensitiveString where toParseable :: CaseInsensitiveString -> Parseable Rulename toParseable (CaseInsensitiveString x :: QuotedString x@(QuotedString ByteString b)) = [Char] -> TreeParser Rulename -> Parseable Rulename forall a. [Char] -> TreeParser a -> Parseable a Parseable.Unit (QuotedString -> [Char] forall a. PrettyPrint a => a -> [Char] prettyPrint QuotedString x) (ByteString -> Parser ByteString Ascii.parseCaseInsensitive ByteString b Parser ByteString -> (ByteString -> Tree Rulename) -> TreeParser Rulename forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> (\ByteString b' -> ([Node Rulename] -> Tree Rulename forall a. Ref a => [Node a] -> Tree a Tree [ByteString -> Node Rulename forall a. ByteString -> Node a Tree.StringNode ByteString b']))) instance ToParseable CaseSensitiveString where toParseable :: CaseSensitiveString -> Parseable Rulename toParseable (CaseSensitiveString x :: QuotedString x@(QuotedString ByteString b)) = [Char] -> TreeParser Rulename -> Parseable Rulename forall a. [Char] -> TreeParser a -> Parseable a Parseable.Unit (QuotedString -> [Char] forall a. PrettyPrint a => a -> [Char] prettyPrint QuotedString x) (ByteString -> Parser ByteString Ascii.parseCaseSensitive ByteString b Parser ByteString -> (ByteString -> Tree Rulename) -> TreeParser Rulename forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> (\ByteString b' -> ([Node Rulename] -> Tree Rulename forall a. Ref a => [Node a] -> Tree a Tree [ByteString -> Node Rulename forall a. ByteString -> Node a Tree.StringNode ByteString b']))) instance ToParseable ProseVal where toParseable :: ProseVal -> Parseable Rulename toParseable ProseVal x = [Char] -> TreeParser Rulename -> Parseable Rulename forall a. [Char] -> TreeParser a -> Parseable a Parseable.Unit (ProseVal -> [Char] forall a. PrettyPrint a => a -> [Char] prettyPrint ProseVal x) ([Char] -> TreeParser Rulename forall a. [Char] -> Parser ByteString a forall (m :: * -> *) a. MonadFail m => [Char] -> m a fail [Char] "prose-val not supported yet") instance ToParseable NumVal where toParseable :: NumVal -> Parseable Rulename toParseable NumVal numVal = case NumVal numVal of BinNumVal BinVal b -> BinVal -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable BinVal b DecNumVal DecVal d -> DecVal -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable DecVal d HexNumVal HexVal x -> HexVal -> Parseable Rulename forall a. ToParseable a => a -> Parseable Rulename toParseable HexVal x instance ToParseable BinVal where toParseable :: BinVal -> Parseable Rulename toParseable BinVal x = case BinVal x of SeqBinVal [Seq] s -> [Char] -> TreeParser Rulename -> Parseable Rulename forall a. [Char] -> TreeParser a -> Parseable a Parseable.Unit (BinVal -> [Char] forall a. PrettyPrint a => a -> [Char] prettyPrint BinVal x) (TreeParser Rulename -> Parseable Rulename) -> TreeParser Rulename -> Parseable Rulename forall a b. (a -> b) -> a -> b $ ByteString -> Parser ByteString Attoparsec.ByteString.string ([Word8] -> ByteString ByteString.pack ([Word8] -> ByteString) -> [Word8] -> ByteString forall a b. (a -> b) -> a -> b $ (Seq -> Word8) -> [Seq] -> [Word8] forall a b. (a -> b) -> [a] -> [b] map Seq -> Word8 forall a. Integral a => Seq -> a Binary.toNum [Seq] s) Parser ByteString -> (ByteString -> Tree Rulename) -> TreeParser Rulename forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> (\ByteString b' -> [Node Rulename] -> Tree Rulename forall a. Ref a => [Node a] -> Tree a Tree [ByteString -> Node Rulename forall a. ByteString -> Node a Tree.StringNode ByteString b']) RangeBinVal Seq lo Seq hi -> [Char] -> TreeParser Rulename -> Parseable Rulename forall a. [Char] -> TreeParser a -> Parseable a Parseable.Unit (BinVal -> [Char] forall a. PrettyPrint a => a -> [Char] prettyPrint BinVal x) (TreeParser Rulename -> Parseable Rulename) -> TreeParser Rulename -> Parseable Rulename forall a b. (a -> b) -> a -> b $ (Word8 -> Bool) -> Parser Word8 Attoparsec.ByteString.satisfy (\Word8 w -> Word8 w Word8 -> Word8 -> Bool forall a. Ord a => a -> a -> Bool >= Seq -> Word8 forall a. Integral a => Seq -> a Binary.toNum Seq lo Bool -> Bool -> Bool && Word8 w Word8 -> Word8 -> Bool forall a. Ord a => a -> a -> Bool <= Seq -> Word8 forall a. Integral a => Seq -> a Binary.toNum Seq hi) Parser Word8 -> (Word8 -> Tree Rulename) -> TreeParser Rulename forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \Word8 w -> [Node Rulename] -> Tree Rulename forall a. Ref a => [Node a] -> Tree a Tree [ByteString -> Node Rulename forall a. ByteString -> Node a Tree.StringNode (Word8 -> ByteString ByteString.singleton Word8 w)] instance ToParseable DecVal where toParseable :: DecVal -> Parseable Rulename toParseable DecVal x = case DecVal x of SeqDecVal [Seq] s -> [Char] -> TreeParser Rulename -> Parseable Rulename forall a. [Char] -> TreeParser a -> Parseable a Parseable.Unit (DecVal -> [Char] forall a. PrettyPrint a => a -> [Char] prettyPrint DecVal x) (TreeParser Rulename -> Parseable Rulename) -> TreeParser Rulename -> Parseable Rulename forall a b. (a -> b) -> a -> b $ ByteString -> Parser ByteString Attoparsec.ByteString.string ([Word8] -> ByteString ByteString.pack ([Word8] -> ByteString) -> [Word8] -> ByteString forall a b. (a -> b) -> a -> b $ (Seq -> Word8) -> [Seq] -> [Word8] forall a b. (a -> b) -> [a] -> [b] map Seq -> Word8 forall a. Integral a => Seq -> a Decimal.toNum [Seq] s) Parser ByteString -> (ByteString -> Tree Rulename) -> TreeParser Rulename forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> (\ByteString b' -> [Node Rulename] -> Tree Rulename forall a. Ref a => [Node a] -> Tree a Tree [ByteString -> Node Rulename forall a. ByteString -> Node a Tree.StringNode ByteString b']) RangeDecVal Seq lo Seq hi -> [Char] -> TreeParser Rulename -> Parseable Rulename forall a. [Char] -> TreeParser a -> Parseable a Parseable.Unit (DecVal -> [Char] forall a. PrettyPrint a => a -> [Char] prettyPrint DecVal x) (TreeParser Rulename -> Parseable Rulename) -> TreeParser Rulename -> Parseable Rulename forall a b. (a -> b) -> a -> b $ (Word8 -> Bool) -> Parser Word8 Attoparsec.ByteString.satisfy (\Word8 w -> Word8 w Word8 -> Word8 -> Bool forall a. Ord a => a -> a -> Bool >= Seq -> Word8 forall a. Integral a => Seq -> a Decimal.toNum Seq lo Bool -> Bool -> Bool && Word8 w Word8 -> Word8 -> Bool forall a. Ord a => a -> a -> Bool <= Seq -> Word8 forall a. Integral a => Seq -> a Decimal.toNum Seq hi) Parser Word8 -> (Word8 -> Tree Rulename) -> TreeParser Rulename forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \Word8 w -> [Node Rulename] -> Tree Rulename forall a. Ref a => [Node a] -> Tree a Tree [ByteString -> Node Rulename forall a. ByteString -> Node a Tree.StringNode (Word8 -> ByteString ByteString.singleton Word8 w)] instance ToParseable HexVal where toParseable :: HexVal -> Parseable Rulename toParseable HexVal x = case HexVal x of SeqHexVal [Seq] s -> [Char] -> TreeParser Rulename -> Parseable Rulename forall a. [Char] -> TreeParser a -> Parseable a Parseable.Unit (HexVal -> [Char] forall a. PrettyPrint a => a -> [Char] prettyPrint HexVal x) (TreeParser Rulename -> Parseable Rulename) -> TreeParser Rulename -> Parseable Rulename forall a b. (a -> b) -> a -> b $ ByteString -> Parser ByteString Attoparsec.ByteString.string ([Word8] -> ByteString ByteString.pack ([Word8] -> ByteString) -> [Word8] -> ByteString forall a b. (a -> b) -> a -> b $ (Seq -> Word8) -> [Seq] -> [Word8] forall a b. (a -> b) -> [a] -> [b] map Seq -> Word8 forall a. Integral a => Seq -> a Hex.toNum [Seq] s) Parser ByteString -> (ByteString -> Tree Rulename) -> TreeParser Rulename forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> (\ByteString b' -> [Node Rulename] -> Tree Rulename forall a. Ref a => [Node a] -> Tree a Tree [ByteString -> Node Rulename forall a. ByteString -> Node a Tree.StringNode ByteString b']) RangeHexVal Seq lo Seq hi -> [Char] -> TreeParser Rulename -> Parseable Rulename forall a. [Char] -> TreeParser a -> Parseable a Parseable.Unit (HexVal -> [Char] forall a. PrettyPrint a => a -> [Char] prettyPrint HexVal x) (TreeParser Rulename -> Parseable Rulename) -> TreeParser Rulename -> Parseable Rulename forall a b. (a -> b) -> a -> b $ (Word8 -> Bool) -> Parser Word8 Attoparsec.ByteString.satisfy (\Word8 w -> Word8 w Word8 -> Word8 -> Bool forall a. Ord a => a -> a -> Bool >= Seq -> Word8 forall a. Integral a => Seq -> a Hex.toNum Seq lo Bool -> Bool -> Bool && Word8 w Word8 -> Word8 -> Bool forall a. Ord a => a -> a -> Bool <= Seq -> Word8 forall a. Integral a => Seq -> a Hex.toNum Seq hi) Parser Word8 -> (Word8 -> Tree Rulename) -> TreeParser Rulename forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b <&> \Word8 w -> [Node Rulename] -> Tree Rulename forall a. Ref a => [Node a] -> Tree a Tree [ByteString -> Node Rulename forall a. ByteString -> Node a Tree.StringNode (Word8 -> ByteString ByteString.singleton Word8 w)]