{-# LANGUAGE OverloadedStrings #-}

module StreamPatch.Example where

import StreamPatch.Patch
import StreamPatch.Seek
import StreamPatch.Patch.Compare qualified as Compare
import StreamPatch.Patch.Compare ( Via(..), EqualityCheck(..) )
import StreamPatch.HFunctorList
import Data.Vinyl

import Data.Text ( Text )
import Numeric.Natural

ex :: Patch (SIx Natural) '[Compare.Meta ('ViaEq 'Exact)] Text
ex :: Patch (SIx Natural) '[Meta ('ViaEq 'Exact)] Text
ex = forall s (fs :: [* -> *]) a.
a -> s -> HFunctorList fs a -> Patch s fs a
Patch Text
"no way this works LMAO" (forall a. a -> SIx a
SIx Natural
0) forall a b. (a -> b) -> a -> b
$ forall {k} (fs :: [k -> *]) (a :: k).
Rec (Flap a) fs -> HFunctorList fs a
HFunctorList forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k) (f :: k -> *). f a -> Flap a f
Flap (forall (v :: Via) a. Maybe (CompareRep v a) -> Meta v a
Compare.Meta forall a. Maybe a
Nothing) forall {u} (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
:& forall {u} (a :: u -> *). Rec a '[]
RNil

ex2 :: Patch (SIx Natural) '[] Text
ex2 :: Patch (SIx Natural) '[] Text
ex2 = forall s (fs :: [* -> *]) a.
a -> s -> HFunctorList fs a -> Patch s fs a
Patch Text
"no way this works LMAO" (forall a. a -> SIx a
SIx Natural
0) forall a b. (a -> b) -> a -> b
$ forall {k} (fs :: [k -> *]) (a :: k).
Rec (Flap a) fs -> HFunctorList fs a
HFunctorList forall {u} (a :: u -> *). Rec a '[]
RNil