summaryrefslogtreecommitdiff
path: root/edit-lens/src/Control/Edit/Container
diff options
context:
space:
mode:
Diffstat (limited to 'edit-lens/src/Control/Edit/Container')
-rw-r--r--edit-lens/src/Control/Edit/Container/Transducer.lhs63
1 files changed, 63 insertions, 0 deletions
diff --git a/edit-lens/src/Control/Edit/Container/Transducer.lhs b/edit-lens/src/Control/Edit/Container/Transducer.lhs
new file mode 100644
index 0000000..0173cc4
--- /dev/null
+++ b/edit-lens/src/Control/Edit/Container/Transducer.lhs
@@ -0,0 +1,63 @@
1\begin{code}
2{-# LANGUAGE TemplateHaskell #-}
3
4module Control.Edit.Container.Transducer
5 ( ContainerTransducer{..}, ctStates
6 , runCT, stepCT
7 ) where
8
9import Control.Edit.Container
10import Data.Map.Strict (Map, (!?))
11import qualified Data.Map.Strict as Map
12import Data.Set (Set)
13import qualified Data.Set as Set
14
15import Control.Monad.RWS.Strict
16
17import Control.Monad.Writer.Class
18import Control.Monad.Reader.Class
19import Control.Monad.State.Class
20
21import Control.Lens
22
23import Data.Maybe
24
25
26data ContainerTransducer state input output = ContainerTransducer
27 { ctInitialState :: state
28 , ctTransition :: Map (state, Content input) (ContainerEdits output, state)
29 -- ^ States are stable (and produce no output) by default
30 }
31
32ctStates :: Ord state => ContainerTransducer state input output -> Set state
33ctStates ContainerTransducer{..} = Map.foldrWithKey' (\(s1, _) (_, s2) -> Set.insert s1 . Set.insert s2) (Set.singleton ctInitialState) ctTransition
34
35stepCT :: ( Ord state, Ord (Content input)
36 , MonadReader (ContainerTransducer state input output) m
37 , MonadState state m
38 , MonadWriter (ContainerEdits output) m
39 ) => Content input -> m ()
40stepCT x = do
41 ContainerTransducer{ ctTransition } <- ask
42 state <- get
43 let (output, newState) = fromMaybe (mempty, state) $ ctTransition !? (state, x)
44 put newState
45 tell output
46
47runCT :: ( Ord state, Ord (Content input)
48 , FoldableContainer input
49 ) => ContainerTransducer state input output
50 -> input
51 -> ContainerEdits output
52runCT ct@ContainerTransducer{ ctInitialState } input = runRWS (forMOf_ containerContent input stepCT) ct ctInitialState ^. _3
53\end{code}
54
55\begin{code}
56
57data CTComplement state input output = CTComplement
58 {
59 }
60
61-- Define edit-lens as span
62
63\end{code}