Stuff...

3 files changed, 169 insertions, 21 deletions

diff --git a/interactive-edit-lens/package.yaml b/interactive-edit-lens/package.yaml
index 9bc3ead..95e2464 100644
--- a/interactive-edit-lens/package.yaml
+++ b/interactive-edit-lens/package.yaml
@@ -37,6 +37,7 @@ dependencies:
   - dyre
   - mtl
   - transformers
+  - universe
 
 # ghc-options: [ -O2 ]
 
diff --git a/interactive-edit-lens/src/Interact.hs b/interactive-edit-lens/src/Interact.hs
index 3aab5c2..0074e86 100644
--- a/interactive-edit-lens/src/Interact.hs
+++ b/interactive-edit-lens/src/Interact.hs
@@ -146,9 +146,9 @@ interactiveEditLens' cfg@InteractConfig{..}
         (moveSplit isSpace   $ \(c, (l, _)) -> if any isSpace (c l) || Seq.null (c l) then (pred l, 0) else (l - 2, 0))
       EvKey  KRight      [MCtrl] -> continue $ st &?~ doMove
         (moveSplit isSpace   $ \(c, (l, _)) -> if any isSpace $ c l then (succ l, 0) else (l + 2, 0))
-      EvKey  KUp         [MCtrl] -> continue $ st &?~ doMove
+      EvKey  KUp         []      -> continue $ st &?~ doMove
         (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, p) else (l - 2, p))
-      EvKey  KDown       [MCtrl] -> continue $ st &?~ doMove
+      EvKey  KDown       []      -> continue $ st &?~ doMove
         (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) then (succ l, p) else (l + 2, p))
       EvKey  KLeft       []      -> continue $ st &?~ doMove moveLeft
       EvKey  KRight      []      -> continue $ st &?~ doMove moveRight
diff --git a/interactive-edit-lens/src/Main.hs b/interactive-edit-lens/src/Main.hs
index f7bc806..83c9725 100644
--- a/interactive-edit-lens/src/Main.hs
+++ b/interactive-edit-lens/src/Main.hs
@@ -8,6 +8,8 @@ import Interact
 import Control.DFST.Lens
 import Control.DFST
 
+import Control.Arrow ((&&&))
+
 import Data.Map (Map)
 import qualified Data.Map as Map
 
@@ -17,6 +19,8 @@ import qualified Data.Set as Set
 import Data.Sequence (Seq)
 import qualified Data.Sequence as Seq
 
+import Data.List ((\\), inits, tails)
+
 import Data.Char
 
 import System.Environment
@@ -24,10 +28,60 @@ import System.Exit
 
 import Debug.Trace
 
-data SomeDFST = forall state. (Ord state, Show state) => SomeDFST { someDFST :: DFST state Char Char }
+import Data.Universe
+
+data SomeDFST = forall state. (Ord state, Show state, Finite state) => SomeDFST { someDFST :: DFST state Char Char }
+
+data JsonContext = JCInDet | JCDict | JCDictKey | JCDictVal | JCArray | JCArrayVal | JCTop
+  deriving (Eq, Ord, Show, Read, Enum, Bounded)
+instance Universe JsonContext
+instance Finite JsonContext
 
-data JsonNewlState = JNUndeterminedStructure | JNOutsideStructure | JNInsideStructure | JNInsideString | JNEscape
+data JsonNewlState = JNElement JsonContext
+                   | JNTrue String JsonContext | JNFalse String JsonContext | JNNull String JsonContext | JNLitEnd JsonContext
+                   | JNString JsonContext | JNStringEsc Int JsonContext | JNStringEnd JsonContext
+                   | JNNumberDigits Bool JsonContext | JNNumberDecimal JsonContext | JNNumberDecimalDigits Bool JsonContext | JNNumberExpSign JsonContext | JNNumberExpDigits Bool JsonContext | JNNumberEnd JsonContext
   deriving (Eq, Ord, Show, Read)
