summaryrefslogtreecommitdiff
path: root/edit-lens/src/Control/Edit
diff options
context:
space:
mode:
Diffstat (limited to 'edit-lens/src/Control/Edit')
-rw-r--r--edit-lens/src/Control/Edit/Container.lhs74
-rw-r--r--edit-lens/src/Control/Edit/Tree.lhs9
2 files changed, 74 insertions, 9 deletions
diff --git a/edit-lens/src/Control/Edit/Container.lhs b/edit-lens/src/Control/Edit/Container.lhs
new file mode 100644
index 0000000..7d0d57c
--- /dev/null
+++ b/edit-lens/src/Control/Edit/Container.lhs
@@ -0,0 +1,74 @@
1\begin{comment}
2\begin{code}
3module Control.Edit.Container
4 ( Container(..), Shape, Content
5 , ContainerEdit(..)
6 ) where
7
8import Control.Edit
9import Data.Set (Set)
10import Data.Sequence (Seq)
11import qualified Data.Sequence as Seq
12
13import Control.Monad
14
15import Control.Lens
16\end{code}
17\end{comment}
18
19\begin{defn}[Container]
20\begin{code}
21class ( Module (ModShape c)
22 , Module (ModContent c)
23 , Ord (Position c)
24 ) => Container c where
25 type ModShape c :: *
26 type Position c :: *
27 type ModContent c :: *
28 positions :: Shape c -> Set (Position c)
29 deconstructed :: Iso' c (Shape c, Position c -> Content c)
30
31constructed :: Container c => Iso' (Shape c, Position c -> Content c) c
32constructed = from deconstructed
33
34type Shape c = Domain (ModShape c)
35type Content c = Domain (ModContent c)
36\end{code}
37\end{defn}
38
39\begin{defn}[container-edits]
40\begin{code}
41data ContainerEdit c where
42 Fail :: ContainerEdit c
43 ModContent :: Position c -> ModContent c -> ContainerEdit c
44 ModShape :: ModShape c -> (Shape c -> Position c -> Position c) -> ContainerEdit c
45\end{code}
46\end{defn}
47
48\begin{defn}[Wirkung von container-edits]
49\begin{code}
50instance Container c => Module (Seq (ContainerEdit c)) where
51 type Domain (Seq (ContainerEdit c)) = c
52 apply fs = over mapped (view constructed) . flip (foldM apply') fs . view deconstructed
53 where
54 apply' :: Container c
55 => (Shape c, Position c -> Content c)
56 -> ContainerEdit c
57 -> Maybe (Shape c, Position c -> Content c)
58 apply' _ Fail = Nothing
59 apply' (s, cf) (ModContent p dc) = do
60 c' <- dc `apply` cf p
61 let cf' x
62 | x == p = c'
63 | otherwise = cf x
64 return (s, cf')
65 apply' (s, cf) (ModShape ds dcf) = (, cf . dcf s) <$> ds `apply` s
66 initial = view constructed (initial @(ModShape c), \_ -> initial @(ModContent c))
67 divInit x =
68 let
69 x'@(s, cf) = x ^. deconstructed
70 (ds, dcf) = over _1 divInit $ over (_2.mapped) divInit x'
71 in
72 foldMap (\p -> Seq.singleton . ModContent p $ dcf p) (positions @c s) |> (ModShape ds $ const id)
73\end{code}
74\end{defn}
diff --git a/edit-lens/src/Control/Edit/Tree.lhs b/edit-lens/src/Control/Edit/Tree.lhs
deleted file mode 100644
index 28320c5..0000000
--- a/edit-lens/src/Control/Edit/Tree.lhs
+++ /dev/null
@@ -1,9 +0,0 @@
1\begin{comment}
2\begin{code}
3module Control.Edit.Tree
4 (
5 ) where
6
7import Control.Edit
8\end{code}
9\end{comment}