summaryrefslogtreecommitdiff
path: root/interactive-edit-lens/src/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'interactive-edit-lens/src/Main.hs')
-rw-r--r--interactive-edit-lens/src/Main.hs94
1 files changed, 94 insertions, 0 deletions
diff --git a/interactive-edit-lens/src/Main.hs b/interactive-edit-lens/src/Main.hs
new file mode 100644
index 0000000..f7bc806
--- /dev/null
+++ b/interactive-edit-lens/src/Main.hs
@@ -0,0 +1,94 @@
1{-# LANGUAGE OverloadedStrings
2 , ExistentialQuantification
3 #-}
4
5module Main where
6
7import Interact
8import Control.DFST.Lens
9import Control.DFST
10
11import Data.Map (Map)
12import qualified Data.Map as Map
13
14import Data.Set (Set)
15import qualified Data.Set as Set
16
17import Data.Sequence (Seq)
18import qualified Data.Sequence as Seq
19
20import Data.Char
21
22import System.Environment
23import System.Exit
24
25import Debug.Trace
26
27data SomeDFST = forall state. (Ord state, Show state) => SomeDFST { someDFST :: DFST state Char Char }
28
29data JsonNewlState = JNUndeterminedStructure | JNOutsideStructure | JNInsideStructure | JNInsideString | JNEscape
30 deriving (Eq, Ord, Show, Read)
31
32dfstMap :: String -> Maybe SomeDFST
33dfstMap "double" = Just . SomeDFST $ DFST
34 { stInitial = ()
35 , stTransition = mconcat
36 [ Map.fromList
37 [(((), sym), ((), Seq.fromList [sym, sym])) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym]
38 , Map.singleton ((), '\n') ((), Seq.singleton '\n')
39 ]
40 , stAccept = Set.singleton ()
41 }
42dfstMap "id" = Just . SomeDFST $ DFST
43 { stInitial = ()
44 , stTransition = Map.fromList
45 [(((), sym), ((), Seq.singleton sym)) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ['!', ' ']] -- sym <- [minBound..maxBound], isPrint sym]
46 , stAccept = Set.singleton ()
47 }
48dfstMap "alternate" = Just . SomeDFST $ DFST
49 { stInitial = 0 :: Int
50 , stTransition = mconcat
51 [ Map.fromList [((0, sym), (1, 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]
53 ]
54 , stAccept = Set.fromList [0]
55 }
56dfstMap "json-newl" = Just . SomeDFST $ DFST
57 { stInitial = JNOutsideStructure
58 , stTransition = mconcat
59 [ Map.fromList [((jnOutside, sym), (jnOutside, Seq.empty)) | sym <- whitespace, jnOutside <- [JNOutsideStructure, JNUndeterminedStructure]]
60 , Map.fromList [((jnOutside, sym), (JNInsideStructure, Seq.fromList [sym, ' '])) | sym <- "[{", jnOutside <- [JNOutsideStructure, JNInsideStructure, JNUndeterminedStructure]]
61 , Map.fromList [((JNInsideStructure, sym), (JNInsideStructure, Seq.empty)) | sym <- whitespace]
62 , Map.fromList [((jnInside, sym), (JNUndeterminedStructure, Seq.fromList ['\n', sym])) | sym <- "]}", jnInside <- [JNInsideStructure, JNUndeterminedStructure]]
63 , Map.fromList [((jnInside, ','), (JNInsideStructure, Seq.fromList "\n, ")) | jnInside <- [JNInsideStructure, JNUndeterminedStructure] ]
64 , Map.fromList [((jnInside, ':'), (JNInsideStructure, Seq.fromList " : ")) | jnInside <- [JNInsideStructure, JNUndeterminedStructure] ]
65 , Map.fromList [((jn, '"'), (JNInsideString, Seq.singleton '"')) | jn <- [JNUndeterminedStructure, JNInsideStructure]]
66 , Map.fromList [((JNInsideString, sym), (JNInsideString, Seq.singleton sym)) | sym <- ['a'..'z'] ++ ['A'..'Z'] ++ ",.!?: "]
67 , Map.singleton (JNInsideString, '"') (JNUndeterminedStructure, Seq.singleton '"')
68 , Map.singleton (JNInsideString, '\\') (JNEscape, Seq.singleton '\\')
69 , Map.singleton (JNEscape, '"') (JNInsideString, Seq.singleton '"')
70 ]
71 , stAccept = Set.fromList [JNOutsideStructure, JNUndeterminedStructure]
72 }
73 where
74 whitespace = toEnum <$> [0x0020, 0x0009, 0x000a, 0x000d]
75dfstMap _ = Nothing
76
77main :: IO ()
78main = do
79 args <- getArgs
80
81 dfst <- case args of
82 [name] | Just dfst <- dfstMap name
83 -> return dfst
84 _ -> exitWith $ ExitFailure 2
85
86 interactiveEditLens' dfst
87
88interactiveEditLens' :: SomeDFST -> IO ()
89interactiveEditLens' (SomeDFST dfst)
90 = interactiveEditLens id $ InteractConfig
91 { icfgInitial = InitialEmpty
92 , icfgLens = dfstLens dfst
93 , icfgCompileError = Nothing
94 }