+instance Universe JsonNewlState where
+  universe = concat
+    [ JNElement <$> universeF
+    , JNTrue <$> inits' "true" <*> universeF
+    , JNFalse <$> inits' "false" <*> universeF
+    , JNNull <$> inits' "null" <*> universeF
+    , JNLitEnd <$> universeF
+    , JNString <$> universeF
+    , JNStringEsc <$> [0..4] <*> universeF
+    , JNStringEnd <$> universeF
+    , JNNumberDigits <$> universeF <*> universeF
+    , JNNumberDecimal <$> universeF
+    , JNNumberDecimalDigits <$> universeF <*> universeF
+    , JNNumberExpSign <$> universeF
+    , JNNumberExpDigits <$> universeF <*> universeF
+    , JNNumberEnd <$> universeF
+    ]
+    where
+      inits' xs = inits xs \\ [""]
+instance Finite JsonNewlState
+
+jsonStrEscapes :: [(Char, Seq Char)]
+jsonStrEscapes = [ ('"', "\\\"")
+                 , ('\\', "\\\\")
+                 , ('/', "/")
+                 , ('b', "\\b")
+                 , ('f', "\\f")
+                 , ('n', "\\n")
+                 , ('r', "\\r")
+                 , ('t', "\\t")
+                 ]
+
+hexDigits :: [Char]
+hexDigits = ['0'..'9'] ++ ['a'..'f']
+
+data LineBreakState = LineBreak Int
+  deriving (Eq, Ord, Show, Read)
+instance Universe LineBreakState where
+  universe = [ LineBreak n | n <- [0..80] ]
+instance Finite LineBreakState
 
 dfstMap :: String -> Maybe SomeDFST
 dfstMap "double" = Just . SomeDFST $ DFST
@@ -46,32 +100,125 @@ dfstMap "id" = Just . SomeDFST $ DFST
   , stAccept = Set.singleton ()
   }
 dfstMap "alternate" = Just . SomeDFST $ DFST
