{-# LANGUAGE RecordWildCards #-}
module StreamPatch.Patch.Binary
( Meta(..)
, MetaStream(..)
, Cfg(..)
, Error(..)
, patchBinRep
, BinRep(..)
, toBinRep'
, check
) where
import StreamPatch.Patch
import GHC.Generics ( Generic )
import GHC.Natural
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as Text
import qualified Data.Text as Text
import Data.Text ( Text )
import Data.Either.Combinators
import Data.Vinyl
import Data.Functor.Const
import Data.Vinyl.TypeLevel
type Bytes = BS.ByteString
data Meta = Meta
{ Meta -> Maybe (SeekRep 'FwdSeek)
mMaxBytes :: Maybe (SeekRep 'FwdSeek)
} deriving (Meta -> Meta -> Bool
(Meta -> Meta -> Bool) -> (Meta -> Meta -> Bool) -> Eq Meta
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meta -> Meta -> Bool
$c/= :: Meta -> Meta -> Bool
== :: Meta -> Meta -> Bool
$c== :: Meta -> Meta -> Bool
Eq, Int -> Meta -> ShowS
[Meta] -> ShowS
Meta -> String
(Int -> Meta -> ShowS)
-> (Meta -> String) -> ([Meta] -> ShowS) -> Show Meta
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meta] -> ShowS
$cshowList :: [Meta] -> ShowS
show :: Meta -> String
$cshow :: Meta -> String
showsPrec :: Int -> Meta -> ShowS
$cshowsPrec :: Int -> Meta -> ShowS
Show, (forall x. Meta -> Rep Meta x)
-> (forall x. Rep Meta x -> Meta) -> Generic Meta
forall x. Rep Meta x -> Meta
forall x. Meta -> Rep Meta x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Meta x -> Meta
$cfrom :: forall x. Meta -> Rep Meta x
Generic)
data MetaStream a = MetaStream
{ forall a. MetaStream a -> Maybe (SeekRep 'FwdSeek)
msNullTerminates :: Maybe (SeekRep 'FwdSeek)
, forall a. MetaStream a -> Maybe a
msExpected :: Maybe a
} deriving (MetaStream a -> MetaStream a -> Bool
(MetaStream a -> MetaStream a -> Bool)
-> (MetaStream a -> MetaStream a -> Bool) -> Eq (MetaStream a)
forall a. Eq a => MetaStream a -> MetaStream a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetaStream a -> MetaStream a -> Bool
$c/= :: forall a. Eq a => MetaStream a -> MetaStream a -> Bool
== :: MetaStream a -> MetaStream a -> Bool
$c== :: forall a. Eq a => MetaStream a -> MetaStream a -> Bool
Eq, Int -> MetaStream a -> ShowS
[MetaStream a] -> ShowS
MetaStream a -> String
(Int -> MetaStream a -> ShowS)
-> (MetaStream a -> String)
-> ([MetaStream a] -> ShowS)
-> Show (MetaStream a)
forall a. Show a => Int -> MetaStream a -> ShowS
forall a. Show a => [MetaStream a] -> ShowS
forall a. Show a => MetaStream a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MetaStream a] -> ShowS
$cshowList :: forall a. Show a => [MetaStream a] -> ShowS
show :: MetaStream a -> String
$cshow :: forall a. Show a => MetaStream a -> String
showsPrec :: Int -> MetaStream a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> MetaStream a -> ShowS
Show, (forall x. MetaStream a -> Rep (MetaStream a) x)
-> (forall x. Rep (MetaStream a) x -> MetaStream a)
-> Generic (MetaStream a)
forall x. Rep (MetaStream a) x -> MetaStream a
forall x. MetaStream a -> Rep (MetaStream a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (MetaStream a) x -> MetaStream a
forall a x. MetaStream a -> Rep (MetaStream a) x
$cto :: forall a x. Rep (MetaStream a) x -> MetaStream a
$cfrom :: forall a x. MetaStream a -> Rep (MetaStream a) x
Generic, (forall a b. (a -> b) -> MetaStream a -> MetaStream b)
-> (forall a b. a -> MetaStream b -> MetaStream a)
-> Functor MetaStream
forall a b. a -> MetaStream b -> MetaStream a
forall a b. (a -> b) -> MetaStream a -> MetaStream b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> MetaStream b -> MetaStream a
$c<$ :: forall a b. a -> MetaStream b -> MetaStream a
fmap :: forall a b. (a -> b) -> MetaStream a -> MetaStream b
$cfmap :: forall a b. (a -> b) -> MetaStream a -> MetaStream b
Functor, (forall m. Monoid m => MetaStream m -> m)
-> (forall m a. Monoid m => (a -> m) -> MetaStream a -> m)
-> (forall m a. Monoid m => (a -> m) -> MetaStream a -> m)
-> (forall a b. (a -> b -> b) -> b -> MetaStream a -> b)
-> (forall a b. (a -> b -> b) -> b -> MetaStream a -> b)
-> (forall b a. (b -> a -> b) -> b -> MetaStream a -> b)
-> (forall b a. (b -> a -> b) -> b -> MetaStream a -> b)
-> (forall a. (a -> a -> a) -> MetaStream a -> a)
-> (forall a. (a -> a -> a) -> MetaStream a -> a)
-> (forall a. MetaStream a -> [a])
-> (forall a. MetaStream a -> Bool)
-> (forall a. MetaStream a -> Int)
-> (forall a. Eq a => a -> MetaStream a -> Bool)
-> (forall a. Ord a => MetaStream a -> a)
-> (forall a. Ord a => MetaStream a -> a)
-> (forall a. Num a => MetaStream a -> a)
-> (forall a. Num a => MetaStream a -> a)
-> Foldable MetaStream
forall a. Eq a => a -> MetaStream a -> Bool
forall a. Num a => MetaStream a -> a
forall a. Ord a => MetaStream a -> a
forall m. Monoid m => MetaStream m -> m
forall a. MetaStream a -> Bool
forall a. MetaStream a -> Int
forall a. MetaStream a -> [a]
forall a. (a -> a -> a) -> MetaStream a -> a
forall m a. Monoid m => (a -> m) -> MetaStream a -> m
forall b a. (b -> a -> b) -> b -> MetaStream a -> b
forall a b. (a -> b -> b) -> b -> MetaStream a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => MetaStream a -> a
$cproduct :: forall a. Num a => MetaStream a -> a
sum :: forall a. Num a => MetaStream a -> a
$csum :: forall a. Num a => MetaStream a -> a
minimum :: forall a. Ord a => MetaStream a -> a
$cminimum :: forall a. Ord a => MetaStream a -> a
maximum :: forall a. Ord a => MetaStream a -> a
$cmaximum :: forall a. Ord a => MetaStream a -> a
elem :: forall a. Eq a => a -> MetaStream a -> Bool
$celem :: forall a. Eq a => a -> MetaStream a -> Bool
length :: forall a. MetaStream a -> Int
$clength :: forall a. MetaStream a -> Int
null :: forall a. MetaStream a -> Bool
$cnull :: forall a. MetaStream a -> Bool
toList :: forall a. MetaStream a -> [a]
$ctoList :: forall a. MetaStream a -> [a]
foldl1 :: forall a. (a -> a -> a) -> MetaStream a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> MetaStream a -> a
foldr1 :: forall a. (a -> a -> a) -> MetaStream a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> MetaStream a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> MetaStream a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> MetaStream a -> b
foldl :: forall b a. (b -> a -> b) -> b -> MetaStream a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> MetaStream a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> MetaStream a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> MetaStream a -> b
foldr :: forall a b. (a -> b -> b) -> b -> MetaStream a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> MetaStream a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> MetaStream a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> MetaStream a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> MetaStream a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> MetaStream a -> m
fold :: forall m. Monoid m => MetaStream m -> m
$cfold :: forall m. Monoid m => MetaStream m -> m
Foldable, Functor MetaStream
Foldable MetaStream
Functor MetaStream
-> Foldable MetaStream
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaStream a -> f (MetaStream b))
-> (forall (f :: * -> *) a.
Applicative f =>
MetaStream (f a) -> f (MetaStream a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MetaStream a -> m (MetaStream b))
-> (forall (m :: * -> *) a.
Monad m =>
MetaStream (m a) -> m (MetaStream a))
-> Traversable MetaStream
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
MetaStream (m a) -> m (MetaStream a)
forall (f :: * -> *) a.
Applicative f =>
MetaStream (f a) -> f (MetaStream a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MetaStream a -> m (MetaStream b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaStream a -> f (MetaStream b)
sequence :: forall (m :: * -> *) a.
Monad m =>
MetaStream (m a) -> m (MetaStream a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
MetaStream (m a) -> m (MetaStream a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MetaStream a -> m (MetaStream b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> MetaStream a -> m (MetaStream b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
MetaStream (f a) -> f (MetaStream a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
MetaStream (f a) -> f (MetaStream a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaStream a -> f (MetaStream b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> MetaStream a -> f (MetaStream b)
Traversable)
data Cfg = Cfg
{ Cfg -> Bool
cfgAllowPartialExpected :: Bool
} deriving (Cfg -> Cfg -> Bool
(Cfg -> Cfg -> Bool) -> (Cfg -> Cfg -> Bool) -> Eq Cfg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cfg -> Cfg -> Bool
$c/= :: Cfg -> Cfg -> Bool
== :: Cfg -> Cfg -> Bool
$c== :: Cfg -> Cfg -> Bool
Eq, Int -> Cfg -> ShowS
[Cfg] -> ShowS
Cfg -> String
(Int -> Cfg -> ShowS)
-> (Cfg -> String) -> ([Cfg] -> ShowS) -> Show Cfg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cfg] -> ShowS
$cshowList :: [Cfg] -> ShowS
show :: Cfg -> String
$cshow :: Cfg -> String
showsPrec :: Int -> Cfg -> ShowS
$cshowsPrec :: Int -> Cfg -> ShowS
Show, (forall x. Cfg -> Rep Cfg x)
-> (forall x. Rep Cfg x -> Cfg) -> Generic Cfg
forall x. Rep Cfg x -> Cfg
forall x. Cfg -> Rep Cfg x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cfg x -> Cfg
$cfrom :: forall x. Cfg -> Rep Cfg x
Generic)
data Error a
= ErrorBadBinRep a String
| ErrorUnexpectedNonNull Bytes
| ErrorDidNotMatchExpected Bytes Bytes
| ErrorBinRepTooLong Bytes Natural
deriving (Error a -> Error a -> Bool
(Error a -> Error a -> Bool)
-> (Error a -> Error a -> Bool) -> Eq (Error a)
forall a. Eq a => Error a -> Error a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error a -> Error a -> Bool
$c/= :: forall a. Eq a => Error a -> Error a -> Bool
== :: Error a -> Error a -> Bool
$c== :: forall a. Eq a => Error a -> Error a -> Bool
Eq, Int -> Error a -> ShowS
[Error a] -> ShowS
Error a -> String
(Int -> Error a -> ShowS)
-> (Error a -> String) -> ([Error a] -> ShowS) -> Show (Error a)
forall a. Show a => Int -> Error a -> ShowS
forall a. Show a => [Error a] -> ShowS
forall a. Show a => Error a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error a] -> ShowS
$cshowList :: forall a. Show a => [Error a] -> ShowS
show :: Error a -> String
$cshow :: forall a. Show a => Error a -> String
showsPrec :: Int -> Error a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Error a -> ShowS
Show, (forall x. Error a -> Rep (Error a) x)
-> (forall x. Rep (Error a) x -> Error a) -> Generic (Error a)
forall x. Rep (Error a) x -> Error a
forall x. Error a -> Rep (Error a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Error a) x -> Error a
forall a x. Error a -> Rep (Error a) x
$cto :: forall a x. Rep (Error a) x -> Error a
$cfrom :: forall a x. Error a -> Rep (Error a) x
Generic, (forall a b. (a -> b) -> Error a -> Error b)
-> (forall a b. a -> Error b -> Error a) -> Functor Error
forall a b. a -> Error b -> Error a
forall a b. (a -> b) -> Error a -> Error b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Error b -> Error a
$c<$ :: forall a b. a -> Error b -> Error a
fmap :: forall a b. (a -> b) -> Error a -> Error b
$cfmap :: forall a b. (a -> b) -> Error a -> Error b
Functor, (forall m. Monoid m => Error m -> m)
-> (forall m a. Monoid m => (a -> m) -> Error a -> m)
-> (forall m a. Monoid m => (a -> m) -> Error a -> m)
-> (forall a b. (a -> b -> b) -> b -> Error a -> b)
-> (forall a b. (a -> b -> b) -> b -> Error a -> b)
-> (forall b a. (b -> a -> b) -> b -> Error a -> b)
-> (forall b a. (b -> a -> b) -> b -> Error a -> b)
-> (forall a. (a -> a -> a) -> Error a -> a)
-> (forall a. (a -> a -> a) -> Error a -> a)
-> (forall a. Error a -> [a])
-> (forall a. Error a -> Bool)
-> (forall a. Error a -> Int)
-> (forall a. Eq a => a -> Error a -> Bool)
-> (forall a. Ord a => Error a -> a)
-> (forall a. Ord a => Error a -> a)
-> (forall a. Num a => Error a -> a)
-> (forall a. Num a => Error a -> a)
-> Foldable Error
forall a. Eq a => a -> Error a -> Bool
forall a. Num a => Error a -> a
forall a. Ord a => Error a -> a
forall m. Monoid m => Error m -> m
forall a. Error a -> Bool
forall a. Error a -> Int
forall a. Error a -> [a]
forall a. (a -> a -> a) -> Error a -> a
forall m a. Monoid m => (a -> m) -> Error a -> m
forall b a. (b -> a -> b) -> b -> Error a -> b
forall a b. (a -> b -> b) -> b -> Error a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Error a -> a
$cproduct :: forall a. Num a => Error a -> a
sum :: forall a. Num a => Error a -> a
$csum :: forall a. Num a => Error a -> a
minimum :: forall a. Ord a => Error a -> a
$cminimum :: forall a. Ord a => Error a -> a
maximum :: forall a. Ord a => Error a -> a
$cmaximum :: forall a. Ord a => Error a -> a
elem :: forall a. Eq a => a -> Error a -> Bool
$celem :: forall a. Eq a => a -> Error a -> Bool
length :: forall a. Error a -> Int
$clength :: forall a. Error a -> Int
null :: forall a. Error a -> Bool
$cnull :: forall a. Error a -> Bool
toList :: forall a. Error a -> [a]
$ctoList :: forall a. Error a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Error a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Error a -> a
foldr1 :: forall a. (a -> a -> a) -> Error a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Error a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Error a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Error a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Error a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Error a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Error a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Error a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Error a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Error a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Error a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Error a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Error a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Error a -> m
fold :: forall m. Monoid m => Error m -> m
$cfold :: forall m. Monoid m => Error m -> m
Foldable, Functor Error
Foldable Error
Functor Error
-> Foldable Error
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Error a -> f (Error b))
-> (forall (f :: * -> *) a.
Applicative f =>
Error (f a) -> f (Error a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Error a -> m (Error b))
-> (forall (m :: * -> *) a. Monad m => Error (m a) -> m (Error a))
-> Traversable Error
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Error (m a) -> m (Error a)
forall (f :: * -> *) a. Applicative f => Error (f a) -> f (Error a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Error a -> m (Error b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Error a -> f (Error b)
sequence :: forall (m :: * -> *) a. Monad m => Error (m a) -> m (Error a)
$csequence :: forall (m :: * -> *) a. Monad m => Error (m a) -> m (Error a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Error a -> m (Error b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Error a -> m (Error b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Error (f a) -> f (Error a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Error (f a) -> f (Error a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Error a -> f (Error b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Error a -> f (Error b)
Traversable)
patchBinRep
:: forall a s ss rs is i r
. ( BinRep a
, Traversable (FunctorRec rs)
, r ~ Const Meta
, rs ~ RDelete r ss
, RElem r ss i
, RSubset rs ss is )
=> Patch s ss a
-> Either (Error a) (Patch s rs Bytes)
patchBinRep :: forall a (s :: SeekKind) (ss :: [* -> *]) (rs :: [* -> *])
(is :: [Nat]) (i :: Nat) (r :: * -> *).
(BinRep a, Traversable (FunctorRec rs), r ~ Const Meta,
rs ~ RDelete r ss, RElem r ss i, RSubset rs ss is) =>
Patch s ss a -> Either (Error a) (Patch s rs Bytes)
patchBinRep (Patch a
a SeekRep s
s FunctorRec ss a
ms) = do
Bytes
a' <- a -> Either (Error a) Bytes
forall {a}. BinRep a => a -> Either (Error a) Bytes
toBinRep' a
a
() <- case Meta -> Maybe (SeekRep 'FwdSeek)
mMaxBytes Meta
m of
Maybe (SeekRep 'FwdSeek)
Nothing -> () -> Either (Error a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just SeekRep 'FwdSeek
maxBytes -> if Bytes -> Int
BS.length Bytes
a' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
SeekRep 'FwdSeek
maxBytes
then Error a -> Either (Error a) ()
forall a b. a -> Either a b
Left (Error a -> Either (Error a) ()) -> Error a -> Either (Error a) ()
forall a b. (a -> b) -> a -> b
$ Bytes -> Natural -> Error a
forall a. Bytes -> Natural -> Error a
ErrorBinRepTooLong Bytes
a' Natural
SeekRep 'FwdSeek
maxBytes
else () -> Either (Error a) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
let msDroppedMeta :: FunctorRec rs a
msDroppedMeta = Rec (Flap a) rs -> FunctorRec rs a
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec (Rec (Flap a) rs -> FunctorRec rs a)
-> Rec (Flap a) rs -> FunctorRec rs a
forall a b. (a -> b) -> a -> b
$ forall (rs :: [* -> *]) (ss :: [* -> *]) (f :: (* -> *) -> *)
(record :: ((* -> *) -> *) -> [* -> *] -> *) (is :: [Nat]).
(RecSubset record rs ss is, RecSubsetFCtx record f) =>
record f ss -> record f rs
forall {k1} {k2} (rs :: [k1]) (ss :: [k1]) (f :: k2 -> *)
(record :: (k2 -> *) -> [k1] -> *) (is :: [Nat]).
(RecSubset record rs ss is, RecSubsetFCtx record f) =>
record f ss -> record f rs
rcast @rs (Rec (Flap a) ss -> Rec (Flap a) rs)
-> Rec (Flap a) ss -> Rec (Flap a) rs
forall a b. (a -> b) -> a -> b
$ FunctorRec ss a -> Rec (Flap a) ss
forall (fs :: [* -> *]) a. FunctorRec fs a -> Rec (Flap a) fs
getFunctorRec FunctorRec ss a
ms
FunctorRec rs Bytes
ms' <- (a -> Either (Error a) Bytes)
-> FunctorRec rs a -> Either (Error a) (FunctorRec rs Bytes)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Either (Error a) Bytes
forall {a}. BinRep a => a -> Either (Error a) Bytes
toBinRep' FunctorRec rs a
msDroppedMeta
Patch s rs Bytes -> Either (Error a) (Patch s rs Bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (Patch s rs Bytes -> Either (Error a) (Patch s rs Bytes))
-> Patch s rs Bytes -> Either (Error a) (Patch s rs Bytes)
forall a b. (a -> b) -> a -> b
$ Bytes -> SeekRep s -> FunctorRec rs Bytes -> Patch s rs Bytes
forall (s :: SeekKind) (fs :: [* -> *]) a.
a -> SeekRep s -> FunctorRec fs a -> Patch s fs a
Patch Bytes
a' SeekRep s
s FunctorRec rs Bytes
ms'
where
toBinRep' :: a -> Either (Error a) Bytes
toBinRep' a
x = (String -> Error a)
-> Either String Bytes -> Either (Error a) Bytes
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (\String
e -> a -> String -> Error a
forall a. a -> String -> Error a
ErrorBadBinRep a
x String
e) (Either String Bytes -> Either (Error a) Bytes)
-> Either String Bytes -> Either (Error a) Bytes
forall a b. (a -> b) -> a -> b
$ a -> Either String Bytes
forall a. BinRep a => a -> Either String Bytes
toBinRep a
x
m :: Meta
m = forall a b. Const a b -> a
forall {k} a (b :: k). Const a b -> a
getConst @Meta (Const Meta a -> Meta) -> Const Meta a -> Meta
forall a b. (a -> b) -> a -> b
$ Flap a (Const Meta) -> Const Meta a
forall a (f :: * -> *). Flap a f -> f a
getFlap (Flap a (Const Meta) -> Const Meta a)
-> Flap a (Const Meta) -> Const Meta a
forall a b. (a -> b) -> a -> b
$ Rec (Flap a) ss -> Flap a (Const Meta)
forall {k} (r :: k) (rs :: [k]) (f :: k -> *)
(record :: (k -> *) -> [k] -> *).
(RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f) =>
record f rs -> f r
rget (Rec (Flap a) ss -> Flap a (Const Meta))
-> Rec (Flap a) ss -> Flap a (Const Meta)
forall a b. (a -> b) -> a -> b
$ FunctorRec ss a -> Rec (Flap a) ss
forall (fs :: [* -> *]) a. FunctorRec fs a -> Rec (Flap a) fs
getFunctorRec FunctorRec ss a
ms
class BinRep a where
toBinRep :: a -> Either String Bytes
toBinRep' :: BinRep a => a -> Either (Error a) Bytes
toBinRep' :: forall {a}. BinRep a => a -> Either (Error a) Bytes
toBinRep' a
a = (String -> Error a)
-> Either String Bytes -> Either (Error a) Bytes
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (a -> String -> Error a
forall a. a -> String -> Error a
ErrorBadBinRep a
a) (Either String Bytes -> Either (Error a) Bytes)
-> Either String Bytes -> Either (Error a) Bytes
forall a b. (a -> b) -> a -> b
$ a -> Either String Bytes
forall a. BinRep a => a -> Either String Bytes
toBinRep a
a
instance BinRep BS.ByteString where
toBinRep :: Bytes -> Either String Bytes
toBinRep = Bytes -> Either String Bytes
forall a b. b -> Either a b
Right (Bytes -> Either String Bytes)
-> (Bytes -> Bytes) -> Bytes -> Either String Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bytes -> Bytes
forall a. a -> a
id
instance BinRep Text where
toBinRep :: Text -> Either String Bytes
toBinRep = Bytes -> Either String Bytes
forall a b. b -> Either a b
Right (Bytes -> Either String Bytes)
-> (Text -> Bytes) -> Text -> Either String Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bytes -> Word8 -> Bytes) -> Word8 -> Bytes -> Bytes
forall a b c. (a -> b -> c) -> b -> a -> c
flip Bytes -> Word8 -> Bytes
BS.snoc Word8
0x00 (Bytes -> Bytes) -> (Text -> Bytes) -> Text -> Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bytes
Text.encodeUtf8
instance BinRep String where
toBinRep :: String -> Either String Bytes
toBinRep = Text -> Either String Bytes
forall a. BinRep a => a -> Either String Bytes
toBinRep (Text -> Either String Bytes)
-> (String -> Text) -> String -> Either String Bytes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack
check :: BinRep a => Cfg -> Bytes -> MetaStream a -> Either (Error a) ()
check :: forall a.
BinRep a =>
Cfg -> Bytes -> MetaStream a -> Either (Error a) ()
check Cfg
cfg Bytes
bs MetaStream a
meta = do
case MetaStream a -> Maybe a
forall a. MetaStream a -> Maybe a
msExpected MetaStream a
meta of
Maybe a
Nothing -> () -> Either (Error a) ()
forall a b. b -> Either a b
Right ()
Just a
aExpected -> do
Bytes
bsExpected <- a -> Maybe Natural -> Either (Error a) Bytes
forall {a}.
BinRep a =>
a -> Maybe Natural -> Either (Error a) Bytes
checkInner a
aExpected Maybe Natural
forall a. Maybe a
Nothing
case MetaStream a -> Maybe (SeekRep 'FwdSeek)
forall a. MetaStream a -> Maybe (SeekRep 'FwdSeek)
msNullTerminates MetaStream a
meta of
Maybe (SeekRep 'FwdSeek)
Nothing -> Bytes -> Bytes -> Either (Error a) ()
check' Bytes
bs Bytes
bsExpected
Just SeekRep 'FwdSeek
nullsFrom ->
let (Bytes
bs', Bytes
bsNulls) = Int -> Bytes -> (Bytes, Bytes)
BS.splitAt (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
SeekRep 'FwdSeek
nullsFrom) Bytes
bs
in if Bytes
bsNulls Bytes -> Bytes -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word8 -> Bytes
BS.replicate (Bytes -> Int
BS.length Bytes
bsNulls) Word8
0x00
then Bytes -> Bytes -> Either (Error a) ()
check' Bytes
bs' Bytes
bsExpected
else Error a -> Either (Error a) ()
forall a b. a -> Either a b
Left (Error a -> Either (Error a) ()) -> Error a -> Either (Error a) ()
forall a b. (a -> b) -> a -> b
$ Bytes -> Error a
forall a. Bytes -> Error a
ErrorUnexpectedNonNull Bytes
bs
where
check' :: Bytes -> Bytes -> Either (Error a) ()
check' Bytes
bs' Bytes
bsExpected =
case Bytes -> Bytes -> Bool
checkExpected Bytes
bs' Bytes
bsExpected of
Bool
True -> () -> Either (Error a) ()
forall a b. b -> Either a b
Right ()
Bool
False -> Error a -> Either (Error a) ()
forall a b. a -> Either a b
Left (Error a -> Either (Error a) ()) -> Error a -> Either (Error a) ()
forall a b. (a -> b) -> a -> b
$ Bytes -> Bytes -> Error a
forall a. Bytes -> Bytes -> Error a
ErrorDidNotMatchExpected Bytes
bs' Bytes
bsExpected
checkInner :: a -> Maybe Natural -> Either (Error a) Bytes
checkInner a
a Maybe Natural
mn = do
Bytes
bs <- a -> Either (Error a) Bytes
forall {a}. BinRep a => a -> Either (Error a) Bytes
toBinRep' a
a
case Maybe Natural
mn of
Maybe Natural
Nothing -> Bytes -> Either (Error a) Bytes
forall a b. b -> Either a b
Right Bytes
bs
Just Natural
n ->
if Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Bytes -> Int
BS.length Bytes
bs) Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
n
then Error a -> Either (Error a) Bytes
forall a b. a -> Either a b
Left (Error a -> Either (Error a) Bytes)
-> Error a -> Either (Error a) Bytes
forall a b. (a -> b) -> a -> b
$ Bytes -> Natural -> Error a
forall a. Bytes -> Natural -> Error a
ErrorBinRepTooLong Bytes
bs Natural
n
else Bytes -> Either (Error a) Bytes
forall a b. b -> Either a b
Right Bytes
bs
checkExpected :: Bytes -> Bytes -> Bool
checkExpected Bytes
bs' Bytes
bsExpected =
case Cfg -> Bool
cfgAllowPartialExpected Cfg
cfg of
Bool
True -> Bytes -> Bytes -> Bool
BS.isPrefixOf Bytes
bs' Bytes
bsExpected
Bool
False -> Bytes
bs' Bytes -> Bytes -> Bool
forall a. Eq a => a -> a -> Bool
== Bytes
bsExpected