{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, GADTs #-}
{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}

module Data.Binary.Combinators
( Many(..)
, Some(..)
, CountedBy(..)
, SkipCount(..)
, SkipByte(..)
, MatchBytes
, matchBytes
) where

import Control.Applicative
import Control.Monad
import Data.Binary
import Data.Binary.Get(lookAhead)
import Data.Functor
import Data.Kind
import Data.Proxy
import GHC.TypeLits
import Numeric
import Test.QuickCheck


newtype Many a = Many { Many a -> [a]
getMany :: [a] } deriving (Many a -> Many a -> Bool
(Many a -> Many a -> Bool)
-> (Many a -> Many a -> Bool) -> Eq (Many a)
forall a. Eq a => Many a -> Many a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Many a -> Many a -> Bool
$c/= :: forall a. Eq a => Many a -> Many a -> Bool
== :: Many a -> Many a -> Bool
$c== :: forall a. Eq a => Many a -> Many a -> Bool
Eq, Eq (Many a)
Eq (Many a)
-> (Many a -> Many a -> Ordering)
-> (Many a -> Many a -> Bool)
-> (Many a -> Many a -> Bool)
-> (Many a -> Many a -> Bool)
-> (Many a -> Many a -> Bool)
-> (Many a -> Many a -> Many a)
-> (Many a -> Many a -> Many a)
-> Ord (Many a)
Many a -> Many a -> Bool
Many a -> Many a -> Ordering
Many a -> Many a -> Many a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Many a)
forall a. Ord a => Many a -> Many a -> Bool
forall a. Ord a => Many a -> Many a -> Ordering
forall a. Ord a => Many a -> Many a -> Many a
min :: Many a -> Many a -> Many a
$cmin :: forall a. Ord a => Many a -> Many a -> Many a
max :: Many a -> Many a -> Many a
$cmax :: forall a. Ord a => Many a -> Many a -> Many a
>= :: Many a -> Many a -> Bool
$c>= :: forall a. Ord a => Many a -> Many a -> Bool
> :: Many a -> Many a -> Bool
$c> :: forall a. Ord a => Many a -> Many a -> Bool
<= :: Many a -> Many a -> Bool
$c<= :: forall a. Ord a => Many a -> Many a -> Bool
< :: Many a -> Many a -> Bool
$c< :: forall a. Ord a => Many a -> Many a -> Bool
compare :: Many a -> Many a -> Ordering
$ccompare :: forall a. Ord a => Many a -> Many a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Many a)
Ord)

instance Show a => Show (Many a) where
  show :: Many a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (Many a -> [a]) -> Many a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many a -> [a]
forall a. Many a -> [a]
getMany

instance Binary a => Binary (Many a) where
  get :: Get (Many a)
