path: root/edit-lens/src/Control/DFST/Lens.lhs

\begin{comment}
\begin{code}
{-# LANGUAGE ScopedTypeVariables
           , TemplateHaskell
           , ConstraintKinds
           , GeneralizedNewtypeDeriving
#-}

module Control.DFST.Lens
  ( StringEdit(..), sePos, seInsertion
  , StringEdits(..), _StringEdits, _SEFail, stringEdits
  , insert, delete, replace
  , DFSTAction(..), DFSTComplement
  , dfstLens
  , module Control.DFST
  , module Control.Lens.Edit
  ) where

import Control.DFST
import Control.FST hiding (stInitial, stTransition, stAccept)
import qualified Control.FST as FST (stInitial, stTransition, stAccept, step)
import Control.Lens.Edit
import Control.Lens
import Control.Lens.TH
import Control.Edit

import Control.Monad

import Numeric.Natural
import Numeric.Interval (Interval, (...))
import qualified Numeric.Interval as Int

import Data.Sequence (Seq((:<|), (:|>)))
import qualified Data.Sequence as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map.Lazy (Map)
import qualified Data.Map.Lazy as Map

import Data.Compositions (Compositions)
import qualified Data.Compositions as Comp

import Data.Algorithm.Diff (Diff, getDiff)
import qualified Data.Algorithm.Diff as Diff

import Data.Monoid
import Data.Bool (bool)
import Data.Maybe (fromMaybe, maybeToList, listToMaybe, catMaybes, isNothing, isJust)
import Data.Function (on)
import Data.Foldable (toList)
import Data.List (partition)

import Control.Exception (assert)

import System.IO.Unsafe
import Text.PrettyPrint.Leijen (Pretty(..))

\end{code}
\end{comment}


Wir betrachten, zur Einfachheit, ein minimiales Set von Edits auf Strings\footnote{Wie in der Konstruktion zum Longest Common Subsequence Problem}:

\begin{defn}[Atomare edits of strings]
\begin{code}
data StringEdit pos char = Insert { _sePos :: pos, _seInsertion :: char }
                         | Delete { _sePos :: pos }
  deriving (Eq, Ord, Show, Read)

-- Automatically derive van-leerhoven-lenses:
--
-- @sePos :: Lens' (StringEdits pos char) pos@
-- @seInsertion :: Traversal' (StringEdits pos char) char@
makeLenses ''StringEdit
\end{code}
\end{defn}

Atomare edits werden, als Liste, zu edits komponiert.
Wir führen einen speziellen edit ein, der nicht-Anwendbarkeit der edits repräsentiert:
\begin{code}
data StringEdits pos char = StringEdits (Seq (StringEdit pos char))
                          | SEFail
  deriving (Eq, Ord, Show, Read)

makePrisms ''StringEdits

stringEdits :: Traversal (StringEdits pos char) (StringEdits pos' char') (StringEdit pos char) (StringEdit pos' char')
\end{code}
\begin{comment}
\begin{code}
stringEdits = _StringEdits . traverse
\end{code}
\end{comment}
\begin{code}
insert :: pos -> char -> StringEdits pos char
\end{code}
\begin{comment}
\begin{code}
insert n c = StringEdits .  Seq.singleton $ Insert n c
\end{code}
\end{comment}
\begin{code}
delete :: pos -> StringEdits pos char
\end{code}
\begin{comment}
\begin{code}
delete n = StringEdits .  Seq.singleton $ Delete n
\end{code}
\end{comment}
\begin{code}
replace :: Eq pos => pos -> char -> StringEdits pos char
\end{code}
\begin{comment}
\begin{code}
replace n c = insert n c <> delete n

-- | Rudimentarily optimize edit composition
instance Eq pos => Monoid (StringEdits pos char) where
  mempty = StringEdits Seq.empty
  SEFail `mappend` _ = SEFail
  _ `mappend` SEFail = SEFail
  (StringEdits Seq.Empty) `mappend` x = x
  x `mappend` (StringEdits Seq.Empty) = x
  (StringEdits x@(bs :|> b)) `mappend` (StringEdits y@(a :<| as))
    | (Insert n _) <- a
    , (Delete n') <- b
    , n == n'
    = StringEdits bs `mappend` StringEdits as
    | otherwise = StringEdits $ x `mappend` y
\end{code}
\end{comment}

Da wir ein minimales set an atomaren edits gewählt haben, ist die Definiton der Modulnstruktur über Strings des passenden Alphabets recht einfach:
\begin{code}
instance Module (StringEdits Natural char) where
  type Domain (StringEdits Natural char) = Seq char
  apply str SEFail = Nothing
  apply str (StringEdits Seq.Empty) = Just str
  apply str (StringEdits (es :|> Insert n c)) = flip apply (StringEdits es) =<< go str n c
    where
      go Seq.Empty n c
        | n == 0 = Just $ Seq.singleton c
        | otherwise = Nothing
      go str@(x :<| xs) n c
        | n == 0 = Just $ c <| str
        | otherwise = (x <|) <$> go xs (pred n) c
  apply str (StringEdits (es :|> Delete n)) = flip apply (StringEdits es) =<< go str n
    where
      go Seq.Empty _ = Nothing
      go (x :<| xs) n
        | n == 0 = Just xs
        | otherwise = (x <|) <$> go xs (pred n)

  init = Seq.empty
  divInit = StringEdits . Seq.unfoldl go . (0,)
    where
      go (_, Seq.Empty) = Nothing
      go (n, c :<| cs ) = Just ((succ n, cs), Insert n c)

\end{code}

% TODO Make notation mathy

Um zunächst eine asymmetrische edit-lens \texttt{StringEdits -> StringEdits} mit akzeptabler Komplexität für einen bestimmten DFST (entlang der \emph{Richtung} des DFSTs) zu konstruieren möchten wir folgendes Verfahren anwenden:

Gegeben eine Sequenz von zu übersetzenden Änderungen genügt es die Übersetzung eines einzelnen \texttt{StringEdit}s in eine womöglich längere Sequenz von \texttt{StringEdits} anzugeben, alle \texttt{StringEdits} aus der Sequenz derart zu übersetzen (hierbei muss auf die korrekte Handhabung des Komplements geachtet werden) und jene Übersetzungen dann zu concatenieren.

Wir definieren zunächst die \emph{Wirkung} eines DFST auf einen festen String als eine Abbildung \texttt{state -> (Seq output, Maybe state)}, die den aktuellen Zustand vor dem Parsen des Strings auf den Zustand danach und die (womöglich leere) Ausgabe schickt.
Wir annotieren Wirkungen zudem mit dem konsumierten String.
Diese Wirkungen bilden einen Monoiden analog zu Endomorphismen, wobei die Resultat-Strings concateniert werden.

\begin{code}
data DFSTAction state input output = DFSTAction
  { runDFSTAction :: state -> (Seq output, Maybe state)
  , dfstaConsumes :: Seq input
  }

instance Monoid (DFSTAction state input output) where
\end{code}
\begin{comment}
\begin{code}
  mempty = DFSTAction (\x -> (Seq.empty, Just x)) Seq.empty
  DFSTAction f cf `mappend` DFSTAction g cg = DFSTAction
    { runDFSTAction = \x ->
        let (outG, x') = g x
            (outF, x'') = maybe (mempty, Nothing) f x'
         in (outG <> outF, x'')
    , dfstaConsumes = cg <> cf
    }
\end{code}
\end{comment}
\begin{code}

type DFSTComplement state input output = Compositions (DFSTAction state input output)

runDFSTAction' :: DFSTComplement state input output -> state -> (Seq output, Maybe state)
runDFSTAction' = runDFSTAction . Comp.composed

dfstaConsumes' :: DFSTComplement state input output -> Seq input
dfstaConsumes' = dfstaConsumes . Comp.composed

dfstaProduces :: DFSTComplement state input output -> state -> Seq output
dfstaProduces = fmap fst . runDFSTAction'
\end{code}

Die Unterliegende Idee von $\Rrightarrow$ ist nun im Komplement der edit-lens eine Liste von Wirkungen (eine für jedes Zeichen der Eingabe des DFSTs) und einen Cache der monoidalen Summen aller kontinuirlichen Teillisten zu halten.

Wir können die alte DFST-Wirkung zunächst anhand des Intervalls indem der input-String von allen gegebenen edits betroffen ist in einen unveränderten Prefix und einen womöglich betroffenen Suffix unterteilen.

Da wir wissen welche Stelle im input-String vom ersten gegebenen edit betroffen ist können wir, anhand der Wirkung des Teilstücks bis zu jener Stelle, den betroffenen Suffix wiederum teilen.
Die Wirkung ab der betroffenen Stelle im input-String können wir als Komposition der Wirkung der durch den edit betroffenen Stelle und derer aller Zeichen danach bestimmen.
Nun gilt es nur noch die Differenz (als `StringEdits`) des vorherigen Suffixes im output-String und des aus der gerade berechneten Wirkung zu bestimmen, wir bedienen uns hierzu dem Unix Standard-Diff-Algorithmus zwischen der ursprünglichen Ausgabe und dem Ergebnis der Iteration des Verfahrens auf alle gegebenen edits.

Für die asymmetrische edit-lens entgegen der DFST-Richtung $\Lleftarrow$ verwenden wir Breitensuche über die Zustände des DFST innerhalb eines iterative vergrößerten Intervalls:

Wir bestimmen zunächst (`affected`) eine obere Schranke an das Intervall in dem der Ausgabe-String vom edit betroffen ist und generieren eine von dort quadratisch wachsende Serie von Intervallen.

Für jedes Intervall ("lokalere" Änderungen werden präferiert) schränken wir zunächst den DFST (zur einfachereren Implementierung in seiner Darstellung als FST) vermöge \texttt{restrictOutput} derart ein, dass nur die gewünschte Ausgabe produziert werden kann.

Wir betrachten dann in jedem Schritt (beginnend mit dem initialen Zustand des DFST) alle ausgehenden Transitionen und ziehen hierbei jene vor, die im vorherigen Lauf (gespeichert im Komplement der edit-lens), ebenfalls genommen wurden.
Abweichungen vom im Komplement gespeicherten Lauf lassen wir nur innerhalb des betrachteten Intervalls zu und wählen in diesem Fall einen Edit auf der Eingabe, der die gewählte Abweichung produziert.
Es wird zudem, wie für Breitensuche üblich, jeder besuchte Zustand markiert und ausgehende Transitionen nicht ein zweites mal betrachtet.

Erreichen wir einen finalen Zustand (wegen der Einschränkung des DFSTs wurde dann auch genau die gewünschte Ausgabe produziert), so fügen wir an die gesammelten Eingabe-edits eine Serie von deletions an, die den noch nicht konsumierten suffix der Eingabe verwerfen und brechen die Suche unter Rückgabe der Eingabe-edits und des neuen Laufs ab.

In Haskell formulieren wir das vorzeitige Abbrechen der Suche indem wir eine vollständige Liste von Rückgabe-Kandidaten konstruieren und dann immer ihr erstes Element zurück geben.
Wegen der verzögerten Auswertungsstrategie von Haskell wird auch tatsächlich nur der erste Rückgabe-Kandidat konstruiert.

\begin{comment}
\begin{code}
type LState state input output = (Natural, (state, Maybe (input, Natural)))
\end{code}
\end{comment}
\begin{code}
dfstLens :: forall state input output. (Ord state, Ord input, Ord output, Show state, Show input, Show output) => DFST state input output -> EditLens (DFSTComplement state input output) (StringEdits Natural input) (StringEdits Natural output)
\end{code}
\begin{comment}
\begin{code}
dfstLens dfst@DFST{..} = EditLens ground propR propL
  where
    ground :: DFSTComplement state input output
    ground = mempty

    propR :: (DFSTComplement state input output, StringEdits Natural input) -> (DFSTComplement state input output, StringEdits Natural output)
    propR (c, SEFail) = (c, SEFail)
    propR (c, StringEdits Seq.Empty) = (c, mempty)
    propR (c, es'@(StringEdits (es :> e)))
      | (_, Just final) <- runDFSTAction' c' stInitial
      , final `Set.member` stAccept
      = (c', rEs)
      | otherwise
      = (c, SEFail)
      where
        Just int = affected es'
        (cAffSuffix, cAffPrefix) = Comp.splitAt (Comp.length c - fromIntegral (Int.inf int)) c
        (cSuffix, cPrefix) = Comp.splitAt (Comp.length c - (e ^. sePos . from enum)) c
        cSuffix'
          | Delete _       <- e
          , Comp.length cSuffix > 0 = Comp.take (pred $ Comp.length cSuffix) cSuffix
          | Insert _ nChar <- e = cSuffix <> Comp.singleton (DFSTAction (\x -> runDFST' dfst x (pure nChar) Seq.empty) (Seq.singleton nChar))
          | otherwise = Comp.singleton $ DFSTAction (\_ -> (Seq.empty, Nothing)) Seq.empty
        (c', _) = propR (cSuffix' <> cPrefix, StringEdits es)
        (cAffSuffix', _) = Comp.splitAt (Comp.length c' - Comp.length cAffPrefix) c'
        (_, Just pFinal) = runDFSTAction' cPrefix stInitial
        rEs = strDiff (fst $ runDFSTAction' cAffSuffix pFinal) (fst $ runDFSTAction' cAffSuffix' pFinal) & stringEdits . sePos . from enum +~ length (dfstaProduces cAffPrefix stInitial)
        

    propL :: (DFSTComplement state input output, StringEdits Natural output) -> (DFSTComplement state input output, StringEdits Natural input)
    propL (c, StringEdits Seq.Empty) = (c, mempty)
    propL (c, es) = fromMaybe (c, SEFail) $ do
      let prevOut = dfstaProduces c stInitial
      newOut <- prevOut `apply` es
      affected' <- affected es
      let outFST :: FST (LState state input output) input output
          -- outFST = wordFST newOut `productFST` toFST dfst
          outFST = restrictOutput newOut $ toFST dfst
      
          trace x y = flip seq y . unsafePerformIO $ appendFile "lens.log" (x <> "\n\n")

          inflate by int
            | Int.null int = Int.empty
            | inf >= by = inf - by Int.... sup + by
            | otherwise = 0 Int.... sup + by
            where
              (inf, sup) = (,) <$> Int.inf <*> Int.sup $ int
          fragmentIntervals = (++ [all]) . takeWhile (not . Int.isSubsetOf (0 Int.... max)) $ inflate <$> 0 : [ 2^n | n <- [0..ceiling (logBase 2.0 max)] ] <*> pure affected'
            where
              max :: Num a => a
              max = fromIntegral $ Seq.length newOut
              all = 0 Int.... max
          runCandidates :: Interval Natural -- ^ Departure from complement-run only permitted within interval (to guarantee locality)
                        -> [ ( Seq (LState state input output, Maybe output) -- ^ Computed run
                             , StringEdits Natural input
                             , DFSTComplement state input output
                             )
                           ]
          runCandidates focus = map ((,,) <$> view _1 <*> view _2 <*> view (_3 . _2)) $ go Set.empty [(Seq.empty, mempty, (c, mempty), 0)]
            where
              go _ [] = []
              go visited (args@(run, edits, compZipper, inP) : alts) = 
                  [ (run', finalizeEdits remC inP' edits', compZipper', inP') | (run', edits', compZipper'@(remC, _), inP') <- args : conts, isFinal run' ]
                  ++ go visited' (alts ++ conts)
                where
                  conts
                    | lastSt <- view _1 <$> Seq.lookup (pred $ Seq.length run) run
                    , lastSt `Set.member` visited = []
                    | otherwise = continueRun edits compZipper inP run
                  visited' = Set.insert (view _1 <$> Seq.lookup (pred $ Seq.length run) run) visited

              isFinal :: Seq (LState state input output, Maybe output) -> Bool
              -- ^ Is the final state of the run a final state of the DFST?
              isFinal Seq.Empty = (0, (stInitial, Nothing)) `Set.member` FST.stAccept outFST
                               && (0 Int.... fromIntegral (Seq.length newOut)) `Int.isSubsetOf` focus
              isFinal (_ :> (lastSt, _)) = lastSt `Set.member` FST.stAccept outFST

              finalizeEdits :: DFSTComplement state input output -- ^ Remaining complement
                            -> Natural -- ^ Input position
                            -> StringEdits Natural input -> StringEdits Natural input
              finalizeEdits remC inP = mappend . mconcat . replicate (Seq.length $ dfstaConsumes' remC) $ delete inP
              
              continueRun :: StringEdits Natural input
                          -> (DFSTComplement state input output, DFSTComplement state input output) -- ^ Zipper into complement
                          -> Natural -- ^ Input position
                          -> Seq (LState state input output, Maybe output)
                          -> [ ( Seq (LState state input output, Maybe output)
                               , StringEdits Natural input
                               , (DFSTComplement state input output, DFSTComplement state input output)
                               , Natural
                               )
                             ]
              -- ^ Nondeterministically make a single further step, continueing a given run
              continueRun inEdits (c', remC) inP run = do
                let
                  pos :: Natural
                  -- pos = fromIntegral $ Comp.length c - Comp.length c' -- FIXME: should use length of dfstaProduces
                  pos = fromIntegral . Seq.length $ dfstaProduces remC stInitial
                  (c'', step) = Comp.splitAt (pred $ Comp.length c') c' -- TODO: unsafe?
                  current :: LState state input output
                  current
                    | Seq.Empty <- run      = (0, (stInitial, Nothing))
                    | (_ :> (st, _)) <- run = st
                  current' :: state
                  oldIn :: Maybe input
                  (current', oldIn)
                    | (_ :> ((_, (st, _)), _)) <- rest
                    , (_ :> ((_, (_, Just (partialIn, _))), _)) <- partial = (st, Just partialIn)
                    | (_ :> ((_, (_, Just (partialIn, _))), _)) <- partial = (stInitial, Just partialIn)
                    | Seq.Empty <- rest = (stInitial, Seq.lookup 0 $ dfstaConsumes' step)
                    | (_ :> ((_, (st, _)), _)) <- rest = (st, Seq.lookup 0 $ dfstaConsumes' step)
                    where
                      (partial, rest) = Seq.spanr (\((_, (_, inp)), _) -> isJust inp) run
                next' <- trace (show ("next'", pos, focus, run, (current', oldIn), current, dfstaConsumes' step, runDFST' dfst current' (maybe Seq.empty Seq.singleton oldIn) Seq.empty)) . maybeToList . snd $ runDFST' dfst current' (maybe Seq.empty Seq.singleton oldIn) Seq.empty
                let
                  outgoing :: LState state input output -> [(LState state input output, Maybe input, Maybe output)]
                  outgoing current = let go (st, minS) outs acc
                                           | st == current = Set.foldr (\(st', moutS) -> ((st', minS, moutS) :)) acc outs
                                           | otherwise     = acc
                                      in Map.foldrWithKey go [] $ FST.stTransition outFST 
                  isPreferred :: (LState state input output, Maybe input, Maybe output) -> Bool
                  isPreferred ((_, (st, Nothing)), _, _) = st == next'
                  isPreferred (st@(_, (_, Just (inS , _))), _, _) = maybe True (== inS) oldIn && any isPreferred (outgoing st) -- By construction of `outFST`, `outgoing st` is a singleton in this case
                  (preferred, alternate) = partition isPreferred $ outgoing current
                  assocEdit :: (LState state input output, Maybe input, Maybe output) -- ^ Transition
                            -> [ ( (DFSTComplement state input output, DFSTComplement state input output) -- ^ new `(c', remC)`, i.e. complement-zipper `(c', remC)` but with edit applied
                                 , StringEdits Natural input
                                 , Natural
                                 )
                               ]
                  assocEdit (_, Just inS, _)
                    | oldIn == Just inS = [ ((c'', step <> remC), mempty, succ inP) ]
                    | isJust oldIn      = [ ((c', altStep inS <> remC), insert inP inS, succ inP)
                                          , ((c'', altStep inS <> remC), replace inP inS, succ inP)
                                          ]
                    | otherwise         = [ ((c', altStep inS <> remC), insert inP inS, succ inP) ]
                  assocEdit (_, Nothing, _) = [((c', remC), mempty, inP)]
                  altStep :: input -> DFSTComplement state input output
                  altStep inS = Comp.singleton DFSTAction{..}
                    where
                      dfstaConsumes = Seq.singleton inS
                      runDFSTAction x = runDFST' dfst x (pure inS) Seq.empty
                  options
                    | pos `Int.member` focus = preferred ++ alternate
                    | otherwise              = preferred
                choice@(next, inS, outS) <- trace (unlines $ show (pretty outFST) : map show options) options
                ((c3, remC'), inEdits', inP') <- assocEdit choice
                -- let
                --   -- | Replace prefix of old complement to reflect current candidate
                --   -- TODO: smarter?
                --   (_, ((c3 <>) -> newComplement')) = Comp.splitAt (Comp.length c') c -- TODO: unsafe?
                --   acc = (run :> (next, outS), inEdits' <> inEdits, newComplement')
                --   dropSuffix = mconcat (replicate (Seq.length $ dfstaConsumes' c3) $ delete inP')
                --   fin
                --     | (trans, inEs, newComplement) <- acc = (trans, dropSuffix <> inEs, newComplement)
                let
                  trans = run :> (next, outS)
                  inEs = inEdits' <> inEdits
                --   dropSuffix = mconcat (replicate (Seq.length $ dfstaConsumes' c3) $ delete inP')
                --   fin
                --     | (trans, inEs) <- acc = (trans, dropSuffix <> inEs, remC')
                -- bool id (over _BFS $ cons fin) (next `Set.member` FST.stAccept outFST) $ continueRun acc (c3, remC') inP'
                return (trans, inEs, (c3, remC'), inP')
              
      -- Properties of the edits computed are determined mostly by the order candidates are generated below
      -- (_, inEs, c') <- (\xs -> foldr (\x f -> x `seq` f) listToMaybe xs $ xs) $ traceShowId fragmentIntervals >>= (\x -> (\y@(y1, y2, _) -> traceShow (y1, y2) y) <$> runCandidates x)

      fmap ((,) <$> view _3 <*> view _2) .  listToMaybe $ runCandidates =<< fragmentIntervals

strDiff :: forall sym pos. (Eq sym, Integral pos) => Seq sym -> Seq sym -> StringEdits pos sym
-- ^ @strDiff a b@ calculates a set of edits, which, when applied to @a@, produce @b@
strDiff a b = snd . foldl toEdit (0, mempty) $ (getDiff `on` toList) a b
  where
    toEdit :: (pos, StringEdits pos sym) -> Diff sym -> (pos, StringEdits pos sym)
    toEdit (n, es) (Diff.Both _ _) = (succ n, es)
    toEdit (n, es) (Diff.First _ ) = (n, delete n <> es)
    toEdit (n, es) (Diff.Second c) = (succ n, insert n c <> es)
\end{code}
\end{comment}

Um eine obere Schranke an das von einer Serie von edits betroffene Intervall zu bestimmen ordnen wir zunächst jeder von mindestens einem atomaren edit betroffenen Position $n$ im Eingabe-Wort einen $\text{offset}_n = \text{\# deletions} - \text{\# inserts}$ zu.
Das gesuchte Intervall ist nun $(\text{minK}, \text{maxK})$, mit $\text{minK}$ der Position im Eingabe-Wort mit niedrigstem $\text{offset}$ und $\text{maxK}$ die Position im Eingabe-Wort mit höchstem $\text{offset}$, $\text{maxK}^\prime$, modifiziert um das Maximum aus $\{ 0 \} \cup \{ \text{maxK}_n \colon n \in \{ 0 \ldots \text{maxK}^\prime \} \}$ wobei $\text{maxK}_n = -1 \cdot (n + \text{offset}_n)$ an Position $n$ ist.

\begin{code}
affected :: forall char. StringEdits Natural char -> Maybe (Interval Natural)
-- ^ For a given set of edits @es@ return the interval @i = a ... b@ such that for any given string @str@ of sufficient length the following holds:
--
--   - For all @n :: Natural@: @n < a ==> str ! n == (str `apply` es) ! n@
--   - There exists a @k :: Integer@ such that for all @n :: Integer@: @n > b ==> str ! (n + k) == (str `apply` es) ! n@
--
-- Intuitively: for any character @c@ of the new string @str `apply` es@ there exists a corresponding character in @str@ (offset by either 0 or a constant shift @k@) if the index of @c@ is /not/ contained in @affected es@.
\end{code}
\begin{comment}
\begin{code}
affected SEFail = Nothing
affected (StringEdits es) = Just . toInterval $ go es Map.empty
  where
    toInterval :: Map Natural Integer -> Interval Natural
    toInterval map
      | Just (((minK, _), _), ((maxK, _), _)) <- (,) <$> Map.minViewWithKey map <*> Map.maxViewWithKey map
      = let
          maxV' = maximum . (0 :) $ do
            offset <- [0..maxK]
            v <- maybeToList $ Map.lookup (maxK - offset) map
            v' <- maybeToList . fmap fromInteger $ negate v <$ guard (v <= 0)
            guard $ v' >= succ offset
            return $ v' - offset
        in (minK Int.... maxK + maxV')
      | otherwise
      = Int.empty
    go :: Seq (StringEdit Natural char) -> Map Natural Integer -> Map Natural Integer
    go Seq.Empty offsets = offsets
    go (es :> e) offsets = go es offsets'
      where
        p = e ^. sePos
        -- p' = fromIntegral $ Map.foldrWithKey (\k o p -> bool (fromIntegral p) (o + p) $ k < fromIntegral p) (fromIntegral p) offsets
        offsets' = Map.alter (Just . myOffset . fromMaybe 0) p offsets
        myOffset :: Integer -> Integer
        myOffset
          | Insert _ _ <- e = pred
          | Delete _   <- e = succ
\end{code}
\end{comment}