Framework for DFST edit lens

1 files changed, 82 insertions, 0 deletions

diff --git a/edit-lens/src/Data/String/DFST/Lens.lhs b/edit-lens/src/Data/String/DFST/Lens.lhs
new file mode 100644
index 0000000..52c80d0
--- /dev/null
+++ b/edit-lens/src/Data/String/DFST/Lens.lhs
@@ -0,0 +1,82 @@
+\begin{code}
+{-# LANGUAGE TupleSections
+  #-}
+
+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)
+
+data DFSTAction state = DFSTBranch (Map state (state, String)) (DFSTAction state) (DFSTAction state)
+                      | 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}