{-# LANGUAGE RecordWildCards #-}

-- TODO rewrite patch/check bits (some overlap)

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

data Meta = Meta
  { Meta -> Maybe (SeekRep 'FwdSeek)
mMaxBytes :: Maybe (SeekRep 'FwdSeek)
  -- ^ Maximum number of bytes permitted to write at the associated position.
  } 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)
  -- ^ Stream segment should be null bytes (0x00) only from this index onwards.

  , forall a. MetaStream a -> Maybe a
msExpected       :: Maybe a
  -- ^ Stream segment should be this.
  } 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
  -- ^ If enabled, allow partial expected bytes checking. If disabled, then even
  --   if the expected bytes are a prefix of the actual, fail.
  } 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 BS.ByteString
  | ErrorDidNotMatchExpected BS.ByteString BS.ByteString
  | ErrorBinRepTooLong BS.ByteString 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 BS.ByteString)
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 ByteString)
patchBinRep (Patch a
a SeekRep s
s FunctorRec ss a
ms) = do
    ByteString
a' <- a -> Either (Error a) ByteString
forall a. BinRep a => a -> Either (Error a) ByteString
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   ByteString -> Int
BS.length ByteString
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
$ ByteString -> Natural -> Error a
forall a. ByteString -> Natural -> Error a
ErrorBinRepTooLong ByteString
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 ByteString
ms' <- (a -> Either (Error a) ByteString)
-> FunctorRec rs a -> Either (Error a) (FunctorRec rs ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Either (Error a) ByteString
forall a. BinRep a => a -> Either (Error a) ByteString
toBinRep' FunctorRec rs a
msDroppedMeta
    Patch s rs ByteString -> Either (Error a) (Patch s rs ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Patch s rs ByteString -> Either (Error a) (Patch s rs ByteString))
-> Patch s rs ByteString
-> Either (Error a) (Patch s rs ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString
-> SeekRep s -> FunctorRec rs ByteString -> Patch s rs ByteString
forall (s :: SeekKind) (fs :: [* -> *]) a.
a -> SeekRep s -> FunctorRec fs a -> Patch s fs a
Patch ByteString
a' SeekRep s
s FunctorRec rs ByteString
ms'
  where 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

-- | Type has a binary representation for using in patchscripts.
--
-- Patchscripts are parsed parameterized over the type to edit. That type needs
-- to become a bytestring for eventual patch application. We're forced into
-- newtypes and typeclasses by Aeson already, so this just enables us to define
-- some important patch generation behaviour in one place. Similarly to Aeson,
-- if you require custom behaviour for existing types (e.g. length-prefixed
-- strings instead of C-style null terminated), define a newtype over it.
--
-- Some values may not have valid patch representations, for example if you're
-- patching a 1-byte length-prefixed string and your string is too long (>255
-- encoded bytes). Thus, 'toPatchRep' is failable.
class BinRep a where
    toBinRep :: a -> Either String BS.ByteString

toBinRep' :: BinRep a => a -> Either (Error a) BS.ByteString
toBinRep' :: forall a. BinRep a => a -> Either (Error a) ByteString
toBinRep' a
a = (String -> Error a)
-> Either String ByteString -> Either (Error a) ByteString
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 ByteString -> Either (Error a) ByteString)
-> Either String ByteString -> Either (Error a) ByteString
forall a b. (a -> b) -> a -> b
$ a -> Either String ByteString
forall a. BinRep a => a -> Either String ByteString
toBinRep a
a

-- | Bytestrings are copied as-is.
instance BinRep BS.ByteString where
    toBinRep :: ByteString -> Either String ByteString
toBinRep = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> (ByteString -> ByteString)
-> ByteString
-> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
forall a. a -> a
id

-- | Text is converted to UTF-8 bytes and null-terminated.
instance BinRep Text where
    toBinRep :: Text -> Either String ByteString
toBinRep = ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (ByteString -> Either String ByteString)
-> (Text -> ByteString) -> Text -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Word8 -> ByteString)
-> Word8 -> ByteString -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Word8 -> ByteString
BS.snoc Word8
0x00 (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

-- | String is the same but goes the long way round, through Text.
instance BinRep String where
    toBinRep :: String -> Either String ByteString
toBinRep = Text -> Either String ByteString
forall a. BinRep a => a -> Either String ByteString
toBinRep (Text -> Either String ByteString)
-> (String -> Text) -> String -> Either String ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

check :: BinRep a => Cfg -> BS.ByteString -> MetaStream a -> Either (Error a) ()
check :: forall a.
BinRep a =>
Cfg -> ByteString -> MetaStream a -> Either (Error a) ()
check Cfg
cfg ByteString
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
        ByteString
bsExpected <- a -> Maybe Natural -> Either (Error a) ByteString
forall {a}.
BinRep a =>
a -> Maybe Natural -> Either (Error a) ByteString
checkInner a
aExpected Maybe Natural
forall a. Maybe a
Nothing -- cheating a bit here
        case MetaStream a -> Maybe (SeekRep 'FwdSeek)
forall a. MetaStream a -> Maybe (SeekRep 'FwdSeek)
msNullTerminates MetaStream a
meta of
          Maybe (SeekRep 'FwdSeek)
Nothing -> ByteString -> ByteString -> Either (Error a) ()
check' ByteString
bs ByteString
bsExpected
          Just SeekRep 'FwdSeek
nullsFrom ->
            let (ByteString
bs', ByteString
bsNulls) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
SeekRep 'FwdSeek
nullsFrom) ByteString
bs
             in if   ByteString
bsNulls ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word8 -> ByteString
BS.replicate (ByteString -> Int
BS.length ByteString
bsNulls) Word8
0x00
                then ByteString -> ByteString -> Either (Error a) ()
check' ByteString
bs' ByteString
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
$ ByteString -> Error a
forall a. ByteString -> Error a
ErrorUnexpectedNonNull ByteString
bs
  where
    check' :: ByteString -> ByteString -> Either (Error a) ()
check' ByteString
bs' ByteString
bsExpected =
        case ByteString -> ByteString -> Bool
checkExpected ByteString
bs' ByteString
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
$ ByteString -> ByteString -> Error a
forall a. ByteString -> ByteString -> Error a
ErrorDidNotMatchExpected ByteString
bs' ByteString
bsExpected
    checkInner :: a -> Maybe Natural -> Either (Error a) ByteString
checkInner a
a Maybe Natural
mn = do
        ByteString
bs' <- a -> Either (Error a) ByteString
forall a. BinRep a => a -> Either (Error a) ByteString
toBinRep' a
a
        case Maybe Natural
mn of
          Maybe Natural
Nothing -> ByteString -> Either (Error a) ByteString
forall a b. b -> Either a b
Right ByteString
bs'
          Just Natural
n  ->
            if   Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs') Natural -> Natural -> Bool
forall a. Ord a => a -> a -> Bool
> Natural
n
            then Error a -> Either (Error a) ByteString
forall a b. a -> Either a b
Left (Error a -> Either (Error a) ByteString)
-> Error a -> Either (Error a) ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Natural -> Error a
forall a. ByteString -> Natural -> Error a
ErrorBinRepTooLong ByteString
bs' Natural
n
            else ByteString -> Either (Error a) ByteString
forall a b. b -> Either a b
Right ByteString
bs'
    checkExpected :: ByteString -> ByteString -> Bool
checkExpected ByteString
bs' ByteString
bsExpected =
        case Cfg -> Bool
cfgAllowPartialExpected Cfg
cfg of
          Bool
True  -> ByteString -> ByteString -> Bool
BS.isPrefixOf ByteString
bs' ByteString
bsExpected
          Bool
False -> ByteString
bs' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bsExpected