module StreamPatch.Patch.Align where

import StreamPatch.Patch
import StreamPatch.HFunctorList ( hflStrip )

import GHC.Generics ( Generic )
import Data.Vinyl
import Data.Vinyl.TypeLevel
import Data.Functor.Const

data Meta st = Meta
  { forall st. Meta st -> Maybe st
mExpected :: Maybe st
  -- ^ Absolute stream offset for edit. Used for checking against actual offset.
  } deriving ((forall x. Meta st -> Rep (Meta st) x)
-> (forall x. Rep (Meta st) x -> Meta st) -> Generic (Meta st)
forall x. Rep (Meta st) x -> Meta st
forall x. Meta st -> Rep (Meta st) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall st x. Rep (Meta st) x -> Meta st
forall st x. Meta st -> Rep (Meta st) x
$cto :: forall st x. Rep (Meta st) x -> Meta st
$cfrom :: forall st x. Meta st -> Rep (Meta st) x
Generic, Int -> Meta st -> ShowS
[Meta st] -> ShowS
Meta st -> String
(Int -> Meta st -> ShowS)
-> (Meta st -> String) -> ([Meta st] -> ShowS) -> Show (Meta st)
forall st. Show st => Int -> Meta st -> ShowS
forall st. Show st => [Meta st] -> ShowS
forall st. Show st => Meta st -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Meta st] -> ShowS
$cshowList :: forall st. Show st => [Meta st] -> ShowS
show :: Meta st -> String
$cshow :: forall st. Show st => Meta st -> String
showsPrec :: Int -> Meta st -> ShowS
$cshowsPrec :: forall st. Show st => Int -> Meta st -> ShowS
Show, Meta st -> Meta st -> Bool
(Meta st -> Meta st -> Bool)
-> (Meta st -> Meta st -> Bool) -> Eq (Meta st)
forall st. Eq st => Meta st -> Meta st -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Meta st -> Meta st -> Bool
$c/= :: forall st. Eq st => Meta st -> Meta st -> Bool
== :: Meta st -> Meta st -> Bool
$c== :: forall st. Eq st => Meta st -> Meta st -> Bool
Eq)

data Error st
  = ErrorAlignedToNegative Integer -- guaranteed negative
  | ErrorDoesntMatchExpected st st
    deriving ((forall x. Error st -> Rep (Error st) x)
-> (forall x. Rep (Error st) x -> Error st) -> Generic (Error st)
forall x. Rep (Error st) x -> Error st
forall x. Error st -> Rep (Error st) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall st x. Rep (Error st) x -> Error st
forall st x. Error st -> Rep (Error st) x
$cto :: forall st x. Rep (Error st) x -> Error st
$cfrom :: forall st x. Error st -> Rep (Error st) x
Generic, Int -> Error st -> ShowS
[Error st] -> ShowS
Error st -> String
(Int -> Error st -> ShowS)
-> (Error st -> String) -> ([Error st] -> ShowS) -> Show (Error st)
forall st. Show st => Int -> Error st -> ShowS
forall st. Show st => [Error st] -> ShowS
forall st. Show st => Error st -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error st] -> ShowS
$cshowList :: forall st. Show st => [Error st] -> ShowS
show :: Error st -> String
$cshow :: forall st. Show st => Error st -> String
showsPrec :: Int -> Error st -> ShowS
$cshowsPrec :: forall st. Show st => Int -> Error st -> ShowS
Show, Error st -> Error st -> Bool
(Error st -> Error st -> Bool)
-> (Error st -> Error st -> Bool) -> Eq (Error st)
forall st. Eq st => Error st -> Error st -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Error st -> Error st -> Bool
$c/= :: forall st. Eq st => Error st -> Error st -> Bool
== :: Error st -> Error st -> Bool
$c== :: forall st. Eq st => Error st -> Error st -> Bool
Eq)

-- | Attempt to align the given patch to 0 using the given base.
--
-- The resulting seek is guaranteed to be non-negative, so you may use
-- natural-like types safely.
--
-- TODO Complicated.
align
    :: forall sf st a ss is 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 :: 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 Integer
sBase (Patch a
a sf
s HFunctorList ss a
ms)
  | Integer
s' Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = Error st -> Either (Error st) (Patch st rs a)
forall a b. a -> Either a b
Left (Error st -> Either (Error st) (Patch st rs a))
-> Error st -> Either (Error st) (Patch st rs a)
forall a b. (a -> b) -> a -> b
$ Integer -> Error st
forall st. Integer -> Error st
ErrorAlignedToNegative Integer
s'
  | Bool
otherwise =
      case Meta st -> Maybe st
forall st. Meta st -> Maybe st
mExpected Meta st
m of
        Maybe st
Nothing        -> Patch st rs a -> Either (Error st) (Patch st rs a)
forall a b. b -> Either a b
Right (Patch st rs a -> Either (Error st) (Patch st rs a))
-> Patch st rs a -> Either (Error st) (Patch st rs a)
forall a b. (a -> b) -> a -> b
$ a -> st -> HFunctorList rs a -> Patch st rs a
forall s (fs :: [* -> *]) a.
a -> s -> HFunctorList fs a -> Patch s fs a
Patch a
a st
s'' HFunctorList rs a
ms'
        Just st
sExpected ->
          if   st
sExpected st -> st -> Bool
forall a. Eq a => a -> a -> Bool
== st
s''
          then Patch st rs a -> Either (Error st) (Patch st rs a)
forall a b. b -> Either a b
Right (Patch st rs a -> Either (Error st) (Patch st rs a))
-> Patch st rs a -> Either (Error st) (Patch st rs a)
forall a b. (a -> b) -> a -> b
$ a -> st -> HFunctorList rs a -> Patch st rs a
forall s (fs :: [* -> *]) a.
a -> s -> HFunctorList fs a -> Patch s fs a
Patch a
a st
s'' HFunctorList rs a
ms'
          else Error st -> Either (Error st) (Patch st rs a)
forall a b. a -> Either a b
Left (Error st -> Either (Error st) (Patch st rs a))
-> Error st -> Either (Error st) (Patch st rs a)
forall a b. (a -> b) -> a -> b
$ st -> st -> Error st
forall st. st -> st -> Error st
ErrorDoesntMatchExpected st
sExpected st
s''
  where
    s' :: Integer
s' = Integer
sBase Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ sf -> Integer
forall a. Integral a => a -> Integer
toInteger sf
s
    s'' :: st
s'' = Integer -> st
forall a. Num a => Integer -> a
fromInteger Integer
s'
    (Meta st
m, HFunctorList rs a
ms') = (Const (Meta st) a -> Meta st)
-> HFunctorList ss a -> (Meta st, HFunctorList rs a)
forall {k} (f :: k -> *) (fs :: [k -> *]) (a :: k)
       (fs' :: [k -> *]) b (i :: Nat) (is :: [Nat]).
(RElem f fs i, fs' ~ RDelete f fs, RSubset fs' fs is) =>
(f a -> b) -> HFunctorList fs a -> (b, HFunctorList fs' a)
hflStrip Const (Meta st) a -> Meta st
forall {k} a (b :: k). Const a b -> a
getConst HFunctorList ss a
ms