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
|
\begin{comment}
\begin{code}
module Control.Edit.Container
( Container(..), Shape, Content
, ContainerEdit(..)
) where
import Control.Edit
import Data.Set (Set)
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
import Control.Monad
import Control.Lens
\end{code}
\end{comment}
\begin{defn}[Container]
\begin{code}
class ( Module (ModShape c)
, Module (ModContent c)
, Ord (Position c)
) => Container c where
type ModShape c :: *
type Position c :: *
type ModContent c :: *
positions :: Shape c -> Set (Position c)
deconstructed :: Iso' c (Shape c, Position c -> Content c)
constructed :: Container c => Iso' (Shape c, Position c -> Content c) c
constructed = from deconstructed
type Shape c = Domain (ModShape c)
type Content c = Domain (ModContent c)
\end{code}
\end{defn}
\begin{defn}[container-edits]
\begin{code}
data ContainerEdit c where
Fail :: ContainerEdit c
ModContent :: Position c -> ModContent c -> ContainerEdit c
ModShape :: ModShape c -> (Shape c -> Position c -> Position c) -> ContainerEdit c
\end{code}
\end{defn}
\begin{defn}[Wirkung von container-edits]
\begin{code}
instance Container c => Module (Seq (ContainerEdit c)) where
type Domain (Seq (ContainerEdit c)) = c
apply fs = over mapped (view constructed) . flip (foldM apply') fs . view deconstructed
where
apply' :: Container c
=> (Shape c, Position c -> Content c)
-> ContainerEdit c
-> Maybe (Shape c, Position c -> Content c)
apply' _ Fail = Nothing
apply' (s, cf) (ModContent p dc) = do
c' <- dc `apply` cf p
let cf' x
| x == p = c'
| otherwise = cf x
return (s, cf')
apply' (s, cf) (ModShape ds dcf) = (, cf . dcf s) <$> ds `apply` s
initial = view constructed (initial @(ModShape c), \_ -> initial @(ModContent c))
divInit x =
let
x'@(s, cf) = x ^. deconstructed
(ds, dcf) = over _1 divInit $ over (_2.mapped) divInit x'
in
foldMap (\p -> Seq.singleton . ModContent p $ dcf p) (positions @c s) |> (ModShape ds $ const id)
\end{code}
\end{defn}
|
