Align.hs

module StreamPatch.Patch.Align where

import           StreamPatch.Patch

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

data Meta s = Meta
  { mExpected :: Maybe (SeekRep s)
  -- ^ Absolute stream offset for edit. Used for checking against actual offset.
  } deriving (Generic)

deriving instance (Eq   (SeekRep s)) => Eq   (Meta s)
deriving instance (Show (SeekRep s)) => Show (Meta s)

data Error s
  = ErrorSeekBelow0 (SeekRep 'RelSeek)
  | ErrorDoesntMatchExpected (SeekRep s) (SeekRep s) -- expected, then actual
    deriving (Generic)

deriving instance (Eq   (SeekRep s)) => Eq   (Error s)
deriving instance (Show (SeekRep s)) => Show (Error s)

-- | Attempt to align the given patch to 0 using the given base.
align
    :: forall s a ss rs is i r
    .  ( SeekRep s ~ Natural
       , r ~ Const (Meta s)
       , rs ~ RDelete r ss
       , RElem r ss i
       , RSubset rs ss is )
    => SeekRep 'RelSeek
    -> Patch 'RelSeek ss a
    -> Either (Error s) (Patch s rs a)
align sBase (Patch a s ms) =
    case tryIntegerToNatural sAligned of
      Nothing          -> Left $ ErrorSeekBelow0 sAligned
      Just sAlignedNat ->
        case mExpected m of
          Nothing        -> reform sAlignedNat
          Just sExpected ->
            if   sExpected == sAlignedNat
            then reform sAlignedNat
            else Left $ ErrorDoesntMatchExpected sExpected sAlignedNat
  where
    sAligned = sBase + s
    -- TODO require a visible type application here, unsure why. even without
    -- the SeekRep indirection
    m = getConst @(Meta s) $ getFlap $ rget $ getFunctorRec ms
    ms' = FunctorRec $ rcast @rs $ getFunctorRec ms
    reform s' = Right $ Patch a s' ms'

tryIntegerToNatural :: Integer -> Maybe Natural
tryIntegerToNatural n | n < 0     = Nothing
                      | otherwise = Just $ naturalFromInteger n