-  { stInitial = 0 :: Int
+  { stInitial = False
   , stTransition = mconcat
-    [ Map.fromList [((0, sym), (1, Seq.singleton sym)) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym]
-    , Map.fromList [((1, sym), (0, Seq.fromList [toUpper sym, toUpper sym])) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym]
+    [ Map.fromList [((False, sym), (True, Seq.singleton sym)) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym]
+    , Map.fromList [((True, sym), (False, Seq.fromList [toUpper sym, toUpper sym])) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym]
     ]
-  , stAccept = Set.fromList [0]
+  , stAccept = Set.fromList [False]
   }
 dfstMap "json-newl" = Just . SomeDFST $ DFST
-  { stInitial = JNOutsideStructure
+  { stInitial = JNElement JCTop
   , stTransition = mconcat
-    [ Map.fromList [((jnOutside, sym), (jnOutside, Seq.empty)) | sym <- whitespace, jnOutside <- [JNOutsideStructure, JNUndeterminedStructure]]
-    , Map.fromList [((jnOutside, sym), (JNInsideStructure, Seq.fromList [sym, ' '])) | sym <- "[{", jnOutside <- [JNOutsideStructure, JNInsideStructure, JNUndeterminedStructure]]
-    , Map.fromList [((JNInsideStructure, sym), (JNInsideStructure, Seq.empty)) | sym <- whitespace]
-    , Map.fromList [((jnInside, sym), (JNUndeterminedStructure, Seq.fromList ['\n', sym])) | sym <- "]}", jnInside <- [JNInsideStructure, JNUndeterminedStructure]]
-    , Map.fromList [((jnInside, ','), (JNInsideStructure, Seq.fromList "\n, ")) | jnInside <- [JNInsideStructure, JNUndeterminedStructure] ]
-    , Map.fromList [((jnInside, ':'), (JNInsideStructure, Seq.fromList " : ")) | jnInside <- [JNInsideStructure, JNUndeterminedStructure] ]
-    , Map.fromList [((jn, '"'), (JNInsideString, Seq.singleton '"')) | jn <- [JNUndeterminedStructure, JNInsideStructure]]
-    , Map.fromList [((JNInsideString, sym), (JNInsideString, Seq.singleton sym)) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ",.!?: "]
-    , Map.singleton (JNInsideString, '"') (JNUndeterminedStructure, Seq.singleton '"')
-    , Map.singleton (JNInsideString, '\\') (JNEscape, Seq.singleton '\\')
-    , Map.singleton (JNEscape, '"') (JNInsideString, Seq.singleton '"')
+    [ Map.fromList [ ((st, sym), (st, Seq.empty))
+                   | sym <- whitespace
+                   , st <- [JNElement, JNStringEnd, JNNumberEnd, JNLitEnd] <*> universeF
+                   ]
+    , Map.fromList [ ((JNElement ctx, '{'), (JNElement JCDict, "{ ")) | ctx <- universeF ]
+    , Map.fromList [ ((JNElement ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDict, JCInDet] ]
+    , Map.fromList [ ((JNElement ctx, '['), (JNElement JCArray, "[ ")) | ctx <- universeF ]
+    , Map.fromList [ ((JNElement ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArray, JCInDet] ]
+    , Map.singleton (JNElement JCInDet, ',') (JNElement JCInDet, "\n, ")
+    , Map.fromList [ ((JNElement ctx, '"'), (JNString ctx', "\"")) | (ctx, ctx') <- startElemCtxs ]
+    , Map.fromList [ ((JNString ctx, c), (JNString ctx, Seq.singleton c)) | ctx <- universeF, c <- map toEnum [0..255], isPrint c, c /= '"', c /= '\\' ]
+    , Map.fromList [ ((JNString ctx, '"'), (JNStringEnd ctx, "\"")) | ctx <- universeF ]
+    , Map.fromList [ ((JNStringEnd ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ]
+    , Map.singleton (JNStringEnd JCArrayVal, ',') (JNElement JCArrayVal, "\n, ")
+    , Map.singleton (JNStringEnd JCDictVal, ',') (JNElement JCDictKey, "\n, ")
+    , Map.singleton (JNStringEnd JCInDet, ',') (JNElement JCInDet, "\n, ")
+    , Map.fromList [ ((JNStringEnd ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ]
+    , Map.fromList [ ((JNStringEnd ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ]
+    , Map.fromList [ ((JNString ctx, '\\'), (JNStringEsc 0 ctx, mempty)) | ctx <- universeF ]
+    , Map.fromList [ ((JNStringEsc 0 ctx, c), (JNString ctx, res)) | ctx <- universeF, (c, res) <- jsonStrEscapes ]
+    , Map.fromList [ ((JNStringEsc 0 ctx, 'u'), (JNStringEsc 1 ctx, "\\u")) | ctx <- universeF ]
+    , Map.fromList [ ((JNStringEsc n ctx, c'), (JNStringEsc (succ n) ctx, Seq.singleton c)) | ctx <- universeF, c <- hexDigits, c' <- [toLower c, toUpper c], n <- [1..3] ]
+    , Map.fromList [ ((JNStringEsc 4 ctx, c'), (JNString ctx, Seq.singleton c)) | ctx <- universeF, c <- hexDigits, c' <- [toLower c, toUpper c]]
+    , mconcat $ do
+        (lit@(l:_), st) <- literals
+        id
+          [ Map.fromList [ ((JNElement ctx, l'), (st (pure l) ctx', Seq.singleton l))
+                         | l' <- [toLower l, toUpper l]
+                         , (ctx, ctx') <- startElemCtxs
+                         ]
+          , Map.fromList [ ((st i ctx, r'), (st (i ++ [r]) ctx, Seq.singleton r))
+                         | (i, t@(r:rs)) <- uncurry zip $ (inits &&& tails) lit
+                         , i /= []
+                         , r' <- [toLower r, toUpper r]
+                         , ctx <- [JCInDet, JCDictKey, JCDictVal, JCArrayVal, JCTop]
+                         ]
+          , Map.fromList [ ((st lit ctx, ':'), (JNElement JCDictVal, " : "))
+                         | ctx <- [JCDictKey, JCInDet]
+                         ]
+          , Map.fromList [ ((st lit ctx, ','), (JNElement JCArrayVal, "\n, "))
+                         | ctx <- [JCArrayVal, JCInDet]
+                         ]
+          , Map.fromList [ ((st lit ctx, ','), (JNElement JCDictKey, "\n, "))
+                        | ctx <- [JCDictVal, JCInDet]
+                         ]
+          , Map.singleton (st lit JCInDet, ',') (JNElement JCInDet, "\n, ")
+          , Map.fromList [ ((st lit ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ]
+          , Map.fromList [ ((st lit ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ]
+          , Map.fromList [ ((st lit ctx, sym), (JNLitEnd ctx, Seq.empty)) | ctx <- universeF, sym <- whitespace ]
+          ]
+    , Map.fromList [ ((JNLitEnd ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ]
+    , Map.fromList [ ((JNLitEnd ctx, ','), (JNElement JCArrayVal, "\n, ")) | ctx <- [JCArrayVal, JCInDet] ]
+    , Map.fromList [ ((JNLitEnd ctx, ','), (JNElement JCDictKey, "\n, ")) | ctx <- [JCDictVal, JCInDet] ]
+    , Map.fromList [ ((JNLitEnd ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ]
+    , Map.fromList [ ((JNLitEnd ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ]
+    , Map.fromList [ ((JNElement ctx, '-'), (JNNumberDigits False ctx', "-")) | (ctx, ctx') <- startElemCtxs ]
+    , Map.fromList [ ((JNElement ctx, '0'), (JNNumberDecimal ctx', "0")) | (ctx, ctx') <- startElemCtxs ]
+    , Map.fromList [ ((JNElement ctx, dgt), (JNNumberDigits True ctx', Seq.singleton dgt)) | (ctx, ctx') <- startElemCtxs, dgt <- ['1'..'9'] ]
+    , Map.fromList [ ((JNNumberDigits True ctx, '0'), (JNNumberDigits True ctx, "0")) | ctx <- universeF ]
+    , Map.fromList [ ((JNNumberDigits b ctx, dgt), (JNNumberDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['1'..'9'], b <- universeF ]
+    , Map.fromList [ ((JNNumberDigits True ctx, '.'), (JNNumberDecimalDigits False ctx, ".")) | ctx <- universeF ]
+    , Map.fromList [ ((JNNumberDecimal ctx, '.'), (JNNumberDecimalDigits False ctx, ".")) | ctx <- universeF ]
+    , Map.fromList [ ((JNNumberDecimalDigits b ctx, dgt), (JNNumberDecimalDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['0'..'9'], b <- universeF ]
+    , Map.fromList [ ((JNNumberDecimalDigits True ctx, e), (JNNumberExpSign ctx, "e")) | ctx <- universeF, e <- "eE" ]
+    , Map.fromList [ ((JNNumberDigits True ctx, e), (JNNumberExpSign ctx, "e")) | ctx <- universeF, e <- "eE" ]
+    , Map.fromList [ ((JNNumberDecimal ctx, e), (JNNumberExpSign ctx, "e")) | ctx <- universeF, e <- "eE" ]
+    , Map.fromList [ ((JNNumberExpSign ctx, sgn), (JNNumberExpDigits False ctx, Seq.singleton sgn)) | ctx <- universeF, sgn <- "+-" ]
+    , Map.fromList [ ((JNNumberExpSign ctx, dgt), (JNNumberExpDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['0'..'9'] ]
+    , Map.fromList [ ((JNNumberExpDigits b ctx, dgt), (JNNumberExpDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['0'..'9'], b <- universeF ]
+    , mconcat $ do
+        end <- [ JNNumberExpDigits True, JNNumberDecimal, JNNumberDigits True, JNNumberDecimalDigits True ]
+        id
+          [ Map.fromList [ ((end ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ]
+          , Map.singleton (end JCArrayVal, ',') (JNElement JCArrayVal, "\n, ")
+          , Map.singleton (end JCDictVal, ',') (JNElement JCDictKey, "\n, ")
+          , Map.singleton (end JCInDet, ',') (JNElement JCInDet, "\n, ")
+          , Map.fromList [ ((end ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ]
+          , Map.fromList [ ((end ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ]
+          , Map.fromList [ ((end ctx, sym), (JNNumberEnd ctx, Seq.empty)) | ctx <- universeF, sym <- whitespace ]
+          ]
+    , Map.fromList [ ((JNNumberEnd ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ]
+    , Map.singleton (JNNumberEnd JCArrayVal, ',') (JNElement JCArrayVal, "\n, ")
+    , Map.singleton (JNNumberEnd JCDictVal, ',') (JNElement JCDictKey, "\n, ")
+    , Map.singleton (JNNumberEnd JCInDet, ',') (JNElement JCInDet, "\n, ")
+    , Map.fromList [ ((JNNumberEnd ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ]
+    , Map.fromList [ ((JNNumberEnd ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ]
     ]
-  , stAccept = Set.fromList [JNOutsideStructure, JNUndeterminedStructure]
+  , stAccept = Set.fromList $ do
+      end <- endStates
+      ctx <- [JCTop, JCInDet]
+      return $ end ctx
   }
   where
+    startElemCtxs = map (\x -> (x, x)) [JCInDet, JCDictKey, JCDictVal, JCArrayVal, JCTop] ++ [(JCArray, JCArrayVal), (JCDict, JCDictKey)]
+    literals = [ ("true", JNTrue), ("false", JNFalse), ("null", JNNull) ]
     whitespace = toEnum <$> [0x0020, 0x0009, 0x000a, 0x000d]
+
+    endStates = [JNElement, JNStringEnd, JNNumberExpDigits True, JNNumberDecimal, JNNumberDigits True, JNNumberDecimalDigits True] ++ [ st lit | (lit, st) <- literals]
+dfstMap "linebreak" = Just . SomeDFST $ DFST
+  { stInitial = LineBreak 0
+  , stTransition = mconcat
+    [ Map.fromList [ ((LineBreak n, sym), (LineBreak $ succ n, Seq.singleton sym)) | n <- [0..79], sym <- map toEnum [0..255], isPrint sym, sym /= '\n' ]
+    , Map.fromList [ ((LineBreak n, '\n'), (LineBreak $ succ n, Seq.singleton ' ')) | n <- [0..79] ]
+    , Map.singleton (LineBreak 80, ' ') (LineBreak 0, Seq.singleton '\n')
+    , Map.singleton (LineBreak 80, '\n') (LineBreak 0, Seq.singleton '\n')
+    , Map.fromList [ ((LineBreak 80, sym), (LineBreak 80, Seq.singleton sym)) | sym <- map toEnum [0..255], isPrint sym, sym /= ' ', sym /= '\n' ]
+    ]
+  , stAccept = Set.fromList universeF
+  }
 dfstMap _ = Nothing
 
 main :: IO ()