-- | Core patch type definitions: patches, seeks, metadata.

module StreamPatch.Patch where

import           Data.Kind
import           GHC.Generics ( Generic )
import           GHC.Natural
import           Data.Vinyl
import           Control.Applicative ( liftA2 )

type Patch :: SeekKind -> [Type -> Type] -> Type -> Type
data Patch s fs a = Patch
  { forall (s :: SeekKind) (fs :: [* -> *]) a. Patch s fs a -> a
patchData :: a
  , forall (s :: SeekKind) (fs :: [* -> *]) a.
Patch s fs a -> SeekRep s
patchSeek :: SeekRep s
  , forall (s :: SeekKind) (fs :: [* -> *]) a.
Patch s fs a -> FunctorRec fs a
patchMeta :: FunctorRec fs a
  } deriving ((forall x. Patch s fs a -> Rep (Patch s fs a) x)
-> (forall x. Rep (Patch s fs a) x -> Patch s fs a)
-> Generic (Patch s fs a)
forall x. Rep (Patch s fs a) x -> Patch s fs a
forall x. Patch s fs a -> Rep (Patch s fs a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: SeekKind) (fs :: [* -> *]) a x.
Rep (Patch s fs a) x -> Patch s fs a
forall (s :: SeekKind) (fs :: [* -> *]) a x.
Patch s fs a -> Rep (Patch s fs a) x
$cto :: forall (s :: SeekKind) (fs :: [* -> *]) a x.
Rep (Patch s fs a) x -> Patch s fs a
$cfrom :: forall (s :: SeekKind) (fs :: [* -> *]) a x.
Patch s fs a -> Rep (Patch s fs a) x
Generic)

deriving instance (Eq   a, Eq   (SeekRep s), Eq (Rec (Flap a) fs))  => Eq (Patch s fs a)
deriving instance (Show a, Show (SeekRep s), ReifyConstraint Show (Flap a) fs, RMap fs, RecordToList fs) => Show (Patch s fs a)
deriving instance (Functor (FunctorRec fs)) => Functor (Patch s fs)

