1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
|
\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)
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}
|
