From 8afbe1f7df24034dd16fdf2e89b0665b2318ae2a Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Tue, 19 Feb 2019 11:39:51 +0100
Subject: Stuff...
---
interactive-edit-lens/package.yaml | 1 +
interactive-edit-lens/src/Interact.hs | 4 +-
interactive-edit-lens/src/Main.hs | 185 ++++++++++++++++++++++++++++++----
3 files changed, 169 insertions(+), 21 deletions(-)
(limited to 'interactive-edit-lens')
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 ()
--
cgit v1.2.3