summaryrefslogtreecommitdiff
path: root/interactive-edit-lens
diff options
context:
space:
mode:
Diffstat (limited to 'interactive-edit-lens')
-rw-r--r--interactive-edit-lens/package.yaml1
-rw-r--r--interactive-edit-lens/src/Interact.hs4
-rw-r--r--interactive-edit-lens/src/Main.hs185
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:
37 - dyre 37 - dyre
38 - mtl 38 - mtl
39 - transformers 39 - transformers
40 - universe
40 41
41# ghc-options: [ -O2 ] 42# ghc-options: [ -O2 ]
42 43
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{..}
146 (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace (c l) || Seq.null (c l) then (pred l, 0) else (l - 2, 0)) 146 (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace (c l) || Seq.null (c l) then (pred l, 0) else (l - 2, 0))
147 EvKey KRight [MCtrl] -> continue $ st &?~ doMove 147 EvKey KRight [MCtrl] -> continue $ st &?~ doMove
148 (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace $ c l then (succ l, 0) else (l + 2, 0)) 148 (moveSplit isSpace $ \(c, (l, _)) -> if any isSpace $ c l then (succ l, 0) else (l + 2, 0))
149 EvKey KUp [MCtrl] -> continue $ st &?~ doMove 149 EvKey KUp [] -> continue $ st &?~ doMove
150 (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, p) else (l - 2, p)) 150 (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) || Seq.null (c l) then (pred l, p) else (l - 2, p))
151 EvKey KDown [MCtrl] -> continue $ st &?~ doMove 151 EvKey KDown [] -> continue $ st &?~ doMove
152 (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) then (succ l, p) else (l + 2, p)) 152 (moveSplit (== '\n') $ \(c, (l, p)) -> if any (== '\n') (c l) then (succ l, p) else (l + 2, p))
153 EvKey KLeft [] -> continue $ st &?~ doMove moveLeft 153 EvKey KLeft [] -> continue $ st &?~ doMove moveLeft
154 EvKey KRight [] -> continue $ st &?~ doMove moveRight 154 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
8import Control.DFST.Lens 8import Control.DFST.Lens
9import Control.DFST 9import Control.DFST
10 10
11import Control.Arrow ((&&&))
12
11import Data.Map (Map) 13import Data.Map (Map)
12import qualified Data.Map as Map 14import qualified Data.Map as Map
13 15
@@ -17,6 +19,8 @@ import qualified Data.Set as Set
17import Data.Sequence (Seq) 19import Data.Sequence (Seq)
18import qualified Data.Sequence as Seq 20import qualified Data.Sequence as Seq
19 21
22import Data.List ((\\), inits, tails)
23
20import Data.Char 24import Data.Char
21 25
22import System.Environment 26import System.Environment
@@ -24,10 +28,60 @@ import System.Exit
24 28
25import Debug.Trace 29import Debug.Trace
26 30
27data SomeDFST = forall state. (Ord state, Show state) => SomeDFST { someDFST :: DFST state Char Char } 31import Data.Universe
32
33data SomeDFST = forall state. (Ord state, Show state, Finite state) => SomeDFST { someDFST :: DFST state Char Char }
34
35data JsonContext = JCInDet | JCDict | JCDictKey | JCDictVal | JCArray | JCArrayVal | JCTop
36 deriving (Eq, Ord, Show, Read, Enum, Bounded)
37instance Universe JsonContext
38instance Finite JsonContext
28 39
29data JsonNewlState = JNUndeterminedStructure | JNOutsideStructure | JNInsideStructure | JNInsideString | JNEscape 40data JsonNewlState = JNElement JsonContext
41 | JNTrue String JsonContext | JNFalse String JsonContext | JNNull String JsonContext | JNLitEnd JsonContext
42 | JNString JsonContext | JNStringEsc Int JsonContext | JNStringEnd JsonContext
43 | JNNumberDigits Bool JsonContext | JNNumberDecimal JsonContext | JNNumberDecimalDigits Bool JsonContext | JNNumberExpSign JsonContext | JNNumberExpDigits Bool JsonContext | JNNumberEnd JsonContext
30 deriving (Eq, Ord, Show, Read) 44 deriving (Eq, Ord, Show, Read)
45instance Universe JsonNewlState where
46 universe = concat
47 [ JNElement <$> universeF
48 , JNTrue <$> inits' "true" <*> universeF
49 , JNFalse <$> inits' "false" <*> universeF
50 , JNNull <$> inits' "null" <*> universeF
51 , JNLitEnd <$> universeF
52 , JNString <$> universeF
53 , JNStringEsc <$> [0..4] <*> universeF
54 , JNStringEnd <$> universeF
55 , JNNumberDigits <$> universeF <*> universeF
56 , JNNumberDecimal <$> universeF
57 , JNNumberDecimalDigits <$> universeF <*> universeF
58 , JNNumberExpSign <$> universeF
59 , JNNumberExpDigits <$> universeF <*> universeF
60 , JNNumberEnd <$> universeF
61 ]
62 where
63 inits' xs = inits xs \\ [""]
64instance Finite JsonNewlState
65
66jsonStrEscapes :: [(Char, Seq Char)]
67jsonStrEscapes = [ ('"', "\\\"")
68 , ('\\', "\\\\")
69 , ('/', "/")
70 , ('b', "\\b")
71 , ('f', "\\f")
72 , ('n', "\\n")
73 , ('r', "\\r")
74 , ('t', "\\t")
75 ]
76
77hexDigits :: [Char]
78hexDigits = ['0'..'9'] ++ ['a'..'f']
79
80data LineBreakState = LineBreak Int
81 deriving (Eq, Ord, Show, Read)
82instance Universe LineBreakState where
83 universe = [ LineBreak n | n <- [0..80] ]
84instance Finite LineBreakState
31 85
32dfstMap :: String -> Maybe SomeDFST 86dfstMap :: String -> Maybe SomeDFST
33dfstMap "double" = Just . SomeDFST $ DFST 87dfstMap "double" = Just . SomeDFST $ DFST
@@ -46,32 +100,125 @@ dfstMap "id" = Just . SomeDFST $ DFST
46 , stAccept = Set.singleton () 100 , stAccept = Set.singleton ()
47 } 101 }
48dfstMap "alternate" = Just . SomeDFST $ DFST 102dfstMap "alternate" = Just . SomeDFST $ DFST
49 { stInitial = 0 :: Int 103 { stInitial = False
50 , stTransition = mconcat 104 , stTransition = mconcat
51 [ Map.fromList [((0, sym), (1, Seq.singleton sym)) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym] 105 [ Map.fromList [((False, sym), (True, Seq.singleton sym)) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym]
52 , Map.fromList [((1, sym), (0, Seq.fromList [toUpper sym, toUpper sym])) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym] 106 , Map.fromList [((True, sym), (False, Seq.fromList [toUpper sym, toUpper sym])) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym]
53 ] 107 ]
54 , stAccept = Set.fromList [0] 108 , stAccept = Set.fromList [False]
55 } 109 }
56dfstMap "json-newl" = Just . SomeDFST $ DFST 110dfstMap "json-newl" = Just . SomeDFST $ DFST
57 { stInitial = JNOutsideStructure 111 { stInitial = JNElement JCTop
58 , stTransition = mconcat 112 , stTransition = mconcat
59 [ Map.fromList [((jnOutside, sym), (jnOutside, Seq.empty)) | sym <- whitespace, jnOutside <- [JNOutsideStructure, JNUndeterminedStructure]] 113 [ Map.fromList [ ((st, sym), (st, Seq.empty))
60 , Map.fromList [((jnOutside, sym), (JNInsideStructure, Seq.fromList [sym, ' '])) | sym <- "[{", jnOutside <- [JNOutsideStructure, JNInsideStructure, JNUndeterminedStructure]] 114 | sym <- whitespace
61 , Map.fromList [((JNInsideStructure, sym), (JNInsideStructure, Seq.empty)) | sym <- whitespace] 115 , st <- [JNElement, JNStringEnd, JNNumberEnd, JNLitEnd] <*> universeF
62 , Map.fromList [((jnInside, sym), (JNUndeterminedStructure, Seq.fromList ['\n', sym])) | sym <- "]}", jnInside <- [JNInsideStructure, JNUndeterminedStructure]] 116 ]
63 , Map.fromList [((jnInside, ','), (JNInsideStructure, Seq.fromList "\n, ")) | jnInside <- [JNInsideStructure, JNUndeterminedStructure] ] 117 , Map.fromList [ ((JNElement ctx, '{'), (JNElement JCDict, "{ ")) | ctx <- universeF ]
64 , Map.fromList [((jnInside, ':'), (JNInsideStructure, Seq.fromList " : ")) | jnInside <- [JNInsideStructure, JNUndeterminedStructure] ] 118 , Map.fromList [ ((JNElement ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDict, JCInDet] ]
65 , Map.fromList [((jn, '"'), (JNInsideString, Seq.singleton '"')) | jn <- [JNUndeterminedStructure, JNInsideStructure]] 119 , Map.fromList [ ((JNElement ctx, '['), (JNElement JCArray, "[ ")) | ctx <- universeF ]
66 , Map.fromList [((JNInsideString, sym), (JNInsideString, Seq.singleton sym)) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ",.!?: "] 120 , Map.fromList [ ((JNElement ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArray, JCInDet] ]
67 , Map.singleton (JNInsideString, '"') (JNUndeterminedStructure, Seq.singleton '"') 121 , Map.singleton (JNElement JCInDet, ',') (JNElement JCInDet, "\n, ")
68 , Map.singleton (JNInsideString, '\\') (JNEscape, Seq.singleton '\\') 122 , Map.fromList [ ((JNElement ctx, '"'), (JNString ctx', "\"")) | (ctx, ctx') <- startElemCtxs ]
69 , Map.singleton (JNEscape, '"') (JNInsideString, Seq.singleton '"') 123 , Map.fromList [ ((JNString ctx, c), (JNString ctx, Seq.singleton c)) | ctx <- universeF, c <- map toEnum [0..255], isPrint c, c /= '"', c /= '\\' ]
124 , Map.fromList [ ((JNString ctx, '"'), (JNStringEnd ctx, "\"")) | ctx <- universeF ]
125 , Map.fromList [ ((JNStringEnd ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ]
126 , Map.singleton (JNStringEnd JCArrayVal, ',') (JNElement JCArrayVal, "\n, ")
127 , Map.singleton (JNStringEnd JCDictVal, ',') (JNElement JCDictKey, "\n, ")
128 , Map.singleton (JNStringEnd JCInDet, ',') (JNElement JCInDet, "\n, ")
129 , Map.fromList [ ((JNStringEnd ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ]
130 , Map.fromList [ ((JNStringEnd ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ]
131 , Map.fromList [ ((JNString ctx, '\\'), (JNStringEsc 0 ctx, mempty)) | ctx <- universeF ]
132 , Map.fromList [ ((JNStringEsc 0 ctx, c), (JNString ctx, res)) | ctx <- universeF, (c, res) <- jsonStrEscapes ]
133 , Map.fromList [ ((JNStringEsc 0 ctx, 'u'), (JNStringEsc 1 ctx, "\\u")) | ctx <- universeF ]
134 , 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] ]
135 , Map.fromList [ ((JNStringEsc 4 ctx, c'), (JNString ctx, Seq.singleton c)) | ctx <- universeF, c <- hexDigits, c' <- [toLower c, toUpper c]]
136 , mconcat $ do
137 (lit@(l:_), st) <- literals
138 id
139 [ Map.fromList [ ((JNElement ctx, l'), (st (pure l) ctx', Seq.singleton l))
140 | l' <- [toLower l, toUpper l]
141 , (ctx, ctx') <- startElemCtxs
142 ]
143 , Map.fromList [ ((st i ctx, r'), (st (i ++ [r]) ctx, Seq.singleton r))
144 | (i, t@(r:rs)) <- uncurry zip $ (inits &&& tails) lit
145 , i /= []
146 , r' <- [toLower r, toUpper r]
147 , ctx <- [JCInDet, JCDictKey, JCDictVal, JCArrayVal, JCTop]
148 ]
149 , Map.fromList [ ((st lit ctx, ':'), (JNElement JCDictVal, " : "))
150 | ctx <- [JCDictKey, JCInDet]
151 ]
152 , Map.fromList [ ((st lit ctx, ','), (JNElement JCArrayVal, "\n, "))
153 | ctx <- [JCArrayVal, JCInDet]
154 ]
155 , Map.fromList [ ((st lit ctx, ','), (JNElement JCDictKey, "\n, "))
156 | ctx <- [JCDictVal, JCInDet]
157 ]
158 , Map.singleton (st lit JCInDet, ',') (JNElement JCInDet, "\n, ")
159 , Map.fromList [ ((st lit ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ]
160 , Map.fromList [ ((st lit ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ]
161 , Map.fromList [ ((st lit ctx, sym), (JNLitEnd ctx, Seq.empty)) | ctx <- universeF, sym <- whitespace ]
162 ]
163 , Map.fromList [ ((JNLitEnd ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ]
164 , Map.fromList [ ((JNLitEnd ctx, ','), (JNElement JCArrayVal, "\n, ")) | ctx <- [JCArrayVal, JCInDet] ]
165 , Map.fromList [ ((JNLitEnd ctx, ','), (JNElement JCDictKey, "\n, ")) | ctx <- [JCDictVal, JCInDet] ]
166 , Map.fromList [ ((JNLitEnd ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ]
167 , Map.fromList [ ((JNLitEnd ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ]
168 , Map.fromList [ ((JNElement ctx, '-'), (JNNumberDigits False ctx', "-")) | (ctx, ctx') <- startElemCtxs ]
169 , Map.fromList [ ((JNElement ctx, '0'), (JNNumberDecimal ctx', "0")) | (ctx, ctx') <- startElemCtxs ]
170 , Map.fromList [ ((JNElement ctx, dgt), (JNNumberDigits True ctx', Seq.singleton dgt)) | (ctx, ctx') <- startElemCtxs, dgt <- ['1'..'9'] ]
171 , Map.fromList [ ((JNNumberDigits True ctx, '0'), (JNNumberDigits True ctx, "0")) | ctx <- universeF ]
172 , Map.fromList [ ((JNNumberDigits b ctx, dgt), (JNNumberDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['1'..'9'], b <- universeF ]
173 , Map.fromList [ ((JNNumberDigits True ctx, '.'), (JNNumberDecimalDigits False ctx, ".")) | ctx <- universeF ]
174 , Map.fromList [ ((JNNumberDecimal ctx, '.'), (JNNumberDecimalDigits False ctx, ".")) | ctx <- universeF ]
175 , Map.fromList [ ((JNNumberDecimalDigits b ctx, dgt), (JNNumberDecimalDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['0'..'9'], b <- universeF ]
176 , Map.fromList [ ((JNNumberDecimalDigits True ctx, e), (JNNumberExpSign ctx, "e")) | ctx <- universeF, e <- "eE" ]
177 , Map.fromList [ ((JNNumberDigits True ctx, e), (JNNumberExpSign ctx, "e")) | ctx <- universeF, e <- "eE" ]
178 , Map.fromList [ ((JNNumberDecimal ctx, e), (JNNumberExpSign ctx, "e")) | ctx <- universeF, e <- "eE" ]
179 , Map.fromList [ ((JNNumberExpSign ctx, sgn), (JNNumberExpDigits False ctx, Seq.singleton sgn)) | ctx <- universeF, sgn <- "+-" ]
180 , Map.fromList [ ((JNNumberExpSign ctx, dgt), (JNNumberExpDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['0'..'9'] ]
181 , Map.fromList [ ((JNNumberExpDigits b ctx, dgt), (JNNumberExpDigits True ctx, Seq.singleton dgt)) | ctx <- universeF, dgt <- ['0'..'9'], b <- universeF ]
182 , mconcat $ do
183 end <- [ JNNumberExpDigits True, JNNumberDecimal, JNNumberDigits True, JNNumberDecimalDigits True ]
184 id
185 [ Map.fromList [ ((end ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ]
186 , Map.singleton (end JCArrayVal, ',') (JNElement JCArrayVal, "\n, ")
187 , Map.singleton (end JCDictVal, ',') (JNElement JCDictKey, "\n, ")
188 , Map.singleton (end JCInDet, ',') (JNElement JCInDet, "\n, ")
189 , Map.fromList [ ((end ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ]
190 , Map.fromList [ ((end ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ]
191 , Map.fromList [ ((end ctx, sym), (JNNumberEnd ctx, Seq.empty)) | ctx <- universeF, sym <- whitespace ]
192 ]
193 , Map.fromList [ ((JNNumberEnd ctx, ':'), (JNElement JCDictVal, " : ")) | ctx <- [JCDictKey, JCInDet] ]
194 , Map.singleton (JNNumberEnd JCArrayVal, ',') (JNElement JCArrayVal, "\n, ")
195 , Map.singleton (JNNumberEnd JCDictVal, ',') (JNElement JCDictKey, "\n, ")
196 , Map.singleton (JNNumberEnd JCInDet, ',') (JNElement JCInDet, "\n, ")
197 , Map.fromList [ ((JNNumberEnd ctx, '}'), (JNElement JCInDet, "\n}\n")) | ctx <- [JCDictVal, JCInDet] ]
198 , Map.fromList [ ((JNNumberEnd ctx, ']'), (JNElement JCInDet, "\n]\n")) | ctx <- [JCArrayVal, JCInDet] ]
70 ] 199 ]
71 , stAccept = Set.fromList [JNOutsideStructure, JNUndeterminedStructure] 200 , stAccept = Set.fromList $ do
201 end <- endStates
202 ctx <- [JCTop, JCInDet]
203 return $ end ctx
72 } 204 }
73 where 205 where
206 startElemCtxs = map (\x -> (x, x)) [JCInDet, JCDictKey, JCDictVal, JCArrayVal, JCTop] ++ [(JCArray, JCArrayVal), (JCDict, JCDictKey)]
207 literals = [ ("true", JNTrue), ("false", JNFalse), ("null", JNNull) ]
74 whitespace = toEnum <$> [0x0020, 0x0009, 0x000a, 0x000d] 208 whitespace = toEnum <$> [0x0020, 0x0009, 0x000a, 0x000d]
209
210 endStates = [JNElement, JNStringEnd, JNNumberExpDigits True, JNNumberDecimal, JNNumberDigits True, JNNumberDecimalDigits True] ++ [ st lit | (lit, st) <- literals]
211dfstMap "linebreak" = Just . SomeDFST $ DFST
212 { stInitial = LineBreak 0
213 , stTransition = mconcat
214 [ Map.fromList [ ((LineBreak n, sym), (LineBreak $ succ n, Seq.singleton sym)) | n <- [0..79], sym <- map toEnum [0..255], isPrint sym, sym /= '\n' ]
215 , Map.fromList [ ((LineBreak n, '\n'), (LineBreak $ succ n, Seq.singleton ' ')) | n <- [0..79] ]
216 , Map.singleton (LineBreak 80, ' ') (LineBreak 0, Seq.singleton '\n')
217 , Map.singleton (LineBreak 80, '\n') (LineBreak 0, Seq.singleton '\n')
218 , Map.fromList [ ((LineBreak 80, sym), (LineBreak 80, Seq.singleton sym)) | sym <- map toEnum [0..255], isPrint sym, sym /= ' ', sym /= '\n' ]
219 ]
220 , stAccept = Set.fromList universeF
221 }
75dfstMap _ = Nothing 222dfstMap _ = Nothing
76 223
77main :: IO () 224main :: IO ()