changetrace.hs

>>> compose (cpy 2 <> ins 1 <> cpy 2) (cpy 4 :: Change)
splitDeltaIn: Change (fromList [Edit 2 0 1,Edit 2 0 0]) 0
splitDeltaOut: (Change (fromList [Edit 2 0 1]) 2,Change (fromList []) 0)
editEdit: Edit 4 0 0
editSplitIn: Change (fromList [Edit 2 0 1]) 2
editSplitOut: (Change (fromList [Edit 2 0 1]) 2,Change (fromList [Edit (-2) 0 0]) 0)
*** Exception: changePos: Past end
CallStack (from HasCallStack):
  error, called at ./Coda/Syntax/Change.hs:127:18 in coda-change-0.0.1-inplace:Coda.Syntax.Change

instance Changeable Delta where
  change (Change xs d) i = case search (\m _ -> i < delta m) xs of
    Position (measure -> Grade o n) (Edit a _ _) _
      | i - o < a -> pure (n + i - o)
      | otherwise  -> fail "changePos: deleted position"
    OnRight
      | Grade o n <- measure xs, res <- i - o, res < d -> pure (n + res)
      | otherwise -> fail "changePos: Past end"
    OnLeft -> fail "changePos: index < 0"
    Nowhere -> fail "changePos: Nowhere"


instance Splittable Change where
  splitDelta i c@(Change xs d) = case search (\m _ -> i <= delta m) xs of
    Nowhere -> error "splitChange: Nowhere"
    OnLeft -> (mempty, c)
    OnRight | i' <- i - delta xs -> (Change xs i', cpy (d-i))
    Position l (Edit n f t) r
      | j < n -> (Change l j, Change (Edit (n-j) f t <| r) d)
      | (fl,fr) <- splitDelta (j - n) f -> (Change l n <> del fl <> ins t, del fr <> Change r d)
      where j = i - delta l

instance Editable Change where
  edit (traceAnnot "editEdit" -> Edit d f t) (traceAnnot "editSplitOut" . splitDelta d . traceAnnot "editSplitIn" -> (l,r)) = change r t <&> \t' -> l <> del f <> ins t'


traceAnnot :: Show a => String -> a -> a
traceAnnot l x = trace (l++": "++show x) x

-- | @change f g@ provides @g . f@
instance Changeable Change where
  change (Change xs0 d0) = go xs0 d0 where
    -- TODO: figure out an optimal split ordering by adding a cost to each edit
    go (e :< es) d (traceAnnot "splitDeltaOut" . splitDelta (delta (inverseEdit e)) . traceAnnot "splitDeltaIn" -> (l,r)) = (<>) <$> edit e l <*> go es d r
    go Empty d c = do
      unless (delta c == d) $ fail $ "changeChange: leftover mismatch " ++ show (delta c,d)
      pure c

-- | @compose f g@ provides @f . g@
instance Composable Change where
  compose = flip change