From 529d127667a366f306f975b3ed34e8a118f3cefc Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Sun, 4 Feb 2018 17:39:46 +0100
Subject: Define DFSTs

---
 edit-lens/package.yaml            |  4 +++-
 edit-lens/src/Data/String/DFST.hs | 38 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 41 insertions(+), 1 deletion(-)
 create mode 100644 edit-lens/src/Data/String/DFST.hs

(limited to 'edit-lens')

diff --git a/edit-lens/package.yaml b/edit-lens/package.yaml
index db1f021..5e8c2d2 100644
--- a/edit-lens/package.yaml
+++ b/edit-lens/package.yaml
@@ -23,8 +23,10 @@ library:
   dependencies:
     - base
     - lens
+    - containers
   exposed-modules:
     - Control.Edit
-    - Control.Edit.Tree
+    - Data.String.DFST
     - Control.Lens.Edit
+    
   
diff --git a/edit-lens/src/Data/String/DFST.hs b/edit-lens/src/Data/String/DFST.hs
new file mode 100644
index 0000000..8a22dd3
--- /dev/null
+++ b/edit-lens/src/Data/String/DFST.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE RecordWildCards
+           , PatternGuards
+           , ScopedTypeVariables
+#-}
+
+{-|
+Description: Deterministic finite state transducers
+-}
+module Data.String.DFST
+  ( DFST(..)
+  , runDFST
+  ) where
+
+import Data.Map.Strict (Map, (!?))
+import qualified Data.Map.Strict as Map
+
+import Data.Set (Set)
+import qualified Data.Set as Set
+
+data DFST state = DFST
+  { stInitial :: state
+  , stTransition :: Map (state, Char) (state, Maybe Char)
+    -- ^ All @(s, c)@-combinations not mapped are assumed to map to @(s, Nothing)@
+  , stAccept :: Set state
+  }
+  
+runDFST :: forall state. Ord state => DFST state -> String -> Maybe String
+runDFST DFST{..} str = ($ []) <$> go stInitial str id
+  where
+    go :: state -> String -> (String -> String) -> Maybe (String -> String)
+    go st [] acc
+      | st `Set.member` stAccept = Just acc
+      | otherwise = Nothing
+    go st (c:cs) acc
+      | Just (st', mc') <- stTransition !? (st, c)
+      = go st' cs $ acc . maybe id (:) mc'
+      | otherwise
+      = go st cs acc
-- 
cgit v1.2.3