get = [a] -> Many a
forall a. [a] -> Many a
Many ([a] -> Many a) -> Get [a] -> Get (Many a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Get a
forall t. Binary t => Get t
get
  put :: Many a -> Put
put = (a -> Put) -> [a] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> Put
forall t. Binary t => t -> Put
put ([a] -> Put) -> (Many a -> [a]) -> Many a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Many a -> [a]
forall a. Many a -> [a]
getMany

instance Arbitrary a => Arbitrary (Many a) where
  arbitrary :: Gen (Many a)
arbitrary = [a] -> Many a
forall a. [a] -> Many a
Many ([a] -> Many a) -> Gen [a] -> Gen (Many a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [a]
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Many a -> [Many a]
shrink (Many [a]
xs) = [a] -> Many a
forall a. [a] -> Many a
Many ([a] -> Many a) -> [[a]] -> [Many a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [[a]]
forall a. Arbitrary a => a -> [a]
shrink [a]
xs


newtype Some a = Some { Some a -> [a]
getSome :: [a] } deriving (Some a -> Some a -> Bool
(Some a -> Some a -> Bool)
-> (Some a -> Some a -> Bool) -> Eq (Some a)
forall a. Eq a => Some a -> Some a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Some a -> Some a -> Bool
$c/= :: forall a. Eq a => Some a -> Some a -> Bool
== :: Some a -> Some a -> Bool
$c== :: forall a. Eq a => Some a -> Some a -> Bool
Eq, Eq (Some a)
Eq (Some a)
-> (Some a -> Some a -> Ordering)
-> (Some a -> Some a -> Bool)
-> (Some a -> Some a -> Bool)
-> (Some a -> Some a -> Bool)
-> (Some a -> Some a -> Bool)
-> (Some a -> Some a -> Some a)
-> (Some a -> Some a -> Some a)
-> Ord (Some a)
Some a -> Some a -> Bool
Some a -> Some a -> Ordering
Some a -> Some a -> Some a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Some a)
forall a. Ord a => Some a -> Some a -> Bool
forall a. Ord a => Some a -> Some a -> Ordering
forall a. Ord a => Some a -> Some a -> Some a
min :: Some a -> Some a -> Some a
$cmin :: forall a. Ord a => Some a -> Some a -> Some a
max :: Some a -> Some a -> Some a
$cmax :: forall a. Ord a => Some a -> Some a -> Some a
>= :: Some a -> Some a -> Bool
$c>= :: forall a. Ord a => Some a -> Some a -> Bool
> :: Some a -> Some a -> Bool
$c> :: forall a. Ord a => Some a -> Some a -> Bool
<= :: Some a -> Some a -> Bool
$c<= :: forall a. Ord a => Some a -> Some a -> Bool
< :: Some a -> Some a -> Bool
$c< :: forall a. Ord a => Some a -> Some a -> Bool
compare :: Some a -> Some a -> Ordering
$ccompare :: forall a. Ord a => Some a -> Some a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Some a)
Ord)

instance Show a => Show (Some a) where
  show :: Some a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String) -> (Some a -> [a]) -> Some a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Some a -> [a]
forall a. Some a -> [a]
getSome

instance Binary a => Binary (Some a) where
  get :: Get (Some a)
