From fc9bdae87b05d1d1c99265ec8b370b37422b01d4 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Wed, 20 Dec 2017 15:29:54 +0100
Subject: Work on container transducers

---
 .../src/Control/Edit/Container/Transducer.lhs      | 63 ++++++++++++++++++++++
 1 file changed, 63 insertions(+)
 create mode 100644 edit-lens/src/Control/Edit/Container/Transducer.lhs

(limited to 'edit-lens/src/Control/Edit/Container')

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 @@
+\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}
-- 
cgit v1.2.3