-- Taken from vinyl-plus. Functor and Applicative instances were provided.
newtype Flap a f = Flap { forall a (f :: * -> *). Flap a f -> f a
getFlap :: f a } deriving (Flap a f -> Flap a f -> Bool
(Flap a f -> Flap a f -> Bool)
-> (Flap a f -> Flap a f -> Bool) -> Eq (Flap a f)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a (f :: * -> *). Eq (f a) => Flap a f -> Flap a f -> Bool
/= :: Flap a f -> Flap a f -> Bool
$c/= :: forall a (f :: * -> *). Eq (f a) => Flap a f -> Flap a f -> Bool
== :: Flap a f -> Flap a f -> Bool
$c== :: forall a (f :: * -> *). Eq (f a) => Flap a f -> Flap a f -> Bool
Eq, Int -> Flap a f -> ShowS
[Flap a f] -> ShowS
Flap a f -> String
(Int -> Flap a f -> ShowS)
-> (Flap a f -> String) -> ([Flap a f] -> ShowS) -> Show (Flap a f)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a (f :: * -> *). Show (f a) => Int -> Flap a f -> ShowS
forall a (f :: * -> *). Show (f a) => [Flap a f] -> ShowS
forall a (f :: * -> *). Show (f a) => Flap a f -> String
showList :: [Flap a f] -> ShowS
$cshowList :: forall a (f :: * -> *). Show (f a) => [Flap a f] -> ShowS
show :: Flap a f -> String
$cshow :: forall a (f :: * -> *). Show (f a) => Flap a f -> String
showsPrec :: Int -> Flap a f -> ShowS
$cshowsPrec :: forall a (f :: * -> *). Show (f a) => Int -> Flap a f -> ShowS
Show, (forall x. Flap a f -> Rep (Flap a f) x)
-> (forall x. Rep (Flap a f) x -> Flap a f) -> Generic (Flap a f)
forall x. Rep (Flap a f) x -> Flap a f
forall x. Flap a f -> Rep (Flap a f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a (f :: * -> *) x. Rep (Flap a f) x -> Flap a f
forall a (f :: * -> *) x. Flap a f -> Rep (Flap a f) x
$cto :: forall a (f :: * -> *) x. Rep (Flap a f) x -> Flap a f
$cfrom :: forall a (f :: * -> *) x. Flap a f -> Rep (Flap a f) x
Generic)
newtype FunctorRec fs a = FunctorRec { forall (fs :: [* -> *]) a. FunctorRec fs a -> Rec (Flap a) fs
getFunctorRec :: Rec (Flap a) fs } deriving ((forall x. FunctorRec fs a -> Rep (FunctorRec fs a) x)
-> (forall x. Rep (FunctorRec fs a) x -> FunctorRec fs a)
-> Generic (FunctorRec fs a)
forall (fs :: [* -> *]) a x.
Rep (FunctorRec fs a) x -> FunctorRec fs a
forall (fs :: [* -> *]) a x.
FunctorRec fs a -> Rep (FunctorRec fs a) x
forall x. Rep (FunctorRec fs a) x -> FunctorRec fs a
forall x. FunctorRec fs a -> Rep (FunctorRec fs a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall (fs :: [* -> *]) a x.
Rep (FunctorRec fs a) x -> FunctorRec fs a
$cfrom :: forall (fs :: [* -> *]) a x.
FunctorRec fs a -> Rep (FunctorRec fs a) x
Generic)
deriving instance (ReifyConstraint Show (Flap a) fs, RMap fs, RecordToList fs) => Show (FunctorRec fs a)
deriving instance Eq (Rec (Flap a) fs) => Eq (FunctorRec fs a)

instance Functor (FunctorRec '[]) where
  fmap :: forall a b. (a -> b) -> FunctorRec '[] a -> FunctorRec '[] b
fmap a -> b
_ (FunctorRec Rec (Flap a) '[]
RNil) = Rec (Flap b) '[] -> FunctorRec '[] b
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec Rec (Flap b) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil
instance (Functor r, Functor (FunctorRec rs)) => Functor (FunctorRec (r ': rs)) where
  fmap :: forall a b.
(a -> b) -> FunctorRec (r : rs) a -> FunctorRec (r : rs) b
fmap a -> b
f (FunctorRec (Flap r a
r :& Rec (Flap a) rs
rs)) =
    Rec (Flap b) (r : rs) -> FunctorRec (r : rs) b
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec (r b -> Flap b r
forall a (f :: * -> *). f a -> Flap a f
Flap ((a -> b) -> r a -> r b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f r a
r) Flap b r -> Rec (Flap b) rs -> Rec (Flap b) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& FunctorRec rs b -> Rec (Flap b) rs
forall (fs :: [* -> *]) a. FunctorRec fs a -> Rec (Flap a) fs
getFunctorRec ((a -> b) -> FunctorRec rs a -> FunctorRec rs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Rec (Flap a) rs -> FunctorRec rs a
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec Rec (Flap a) rs
rs)))

instance Applicative (FunctorRec '[]) where
  pure :: forall a. a -> FunctorRec '[] a
pure a
_ = Rec (Flap a) '[] -> FunctorRec '[] a
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec Rec (Flap a) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil
  FunctorRec Rec (Flap (a -> b)) '[]
RNil <*> :: forall a b.
FunctorRec '[] (a -> b) -> FunctorRec '[] a -> FunctorRec '[] b
<*> FunctorRec Rec (Flap a) '[]
RNil = Rec (Flap b) '[] -> FunctorRec '[] b
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec Rec (Flap b) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil
instance (Applicative r, Applicative (FunctorRec rs)) => Applicative (FunctorRec (r ': rs)) where
  pure :: forall a. a -> FunctorRec (r : rs) a
pure a
a = Rec (Flap a) (r : rs) -> FunctorRec (r : rs) a
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec (r a -> Flap a r
forall a (f :: * -> *). f a -> Flap a f
Flap (a -> r a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) Flap a r -> Rec (Flap a) rs -> Rec (Flap a) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& FunctorRec rs a -> Rec (Flap a) rs
forall (fs :: [* -> *]) a. FunctorRec fs a -> Rec (Flap a) fs
getFunctorRec (a -> FunctorRec rs a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a))
  FunctorRec (Flap r (a -> b)
f :& Rec (Flap (a -> b)) rs
fs) <*> :: forall a b.
FunctorRec (r : rs) (a -> b)
-> FunctorRec (r : rs) a -> FunctorRec (r : rs) b
<*> FunctorRec (Flap r a
a :& Rec (Flap a) rs
as) =
    Rec (Flap b) (r : rs) -> FunctorRec (r : rs) b
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec (r b -> Flap b r
forall a (f :: * -> *). f a -> Flap a f
Flap (r (a -> b)
f r (a -> b) -> r a -> r b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> r a
r a
a) Flap b r -> Rec (Flap b) rs -> Rec (Flap b) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& FunctorRec rs b -> Rec (Flap b) rs
forall (fs :: [* -> *]) a. FunctorRec fs a -> Rec (Flap a) fs
getFunctorRec (Rec (Flap (a -> b)) rs -> FunctorRec rs (a -> b)
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec Rec (Flap (a -> b)) rs
fs FunctorRec rs (a -> b) -> FunctorRec rs a -> FunctorRec rs b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Rec (Flap a) rs -> FunctorRec rs a
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec Rec (Flap a) rs
as))

instance Foldable (FunctorRec '[]) where
  foldr :: forall a b. (a -> b -> b) -> b -> FunctorRec '[] a -> b
foldr a -> b -> b
_ b
z (FunctorRec Rec (Flap a) '[]
RNil) = b
z
instance (Foldable r, Foldable (FunctorRec rs)) => Foldable (FunctorRec (r ': rs)) where
    -- TODO foldr is harder lol
    foldMap :: forall m a. Monoid m => (a -> m) -> FunctorRec (r : rs) a -> m
foldMap a -> m
f (FunctorRec (Flap r a
r :& Rec (Flap a) rs
rs)) = (a -> m) -> r a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f r a
r m -> m -> m
forall a. Semigroup a => a -> a -> a
<> (a -> m) -> FunctorRec rs a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (Rec (Flap a) rs -> FunctorRec rs a
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec Rec (Flap a) rs
rs)

-- I am shit at this LOL
instance Traversable (FunctorRec '[]) where
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FunctorRec '[] a -> f (FunctorRec '[] b)
traverse a -> f b
_ (FunctorRec Rec (Flap a) '[]
RNil) = FunctorRec '[] b -> f (FunctorRec '[] b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Rec (Flap b) '[] -> FunctorRec '[] b
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec Rec (Flap b) '[]
forall {u} (a :: u -> *). Rec a '[]
RNil)
instance (Traversable r, Traversable (FunctorRec rs)) => Traversable (FunctorRec (r ': rs)) where
  traverse
      :: forall f a b. Applicative f
      => (a -> f b)
      -> (FunctorRec (r ': rs)) a
      -> f (FunctorRec (r ': rs) b)
  traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FunctorRec (r : rs) a -> f (FunctorRec (r : rs) b)
traverse a -> f b
f (FunctorRec (Flap (r a
r :: r a) :& Rec (Flap a) rs
rs)) =
      Rec (Flap b) (r : rs) -> FunctorRec (r : rs) b
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec (Rec (Flap b) (r : rs) -> FunctorRec (r : rs) b)
-> f (Rec (Flap b) (r : rs)) -> f (FunctorRec (r : rs) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (Rec (Flap b) (r : rs))
rBoth
    where
      rBoth :: f (Rec (Flap b) (r ': rs))
      rBoth :: f (Rec (Flap b) (r : rs))
rBoth = (Flap b r -> Rec (Flap b) rs -> Rec (Flap b) (r : rs))
-> f (Flap b r) -> f (Rec (Flap b) rs) -> f (Rec (Flap b) (r : rs))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Flap b r -> Rec (Flap b) rs -> Rec (Flap b) (r : rs)
forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
(:&) f (Flap b r)
rHead f (Rec (Flap b) rs)
rTail
      rHead :: f (Flap b r)
      rHead :: f (Flap b r)
rHead = r b -> Flap b r
forall a (f :: * -> *). f a -> Flap a f
Flap (r b -> Flap b r) -> f (r b) -> f (Flap b r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> r a -> f (r b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f r a
r
      rTail :: f (Rec (Flap b) rs)
      rTail :: f (Rec (Flap b) rs)
rTail = FunctorRec rs b -> Rec (Flap b) rs
forall (fs :: [* -> *]) a. FunctorRec fs a -> Rec (Flap a) fs
getFunctorRec (FunctorRec rs b -> Rec (Flap b) rs)
-> f (FunctorRec rs b) -> f (Rec (Flap b) rs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> FunctorRec rs a -> f (FunctorRec rs b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f (Rec (Flap a) rs -> FunctorRec rs a
forall (fs :: [* -> *]) a. Rec (Flap a) fs -> FunctorRec fs a
FunctorRec Rec (Flap a) rs
rs)

-- | What a patch seek value means.
data SeekKind
  = FwdSeek -- ^ seeks only move cursor forward
  | RelSeek -- ^ seeks are relative e.g. to a universal base, or a stream cursor
  | AbsSeek -- ^ seeks specify an exact offset in stream
    deriving (SeekKind -> SeekKind -> Bool
(SeekKind -> SeekKind -> Bool)
-> (SeekKind -> SeekKind -> Bool) -> Eq SeekKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeekKind -> SeekKind -> Bool
$c/= :: SeekKind -> SeekKind -> Bool
== :: SeekKind -> SeekKind -> Bool
$c== :: SeekKind -> SeekKind -> Bool
Eq, Int -> SeekKind -> ShowS
[SeekKind] -> ShowS
SeekKind -> String
(Int -> SeekKind -> ShowS)
-> (SeekKind -> String) -> ([SeekKind] -> ShowS) -> Show SeekKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeekKind] -> ShowS
$cshowList :: [SeekKind] -> ShowS
show :: SeekKind -> String
$cshow :: SeekKind -> String
showsPrec :: Int -> SeekKind -> ShowS
$cshowsPrec :: Int -> SeekKind -> ShowS
Show, (forall x. SeekKind -> Rep SeekKind x)
-> (forall x. Rep SeekKind x -> SeekKind) -> Generic SeekKind
forall x. Rep SeekKind x -> SeekKind
forall x. SeekKind -> Rep SeekKind x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SeekKind x -> SeekKind
$cfrom :: forall x. SeekKind -> Rep SeekKind x
Generic)

-- | Get the representation for a 'SeekKind'. Allows us a bit more safety.
type family SeekRep (s :: SeekKind) where
    SeekRep 'FwdSeek = Natural
    SeekRep 'RelSeek = Integer
    SeekRep 'AbsSeek = Natural