get = [a] -> Some a
forall a. [a] -> Some a
Some ([a] -> Some a) -> Get [a] -> Get (Some a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a -> Get [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Get a
forall t. Binary t => Get t
get
  put :: Some a -> Put
put = (a -> Put) -> [a] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> Put
forall t. Binary t => t -> Put
put ([a] -> Put) -> (Some a -> [a]) -> Some a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Some a -> [a]
forall a. Some a -> [a]
getSome

instance Arbitrary a => Arbitrary (Some a) where
  arbitrary :: Gen (Some a)
arbitrary = [a] -> Some a
forall a. [a] -> Some a
Some ([a] -> Some a)
-> (NonEmptyList a -> [a]) -> NonEmptyList a -> Some a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmptyList a -> [a]
forall a. NonEmptyList a -> [a]
getNonEmpty (NonEmptyList a -> Some a) -> Gen (NonEmptyList a) -> Gen (Some a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NonEmptyList a)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Some a -> [Some a]
shrink (Some [a]
xs) = [a] -> Some a
forall a. [a] -> Some a
Some ([a] -> Some a) -> [[a]] -> [Some a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([a] -> [[a]]
forall a. Arbitrary a => a -> [a]
shrink [a]
xs)


newtype CountedBy ty a = CountedBy { CountedBy ty a -> [a]
getCounted :: [a] } deriving (CountedBy ty a -> CountedBy ty a -> Bool
(CountedBy ty a -> CountedBy ty a -> Bool)
-> (CountedBy ty a -> CountedBy ty a -> Bool)
-> Eq (CountedBy ty a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (ty :: k) a.
Eq a =>
CountedBy ty a -> CountedBy ty a -> Bool
/= :: CountedBy ty a -> CountedBy ty a -> Bool
$c/= :: forall k (ty :: k) a.
Eq a =>
CountedBy ty a -> CountedBy ty a -> Bool
== :: CountedBy ty a -> CountedBy ty a -> Bool
$c== :: forall k (ty :: k) a.
Eq a =>
CountedBy ty a -> CountedBy ty a -> Bool
Eq, Eq (CountedBy ty a)
Eq (CountedBy ty a)
-> (CountedBy ty a -> CountedBy ty a -> Ordering)
-> (CountedBy ty a -> CountedBy ty a -> Bool)
-> (CountedBy ty a -> CountedBy ty a -> Bool)
-> (CountedBy ty a -> CountedBy ty a -> Bool)
-> (CountedBy ty a -> CountedBy ty a -> Bool)
-> (CountedBy ty a -> CountedBy ty a -> CountedBy ty a)
-> (CountedBy ty a -> CountedBy ty a -> CountedBy ty a)
-> Ord (CountedBy ty a)
CountedBy ty a -> CountedBy ty a -> Bool
CountedBy ty a -> CountedBy ty a -> Ordering
CountedBy ty a -> CountedBy ty a -> CountedBy ty a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (ty :: k) a. Ord a => Eq (CountedBy ty a)
forall k (ty :: k) a.
Ord a =>
CountedBy ty a -> CountedBy ty a -> Bool
forall k (ty :: k) a.
Ord a =>
CountedBy ty a -> CountedBy ty a -> Ordering
forall k (ty :: k) a.
Ord a =>
CountedBy ty a -> CountedBy ty a -> CountedBy ty a
min :: CountedBy ty a -> CountedBy ty a -> CountedBy ty a
$cmin :: forall k (ty :: k) a.
Ord a =>
CountedBy ty a -> CountedBy ty a -> CountedBy ty a
max :: CountedBy ty a -> CountedBy ty a -> CountedBy ty a
$cmax :: forall k (ty :: k) a.
Ord a =>
CountedBy ty a -> CountedBy ty a -> CountedBy ty a
>= :: CountedBy ty a -> CountedBy ty a -> Bool
$c>= :: forall k (ty :: k) a.
Ord a =>
CountedBy ty a -> CountedBy ty a -> Bool
> :: CountedBy ty a -> CountedBy ty a -> Bool
$c> :: forall k (ty :: k) a.
Ord a =>
CountedBy ty a -> CountedBy ty a -> Bool
<= :: CountedBy ty a -> CountedBy ty a -> Bool
$c<= :: forall k (ty :: k) a.
Ord a =>
CountedBy ty a -> CountedBy ty a -> Bool
< :: CountedBy ty a -> CountedBy ty a -> Bool
$c< :: forall k (ty :: k) a.
Ord a =>
CountedBy ty a -> CountedBy ty a -> Bool
compare :: CountedBy ty a -> CountedBy ty a -> Ordering
$ccompare :: forall k (ty :: k) a.
Ord a =>
CountedBy ty a -> CountedBy ty a -> Ordering
$cp1Ord :: forall k (ty :: k) a. Ord a => Eq (CountedBy ty a)
Ord)

instance Show a => Show (CountedBy ty a) where
  show :: CountedBy ty a -> String
show = [a] -> String
forall a. Show a => a -> String
show ([a] -> String)
-> (CountedBy ty a -> [a]) -> CountedBy ty a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CountedBy ty a -> [a]
forall k (ty :: k) a. CountedBy ty a -> [a]
getCounted

instance (Integral ty, Binary ty, Binary a) => Binary (CountedBy ty a) where
  get :: Get (CountedBy ty a)
get = do ty
cnt :: ty <- Get ty
forall t. Binary t => Get t
get
           [a] -> CountedBy ty a
forall k (ty :: k) a. [a] -> CountedBy ty a
CountedBy ([a] -> CountedBy ty a) -> Get [a] -> Get (CountedBy ty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Get a -> Get [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (ty -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ty
cnt) Get a
forall t. Binary t => Get t
get
  put :: CountedBy ty a -> Put
put (CountedBy [a]
xs) = ty -> Put
forall t. Binary t => t -> Put
put (Int -> ty
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> ty) -> Int -> ty
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs :: ty) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (a -> Put) -> [a] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> Put
forall t. Binary t => t -> Put
put [a]
xs

instance Arbitrary a => Arbitrary (CountedBy ty a) where
  arbitrary :: Gen (CountedBy ty a)
arbitrary = [a] -> CountedBy ty a
forall k (ty :: k) a. [a] -> CountedBy ty a
CountedBy ([a] -> CountedBy ty a) -> Gen [a] -> Gen (CountedBy ty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [a]
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: CountedBy ty a -> [CountedBy ty a]
shrink (CountedBy [a]
xs) = [a] -> CountedBy ty a
forall k (ty :: k) a. [a] -> CountedBy ty a
CountedBy ([a] -> CountedBy ty a) -> [[a]] -> [CountedBy ty a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a] -> [[a]]
forall a. Arbitrary a => a -> [a]
shrink [a]
xs


data SkipCount ty (n :: Nat) = SkipCount deriving (SkipCount ty n -> SkipCount ty n -> Bool
(SkipCount ty n -> SkipCount ty n -> Bool)
-> (SkipCount ty n -> SkipCount ty n -> Bool)
-> Eq (SkipCount ty n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> Bool
/= :: SkipCount ty n -> SkipCount ty n -> Bool
$c/= :: forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> Bool
== :: SkipCount ty n -> SkipCount ty n -> Bool
$c== :: forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> Bool
Eq, Eq (SkipCount ty n)
Eq (SkipCount ty n)
-> (SkipCount ty n -> SkipCount ty n -> Ordering)
-> (SkipCount ty n -> SkipCount ty n -> Bool)
-> (SkipCount ty n -> SkipCount ty n -> Bool)
-> (SkipCount ty n -> SkipCount ty n -> Bool)
-> (SkipCount ty n -> SkipCount ty n -> Bool)
-> (SkipCount ty n -> SkipCount ty n -> SkipCount ty n)
-> (SkipCount ty n -> SkipCount ty n -> SkipCount ty n)
-> Ord (SkipCount ty n)
SkipCount ty n -> SkipCount ty n -> Bool
SkipCount ty n -> SkipCount ty n -> Ordering
SkipCount ty n -> SkipCount ty n -> SkipCount ty n
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k (ty :: k) (n :: Nat). Eq (SkipCount ty n)
forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> Bool
forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> Ordering
forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> SkipCount ty n
min :: SkipCount ty n -> SkipCount ty n -> SkipCount ty n
$cmin :: forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> SkipCount ty n
max :: SkipCount ty n -> SkipCount ty n -> SkipCount ty n
$cmax :: forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> SkipCount ty n
>= :: SkipCount ty n -> SkipCount ty n -> Bool
$c>= :: forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> Bool
> :: SkipCount ty n -> SkipCount ty n -> Bool
$c> :: forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> Bool
<= :: SkipCount ty n -> SkipCount ty n -> Bool
$c<= :: forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> Bool
< :: SkipCount ty n -> SkipCount ty n -> Bool
$c< :: forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> Bool
compare :: SkipCount ty n -> SkipCount ty n -> Ordering
$ccompare :: forall k (ty :: k) (n :: Nat).
SkipCount ty n -> SkipCount ty n -> Ordering
$cp1Ord :: forall k (ty :: k) (n :: Nat). Eq (SkipCount ty n)
Ord, Int -> SkipCount ty n -> ShowS
[SkipCount ty n] -> ShowS
SkipCount ty n -> String
(Int -> SkipCount ty n -> ShowS)
-> (SkipCount ty n -> String)
-> ([SkipCount ty n] -> ShowS)
-> Show (SkipCount ty n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (ty :: k) (n :: Nat). Int -> SkipCount ty n -> ShowS
forall k (ty :: k) (n :: Nat). [SkipCount ty n] -> ShowS
forall k (ty :: k) (n :: Nat). SkipCount ty n -> String
showList :: [SkipCount ty n] -> ShowS
$cshowList :: forall k (ty :: k) (n :: Nat). [SkipCount ty n] -> ShowS
show :: SkipCount ty n -> String
$cshow :: forall k (ty :: k) (n :: Nat). SkipCount ty n -> String
showsPrec :: Int -> SkipCount ty n -> ShowS
$cshowsPrec :: forall k (ty :: k) (n :: Nat). Int -> SkipCount ty n -> ShowS
Show)

instance (Num ty, Binary ty, KnownNat n) => Binary (SkipCount ty n) where
  get :: Get (SkipCount ty n)
get   = Int -> Get ty -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)) (Get ty
forall t. Binary t => Get t
get :: Get ty) Get () -> SkipCount ty n -> Get (SkipCount ty n)
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SkipCount ty n
forall k (ty :: k) (n :: Nat). SkipCount ty n
SkipCount
  put :: SkipCount ty n -> Put
put SkipCount ty n
_ = Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)) (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ ty -> Put
forall t. Binary t => t -> Put
put (ty
0 :: ty)

instance Arbitrary (SkipCount ty n) where
  arbitrary :: Gen (SkipCount ty n)
arbitrary = SkipCount ty n -> Gen (SkipCount ty n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SkipCount ty n
forall k (ty :: k) (n :: Nat). SkipCount ty n
SkipCount


data SkipByte (n :: Nat) = SkipByte deriving (SkipByte n -> SkipByte n -> Bool
(SkipByte n -> SkipByte n -> Bool)
-> (SkipByte n -> SkipByte n -> Bool) -> Eq (SkipByte n)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (n :: Nat). SkipByte n -> SkipByte n -> Bool
/= :: SkipByte n -> SkipByte n -> Bool
$c/= :: forall (n :: Nat). SkipByte n -> SkipByte n -> Bool
== :: SkipByte n -> SkipByte n -> Bool
$c== :: forall (n :: Nat). SkipByte n -> SkipByte n -> Bool
Eq, Eq (SkipByte n)
Eq (SkipByte n)
-> (SkipByte n -> SkipByte n -> Ordering)
-> (SkipByte n -> SkipByte n -> Bool)
-> (SkipByte n -> SkipByte n -> Bool)
-> (SkipByte n -> SkipByte n -> Bool)
-> (SkipByte n -> SkipByte n -> Bool)
-> (SkipByte n -> SkipByte n -> SkipByte n)
-> (SkipByte n -> SkipByte n -> SkipByte n)
-> Ord (SkipByte n)
SkipByte n -> SkipByte n -> Bool
SkipByte n -> SkipByte n -> Ordering
SkipByte n -> SkipByte n -> SkipByte n
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall (n :: Nat). Eq (SkipByte n)
forall (n :: Nat). SkipByte n -> SkipByte n -> Bool
forall (n :: Nat). SkipByte n -> SkipByte n -> Ordering
forall (n :: Nat). SkipByte n -> SkipByte n -> SkipByte n
min :: SkipByte n -> SkipByte n -> SkipByte n
$cmin :: forall (n :: Nat). SkipByte n -> SkipByte n -> SkipByte n
max :: SkipByte n -> SkipByte n -> SkipByte n
$cmax :: forall (n :: Nat). SkipByte n -> SkipByte n -> SkipByte n
>= :: SkipByte n -> SkipByte n -> Bool
$c>= :: forall (n :: Nat). SkipByte n -> SkipByte n -> Bool
> :: SkipByte n -> SkipByte n -> Bool
$c> :: forall (n :: Nat). SkipByte n -> SkipByte n -> Bool
<= :: SkipByte n -> SkipByte n -> Bool
$c<= :: forall (n :: Nat). SkipByte n -> SkipByte n -> Bool
< :: SkipByte n -> SkipByte n -> Bool
$c< :: forall (n :: Nat). SkipByte n -> SkipByte n -> Bool
compare :: SkipByte n -> SkipByte n -> Ordering
$ccompare :: forall (n :: Nat). SkipByte n -> SkipByte n -> Ordering
$cp1Ord :: forall (n :: Nat). Eq (SkipByte n)
Ord, Int -> SkipByte n -> ShowS
[SkipByte n] -> ShowS
SkipByte n -> String
(Int -> SkipByte n -> ShowS)
-> (SkipByte n -> String)
-> ([SkipByte n] -> ShowS)
-> Show (SkipByte n)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (n :: Nat). Int -> SkipByte n -> ShowS
forall (n :: Nat). [SkipByte n] -> ShowS
forall (n :: Nat). SkipByte n -> String
showList :: [SkipByte n] -> ShowS
$cshowList :: forall (n :: Nat). [SkipByte n] -> ShowS
show :: SkipByte n -> String
$cshow :: forall (n :: Nat). SkipByte n -> String
showsPrec :: Int -> SkipByte n -> ShowS
$cshowsPrec :: forall (n :: Nat). Int -> SkipByte n -> ShowS
Show)

instance (KnownNat n) => Binary (SkipByte n) where
  get :: Get (SkipByte n)
get   = do Word8
nextByte <- Get Word8 -> Get Word8
forall a. Get a -> Get a
lookAhead Get Word8
forall t. Binary t => Get t
get
             if Word8
nextByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
expected
             then SkipByte n -> Get (SkipByte n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SkipByte n
forall (n :: Nat). SkipByte n
SkipByte
             else (Get Word8
forall t. Binary t => Get t
get :: Get Word8) Get Word8 -> Get (SkipByte n) -> Get (SkipByte n)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Get (SkipByte n)
forall t. Binary t => Get t
get
    where
      expected :: Word8
      expected :: Word8
expected = Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word8) -> Integer -> Word8
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)
  put :: SkipByte n -> Put
put SkipByte n
_ = () -> Put
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Arbitrary (SkipByte n) where
  arbitrary :: Gen (SkipByte n)
arbitrary = SkipByte n -> Gen (SkipByte n)
forall (f :: * -> *) a. Applicative f => a -> f a
pure SkipByte n
forall (n :: Nat). SkipByte n
SkipByte


data MatchBytes :: Symbol -> [Nat] -> Type where
  ConsumeNil  :: MatchBytes ctx '[]
  ConsumeCons :: KnownNat n => Proxy n -> MatchBytes ctx ns -> MatchBytes ctx (n ': ns)

deriving instance Eq (MatchBytes s ns)
deriving instance Ord (MatchBytes s ns)

instance Binary (MatchBytes ctx '[]) where
  get :: Get (MatchBytes ctx '[])
get = MatchBytes ctx '[] -> Get (MatchBytes ctx '[])
forall (f :: * -> *) a. Applicative f => a -> f a
pure MatchBytes ctx '[]
forall (ctx :: Symbol). MatchBytes ctx '[]
ConsumeNil
  put :: MatchBytes ctx '[] -> Put
put MatchBytes ctx '[]
_ = () -> Put
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance (KnownSymbol ctx, KnownNat n, Binary (MatchBytes ctx ns)) => Binary (MatchBytes ctx (n : ns)) where
  get :: Get (MatchBytes ctx (n : ns))
get = do Word8
byte <- Get Word8
forall t. Binary t => Get t
get
           Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
byte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
expected) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ String -> Get ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Get ()) -> String -> Get ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected byte 0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
byte String
", expected 0x"
                                                                 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex Word8
expected String
" when parsing "
                                                                 String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Proxy ctx -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy ctx
forall k (t :: k). Proxy t
Proxy :: Proxy ctx)
           Proxy n -> MatchBytes ctx ns -> MatchBytes ctx (n : ns)
forall (n :: Nat) (ctx :: Symbol) (ns :: [Nat]).
KnownNat n =>
Proxy n -> MatchBytes ctx ns -> MatchBytes ctx (n : ns)
ConsumeCons Proxy n
forall k (t :: k). Proxy t
Proxy (MatchBytes ctx ns -> MatchBytes ctx (n : ns))
-> Get (MatchBytes ctx ns) -> Get (MatchBytes ctx (n : ns))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (MatchBytes ctx ns)
forall t. Binary t => Get t
get
    where
      expected :: Word8
      expected :: Word8
expected = Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Integer -> Word8) -> Integer -> Word8
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n
forall k (t :: k). Proxy t
Proxy :: Proxy n)

  put :: MatchBytes ctx (n : ns) -> Put
put (ConsumeCons Proxy n
proxy MatchBytes ctx ns
ns) = Word8 -> Put
forall t. Binary t => t -> Put
put Word8
theByte Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MatchBytes ctx ns -> Put
forall t. Binary t => t -> Put
put MatchBytes ctx ns
ns
    where
      theByte :: Word8
      theByte :: Word8
theByte = Integer -> Word8
forall a. Num a => Integer -> a
fromInteger (Integer -> Word8) -> Integer -> Word8
forall a b. (a -> b) -> a -> b
$ Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
proxy

instance Show (MatchBytes ctx ns) where
  show :: MatchBytes ctx ns -> String
show MatchBytes ctx ns
bs = String
"Marker [ " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> MatchBytes ctx ns -> String
forall (ctx :: Symbol) (ns :: [Nat]). MatchBytes ctx ns -> String
go MatchBytes ctx ns
bs String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"]"
    where
      go :: MatchBytes ctx' ns' -> String
      go :: MatchBytes ctx' ns' -> String
go MatchBytes ctx' ns'
ConsumeNil = String
""
      go (ConsumeCons Proxy n
proxy MatchBytes ctx' ns
ns) = String
"0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Integer -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex (Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal Proxy n
proxy) String
" " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> MatchBytes ctx' ns -> String
forall (ctx :: Symbol) (ns :: [Nat]). MatchBytes ctx ns -> String
go MatchBytes ctx' ns
ns

class MatchBytesSing ctx ns where
  matchBytesSing :: MatchBytes ctx ns

instance MatchBytesSing ctx '[] where
  matchBytesSing :: MatchBytes ctx '[]
matchBytesSing = MatchBytes ctx '[]
forall (ctx :: Symbol). MatchBytes ctx '[]
ConsumeNil

instance (KnownNat n, MatchBytesSing ctx ns) => MatchBytesSing ctx (n ': ns) where
  matchBytesSing :: MatchBytes ctx (n : ns)
matchBytesSing = Proxy n -> MatchBytes ctx ns -> MatchBytes ctx (n : ns)
forall (n :: Nat) (ctx :: Symbol) (ns :: [Nat]).
KnownNat n =>
Proxy n -> MatchBytes ctx ns -> MatchBytes ctx (n : ns)
ConsumeCons Proxy n
forall k (t :: k). Proxy t
Proxy MatchBytes ctx ns
forall (ctx :: Symbol) (ns :: [Nat]).
MatchBytesSing ctx ns =>
MatchBytes ctx ns
matchBytesSing

matchBytes :: MatchBytesSing ctx ns => MatchBytes ctx ns
matchBytes :: MatchBytes ctx ns
matchBytes = MatchBytes ctx ns
forall (ctx :: Symbol) (ns :: [Nat]).
MatchBytesSing ctx ns =>
MatchBytes ctx ns
matchBytesSing

instance MatchBytesSing ctx ns => Arbitrary (MatchBytes ctx ns) where
  arbitrary :: Gen (MatchBytes ctx ns)
arbitrary = MatchBytes ctx ns -> Gen (MatchBytes ctx ns)
forall (f :: * -> *) a. Applicative f => a -> f a
pure MatchBytes ctx ns
forall (ctx :: Symbol) (ns :: [Nat]).
MatchBytesSing ctx ns =>
MatchBytes ctx ns
matchBytes