\begin{code}
module Data.String.DFST.Lens
  (
  ) where

import Data.String.DFST
import Control.Lens.Edit
import Control.Edit

import Numeric.Natural
import Data.Sequence (Seq((:<|), (:|>)))
import qualified Data.Sequence as Seq

data StringEdit = Insert Natural Char
                | Delete Natural
  deriving (Eq, Ord, Show, Read)

data StringEdits = StringEdits (Seq StringEdit)
                 | SEFail
  deriving (Eq, Ord, Show, Read)

insert :: Natural -> Char -> StringEdits
insert n c = StringEdits .  Seq.singleton $ Insert n c
  
delete :: Natural -> StringEdits
delete n = StringEdits .  Seq.singleton $ Delete n

instance Monoid StringEdits 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

instance Module StringEdits where
  type Domain StringEdits = String
  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 [] n c
        | n == 0 = Just [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 [] _ = Nothing
      go (x:xs) n
        | n == 0 = Just xs
        | otherwise = (x:) <$> go xs (pred n)

  init = ""
  divInit = StringEdits . Seq.unfoldl go . (0,)
    where
      go (_, []) = 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 `StringEdits -> StringEdits` mit akzeptabler Komplexität für einen bestimmten `DFST s` (entlang der \emph{Richtung} des DFSTs) zu konstruieren möchten wir folgendes Verfahren anwenden:

Gegeben eine Sequenz (`StringEdits`) von zu übersetzenden Änderungen genügt es die Übersetzung eines einzelnen `StringEdit`s in eine womöglich längere Sequenz von `StringEdits` anzugeben, alle `StringEdits` aus der Sequenz 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 `state -> (state, String)`, die den aktuellen Zustand vorm Parsen des Strings auf den Zustand danach und die (womöglich leere) Ausgabe schickt.
Diese Wirkungen bilden einen Monoiden analog zu Endomorphismen, wobei die Resultat-Strings concateniert werden.

Die Unterliegende Idee 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 möglich Präfixe und Suffixe zu halten.
Da wir wissen welche Stelle im input-String von einem gegebenen edit betroffen ist können wir, anhand der Wirkung des Teilstücks bis zu jener Stelle, den output-String in einen durch den edit unveränderten Prefix und einen womöglich betroffenen Suffix unterteilen.
Die Wirkung ab der betroffenen Stelle im input-String können wir also 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 Bestimmten zu bestimmen.
  
\begin{code}

data DFSTAction state = DFSTBranch (Map state (state, String)) (DFSTAction state) (DFSTAction state)

% TODO propL, Transduktor invertieren?
                      | DFSTLeaf

dfstLens :: forall state. Ord state => DFST state -> EditLens (DFSTAction state) StringEdits StringEdits
dfstLens DFST{..} = EditLens ground propR propL
  where
    ground :: DFSTAction state
    ground = DFSTLeaf

    propR :: (DFSTAction state, StringEdits) -> (DFSTAction state, StringEdits)
    propR = undefined
    propL :: (DFSTAction state, StringEdits) -> (DFSTAction state, StringEdits)
    propL = undefined
\end{code}