From 8afbe1f7df24034dd16fdf2e89b0665b2318ae2a Mon Sep 17 00:00:00 2001 From: Gregor Kleen 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