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
|
\begin{code}
{-# LANGUAGE TemplateHaskell #-}
module Control.Edit.Container.Transducer
( ContainerTransducer{..}, ctStates
, runCT, stepCT
) where
import Control.Edit.Container
import Data.Map.Strict (Map, (!?))
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import Control.Monad.RWS.Strict
import Control.Monad.Writer.Class
import Control.Monad.Reader.Class
import Control.Monad.State.Class
import Control.Lens
import Data.Maybe
data ContainerTransducer state input output = ContainerTransducer
{ ctInitialState :: state
, ctTransition :: Map (state, Content input) (ContainerEdits output, state)
-- ^ States are stable (and produce no output) by default
}
ctStates :: Ord state => ContainerTransducer state input output -> Set state
ctStates ContainerTransducer{..} = Map.foldrWithKey' (\(s1, _) (_, s2) -> Set.insert s1 . Set.insert s2) (Set.singleton ctInitialState) ctTransition
stepCT :: ( Ord state, Ord (Content input)
, MonadReader (ContainerTransducer state input output) m
, MonadState state m
, MonadWriter (ContainerEdits output) m
) => Content input -> m ()
stepCT x = do
ContainerTransducer{ ctTransition } <- ask
state <- get
let (output, newState) = fromMaybe (mempty, state) $ ctTransition !? (state, x)
put newState
tell output
runCT :: ( Ord state, Ord (Content input)
, FoldableContainer input
) => ContainerTransducer state input output
-> input
-> ContainerEdits output
runCT ct@ContainerTransducer{ ctInitialState } input = runRWS (forMOf_ containerContent input stepCT) ct ctInitialState ^. _3
\end{code}
\begin{code}
data CTComplement state input output = CTComplement
{
}
-- Define edit-lens as span
\end{code}
|
