{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module StreamPatch.Simple where
import StreamPatch.Patch
import StreamPatch.HFunctorList
import StreamPatch.Patch.Binary qualified as Bin
import StreamPatch.Patch.Compare qualified as Compare
import StreamPatch.Patch.Compare ( Via(..), CompareRep )
import StreamPatch.Patch.Align qualified as Align
import Numeric.Natural
import Data.Functor.Const
import Data.Vinyl
import Data.Vinyl.TypeLevel
import Data.Aeson
import GHC.Generics
data MultiPatch s (v :: Via) a = MultiPatch
{ forall s (v :: Via) a. MultiPatch s v a -> a
mpData :: a
, forall s (v :: Via) a. MultiPatch s v a -> s
mpSeek :: s
, forall s (v :: Via) a. MultiPatch s v a -> Maybe (CompareRep v a)
mpCompare :: Maybe (CompareRep v a)
, forall s (v :: Via) a. MultiPatch s v a -> Maybe Natural
mpNullTerminates :: Maybe Natural
, forall s (v :: Via) a. MultiPatch s v a -> Maybe Natural
mpMaxBytes :: Maybe Natural
, forall s (v :: Via) a. MultiPatch s v a -> Maybe Integer
mpAligned :: Maybe Integer
} deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s (v :: Via) a x.
Rep (MultiPatch s v a) x -> MultiPatch s v a
forall s (v :: Via) a x.
MultiPatch s v a -> Rep (MultiPatch s v a) x
$cto :: forall s (v :: Via) a x.
Rep (MultiPatch s v a) x -> MultiPatch s v a
$cfrom :: forall s (v :: Via) a x.
MultiPatch s v a -> Rep (MultiPatch s v a) x
Generic)
instance Functor (MultiPatch s ('ViaEq ec)) where
fmap :: forall a b.
(a -> b)
-> MultiPatch s ('ViaEq ec) a -> MultiPatch s ('ViaEq ec) b
fmap a -> b
f (MultiPatch a
d s
s Maybe (CompareRep ('ViaEq ec) a)
c Maybe Natural
n Maybe Natural
m Maybe Integer
a) = forall s (v :: Via) a.
a
-> s
-> Maybe (CompareRep v a)
-> Maybe Natural
-> Maybe Natural
-> Maybe Integer
-> MultiPatch s v a
MultiPatch (a -> b
f a
d) s
s (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe (CompareRep ('ViaEq ec) a)
c) Maybe Natural
n Maybe Natural
m Maybe Integer
a
instance Functor (MultiPatch s ('ViaDigest h)) where
fmap :: forall a b.
(a -> b)
-> MultiPatch s ('ViaDigest h) a -> MultiPatch s ('ViaDigest h) b
fmap a -> b
f (MultiPatch a
d s
s Maybe (CompareRep ('ViaDigest h) a)
c Maybe Natural
n Maybe Natural
m Maybe Integer
a) = forall s (v :: Via) a.
a
-> s
-> Maybe (CompareRep v a)
-> Maybe Natural
-> Maybe Natural
-> Maybe Integer
-> MultiPatch s v a
MultiPatch (a -> b
f a
d) s
s Maybe (CompareRep ('ViaDigest h) a)
c Maybe Natural
n Maybe Natural
m Maybe Integer
a
deriving instance (Eq a, Eq s, Eq (CompareRep v a)) => Eq (MultiPatch s v a)
deriving instance (Show a, Show s, Show (CompareRep v a)) => Show (MultiPatch s v a)
data Aligned p = Aligned
{ forall p. Aligned p -> Integer
alignedAlign :: Integer
, forall p. Aligned p -> [p]
alignedPatches :: [p]
} deriving (Aligned p -> Aligned p -> Bool
forall p. Eq p => Aligned p -> Aligned p -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Aligned p -> Aligned p -> Bool
$c/= :: forall p. Eq p => Aligned p -> Aligned p -> Bool
== :: Aligned p -> Aligned p -> Bool
$c== :: forall p. Eq p => Aligned p -> Aligned p -> Bool
Eq, Int -> Aligned p -> ShowS
forall p. Show p => Int -> Aligned p -> ShowS
forall p. Show p => [Aligned p] -> ShowS
forall p. Show p => Aligned p -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Aligned p] -> ShowS
$cshowList :: forall p. Show p => [Aligned p] -> ShowS
show :: Aligned p -> String
$cshow :: forall p. Show p => Aligned p -> String
showsPrec :: Int -> Aligned p -> ShowS
$cshowsPrec :: forall p. Show p => Int -> Aligned p -> ShowS
Show, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p x. Rep (Aligned p) x -> Aligned p
forall p x. Aligned p -> Rep (Aligned p) x
$cto :: forall p x. Rep (Aligned p) x -> Aligned p
$cfrom :: forall p x. Aligned p -> Rep (Aligned p) x
Generic)
jsonCfgCamelDrop :: Int -> Options
jsonCfgCamelDrop :: Int -> Options
jsonCfgCamelDrop Int
x = Options
defaultOptions
{ fieldLabelModifier :: ShowS
fieldLabelModifier = Char -> ShowS
camelTo2 Char
'_' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
x
, rejectUnknownFields :: Bool
rejectUnknownFields = Bool
True }
instance (ToJSON (CompareRep v a), ToJSON a, ToJSON s) => ToJSON (MultiPatch s v a) where
toJSON :: MultiPatch s v a -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2
toEncoding :: MultiPatch s v a -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2
instance (FromJSON (CompareRep v a), FromJSON a, FromJSON s) => FromJSON (MultiPatch s v a) where
parseJSON :: Value -> Parser (MultiPatch s v a)
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
2
instance (ToJSON p) => ToJSON (Aligned p) where
toJSON :: Aligned p -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
7
toEncoding :: Aligned p -> Encoding
toEncoding = forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
7
instance (FromJSON p) => FromJSON (Aligned p) where
parseJSON :: Value -> Parser (Aligned p)
parseJSON = forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON forall a b. (a -> b) -> a -> b
$ Int -> Options
jsonCfgCamelDrop Int
7
convert :: (MultiPatch s v a -> Rec (Flap a) fs) -> MultiPatch s v a -> Patch s fs a
convert :: forall s (v :: Via) a (fs :: [* -> *]).
(MultiPatch s v a -> Rec (Flap a) fs)
-> MultiPatch s v a -> Patch s fs a
convert MultiPatch s v a -> Rec (Flap a) fs
f MultiPatch s v a
p = Patch { patchData :: a
patchData = forall s (v :: Via) a. MultiPatch s v a -> a
mpData MultiPatch s v a
p
, patchSeek :: s
patchSeek = forall s (v :: Via) a. MultiPatch s v a -> s
mpSeek MultiPatch s v a
p
, patchMeta :: HFunctorList fs a
patchMeta = forall {k} (fs :: [k -> *]) (a :: k).
Rec (Flap a) fs -> HFunctorList fs a
HFunctorList forall a b. (a -> b) -> a -> b
$ MultiPatch s v a -> Rec (Flap a) fs
f MultiPatch s v a
p }
convertBinAlign
:: forall a v
. MultiPatch Integer v a
-> Patch Integer '[Const (Align.Meta Int), Const Bin.MetaPrep, Compare.Meta v, Bin.Meta] a
convertBinAlign :: forall a (v :: Via).
MultiPatch Integer v a
-> Patch
Integer '[Const (Meta Int), Const MetaPrep, Meta v, Meta] a
convertBinAlign = forall s (v :: Via) a (fs :: [* -> *]).
(MultiPatch s v a -> Rec (Flap a) fs)
-> MultiPatch s v a -> Patch s fs a
convert forall {c :: Via} {a}.
MultiPatch Integer c a
-> Rec (Flap a) '[Const (Meta Int), Const MetaPrep, Meta c, Meta]
go
where go :: MultiPatch Integer c a
-> Rec
(Flap a) ('[Const (Meta Int)] ++ '[Const MetaPrep, Meta c, Meta])
go MultiPatch Integer c a
p = forall (c :: Via) a.
MultiPatch Integer c a -> Rec (Flap a) '[Const (Meta Int)]
cmAlign MultiPatch Integer c a
p forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> forall s (c :: Via) a.
MultiPatch s c a -> Rec (Flap a) '[Const MetaPrep]
cmBinPrep MultiPatch Integer c a
p forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> forall s (v :: Via) a. MultiPatch s v a -> Rec (Flap a) '[Meta v]
cmCompare MultiPatch Integer c a
p forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> forall s (c :: Via) a. MultiPatch s c a -> Rec (Flap a) '[Meta]
cmBin MultiPatch Integer c a
p
convertBin
:: forall s a v
. MultiPatch s v a
-> Patch s '[Const Bin.MetaPrep, Compare.Meta v, Bin.Meta] a
convertBin :: forall s a (v :: Via).
MultiPatch s v a -> Patch s '[Const MetaPrep, Meta v, Meta] a
convertBin MultiPatch s v a
p = forall s (v :: Via) a (fs :: [* -> *]).
(MultiPatch s v a -> Rec (Flap a) fs)
-> MultiPatch s v a -> Patch s fs a
convert forall {s} {c :: Via} {a}.
MultiPatch s c a -> Rec (Flap a) '[Const MetaPrep, Meta c, Meta]
go MultiPatch s v a
p
where go :: MultiPatch s c a
-> Rec (Flap a) ('[Const MetaPrep] ++ '[Meta c, Meta])
go MultiPatch s c a
s = forall s (c :: Via) a.
MultiPatch s c a -> Rec (Flap a) '[Const MetaPrep]
cmBinPrep MultiPatch s c a
s forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> forall s (v :: Via) a. MultiPatch s v a -> Rec (Flap a) '[Meta v]
cmCompare MultiPatch s c a
s forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> forall s (c :: Via) a. MultiPatch s c a -> Rec (Flap a) '[Meta]
cmBin MultiPatch s c a
s
convertAlign
:: forall a v
. MultiPatch Integer v a
-> Patch Integer '[Const (Align.Meta Int)] a
convertAlign :: forall a (v :: Via).
MultiPatch Integer v a -> Patch Integer '[Const (Meta Int)] a
convertAlign MultiPatch Integer v a
p = forall s (v :: Via) a (fs :: [* -> *]).
(MultiPatch s v a -> Rec (Flap a) fs)
-> MultiPatch s v a -> Patch s fs a
convert forall (c :: Via) a.
MultiPatch Integer c a -> Rec (Flap a) '[Const (Meta Int)]
cmAlign MultiPatch Integer v a
p
convertEmpty
:: forall s a v
. MultiPatch s v a
-> Patch s '[] a
convertEmpty :: forall s a (v :: Via). MultiPatch s v a -> Patch s '[] a
convertEmpty MultiPatch s v a
p = forall s (v :: Via) a (fs :: [* -> *]).
(MultiPatch s v a -> Rec (Flap a) fs)
-> MultiPatch s v a -> Patch s fs a
convert (forall a b. a -> b -> a
const forall {u} (a :: u -> *). Rec a '[]
RNil) MultiPatch s v a
p
align
:: forall st a ss rs is i r
. ( r ~ Const (Align.Meta st)
, Num st, Eq st
, rs ~ RDelete r ss
, RElem r ss i
, RSubset rs ss is )
=> Aligned (Patch Integer ss a)
-> Either (Align.Error st) [Patch st rs a]
align :: forall st a (ss :: [* -> *]) (rs :: [* -> *]) (is :: [Nat])
(i :: Nat) (r :: * -> *).
(r ~ Const (Meta st), Num st, Eq st, rs ~ RDelete r ss,
RElem r ss i, RSubset rs ss is) =>
Aligned (Patch Integer ss a) -> Either (Error st) [Patch st rs a]
align (Aligned Integer
a [Patch Integer ss a]
ps) = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall sf st a (ss :: [* -> *]) (is :: [Nat]) (r :: * -> *)
(rs :: [* -> *]).
(Integral sf, Num st, Eq st, r ~ Const (Meta st),
rs ~ RDelete r ss, RElem r ss (RIndex r ss), RSubset rs ss is) =>
Integer -> Patch sf ss a -> Either (Error st) (Patch st rs a)
Align.align Integer
a) [Patch Integer ss a]
ps
cmBin :: MultiPatch s c a -> Rec (Flap a) '[Bin.Meta]
cmBin :: forall s (c :: Via) a. MultiPatch s c a -> Rec (Flap a) '[Meta]
cmBin MultiPatch s c a
p = forall {k} (f :: k -> *) (a :: k). f a -> Rec (Flap a) '[f]
cm forall a b. (a -> b) -> a -> b
$ Bin.Meta { mNullTerminates :: Maybe Natural
Bin.mNullTerminates = forall s (v :: Via) a. MultiPatch s v a -> Maybe Natural
mpNullTerminates MultiPatch s c a
p }
cmCompare :: MultiPatch s v a -> Rec (Flap a) '[Compare.Meta v]
cmCompare :: forall s (v :: Via) a. MultiPatch s v a -> Rec (Flap a) '[Meta v]
cmCompare MultiPatch s v a
p = forall {k} (f :: k -> *) (a :: k). f a -> Rec (Flap a) '[f]
cm forall a b. (a -> b) -> a -> b
$ Compare.Meta { mCompare :: Maybe (CompareRep v a)
Compare.mCompare = forall s (v :: Via) a. MultiPatch s v a -> Maybe (CompareRep v a)
mpCompare MultiPatch s v a
p }
cmBinPrep :: MultiPatch s c a -> Rec (Flap a) '[Const Bin.MetaPrep]
cmBinPrep :: forall s (c :: Via) a.
MultiPatch s c a -> Rec (Flap a) '[Const MetaPrep]
cmBinPrep MultiPatch s c a
p = forall {k} (f :: k -> *) (a :: k). f a -> Rec (Flap a) '[f]
cm forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ Bin.MetaPrep { mpMaxBytes :: Maybe Natural
Bin.mpMaxBytes = forall s (v :: Via) a. MultiPatch s v a -> Maybe Natural
mpMaxBytes MultiPatch s c a
p }
cmAlign :: MultiPatch Integer c a -> Rec (Flap a) '[Const (Align.Meta Int)]
cmAlign :: forall (c :: Via) a.
MultiPatch Integer c a -> Rec (Flap a) '[Const (Meta Int)]
cmAlign MultiPatch Integer c a
p = forall {k} (f :: k -> *) (a :: k). f a -> Rec (Flap a) '[f]
cm forall a b. (a -> b) -> a -> b
$ forall {k} a (b :: k). a -> Const a b
Const forall a b. (a -> b) -> a -> b
$ Align.Meta { mExpected :: Maybe Int
Align.mExpected = forall a. Num a => Integer -> a
fromInteger forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (v :: Via) a. MultiPatch s v a -> Maybe Integer
mpAligned MultiPatch Integer c a
p }
cm :: f a -> Rec (Flap a) '[f]
cm :: forall {k} (f :: k -> *) (a :: k). f a -> Rec (Flap a) '[f]
cm f a
fa = forall {k} (a :: k) (f :: k -> *). f a -> Flap a f
Flap f a
fa forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil
metaWrap1 :: f a -> HFunctorList '[f] a
metaWrap1 :: forall {k} (f :: k -> *) (a :: k). f a -> HFunctorList '[f] a
metaWrap1 = forall {k} (fs :: [k -> *]) (a :: k).
Rec (Flap a) fs -> HFunctorList fs a
HFunctorList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> Rec (Flap a) '[f]
cm
metaEmpty :: HFunctorList '[] a
metaEmpty :: forall {k} (a :: k). HFunctorList '[] a
metaEmpty = forall {k} (fs :: [k -> *]) (a :: k).
Rec (Flap a) fs -> HFunctorList fs a
HFunctorList forall {u} (a :: u -> *). Rec a '[]
RNil
convertBackBin :: forall v s a. Patch s '[Compare.Meta v, Bin.Meta] a -> MultiPatch s v a
convertBackBin :: forall (v :: Via) s a.
Patch s '[Meta v, Meta] a -> MultiPatch s v a
convertBackBin Patch s '[Meta v, Meta] a
p = MultiPatch { mpData :: a
mpData = forall s (fs :: [* -> *]) a. Patch s fs a -> a
patchData Patch s '[Meta v, Meta] a
p
, mpSeek :: s
mpSeek = forall s (fs :: [* -> *]) a. Patch s fs a -> s
patchSeek Patch s '[Meta v, Meta] a
p
, mpCompare :: Maybe (CompareRep v a)
mpCompare = forall (v :: Via) a. Meta v a -> Maybe (CompareRep v a)
Compare.mCompare @v forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (fs :: [k -> *]) (a :: k) (i :: Nat).
RElem f fs i =>
HFunctorList fs a -> f a
hflGet forall a b. (a -> b) -> a -> b
$ forall s (fs :: [* -> *]) a. Patch s fs a -> HFunctorList fs a
patchMeta Patch s '[Meta v, Meta] a
p
, mpNullTerminates :: Maybe Natural
mpNullTerminates = forall {k} (a :: k). Meta a -> Maybe Natural
Bin.mNullTerminates forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (fs :: [k -> *]) (a :: k) (i :: Nat).
RElem f fs i =>
HFunctorList fs a -> f a
hflGet forall a b. (a -> b) -> a -> b
$ forall s (fs :: [* -> *]) a. Patch s fs a -> HFunctorList fs a
patchMeta Patch s '[Meta v, Meta] a
p
, mpMaxBytes :: Maybe Natural
mpMaxBytes = forall a. Maybe a
Nothing
, mpAligned :: Maybe Integer
mpAligned = forall a. Maybe a
Nothing
}