@@ -7,8 +7,6 @@ module Main where
8import Verify.Graphics.Vty.Output
8import Verify.Graphics.Vty.Output
10−import Data.List (intersperse)
12import Graphics.Vty hiding (resize)
10import Graphics.Vty hiding (resize)
13import Graphics.Vty.Input.Events
11import Graphics.Vty.Input.Events
14import Graphics.Vty.Input.Loop
12import Graphics.Vty.Input.Loop
@@ -22,6 +20,7 @@ import Control.Monad
23import Data.Default
21import Data.Default
24import Data.IORef
22import Data.IORef
23+import Data.List (intersperse, reverse, nubBy)
26import System.Console.Terminfo
25import System.Console.Terminfo
27import System.Posix.IO
26import System.Posix.IO
@@ -140,7 +139,9 @@ instance Show (InputBlocksUsingTable event) where
140instance Monad m => Serial m (InputBlocksUsingTable event) where
139instance Monad m => Serial m (InputBlocksUsingTable event) where
141 series = do
140 series = do
142 n :: Int <- localDepth (const maxTableSize) series
141 n :: Int <- localDepth (const maxTableSize) series
142+ return $ InputBlocksUsingTable $ \raw_table ->
143+ let table = reverse $ nubBy (\(s0,_) (s1,_) -> s0 == s1) $ reverse raw_table
143− return $ InputBlocksUsingTable $ \table -> concat (take n (selections table))
144+ in concat (take n (selections table))
145 selections [] = []
146 selections [] = []
146 selections (x:xs) = let z = selections xs in [x] : (z ++ map ((:) x) z)
147 selections (x:xs) = let z = selections xs in [x] : (z ++ map ((:) x) z)
@@ -159,7 +160,7 @@ verifyCapsSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->
159 forEachOf terminalsOfInterest $ \termName -> monadic $ do
160 forEachOf terminalsOfInterest $ \termName -> monadic $ do
160 term <- setupTerm termName
161 term <- setupTerm termName
161 let table = capsClassifyTable term keysFromCapsTable
162 let table = capsClassifyTable term keysFromCapsTable
162− inputSeq = gen table
163+ inputSeq = gen table
163 events = map snd inputSeq
164 events = map snd inputSeq
164 keydowns = map (Bytes . fst) inputSeq
165 keydowns = map (Bytes . fst) inputSeq
165 input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]
166 input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]
@@ -168,7 +169,7 @@ verifyCapsSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->
168verifySpecialSynInputToEvent :: Property IO
169verifySpecialSynInputToEvent :: Property IO
169verifySpecialSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do
170verifySpecialSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) -> monadic $ do
170 let table = specialSupportKeys
171 let table = specialSupportKeys
171− inputSeq = gen table
172+ inputSeq = gen table
172 events = map snd inputSeq
173 events = map snd inputSeq
173 keydowns = map (Bytes . fst) inputSeq
174 keydowns = map (Bytes . fst) inputSeq
174 input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]
175 input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]
@@ -179,7 +180,7 @@ verifyFullSynInputToEvent = forAll $ \(InputBlocksUsingTable gen) ->
179 forEachOf terminalsOfInterest $ \termName -> monadic $ do
180 forEachOf terminalsOfInterest $ \termName -> monadic $ do
180 term <- setupTerm termName
181 term <- setupTerm termName
181 let table = classifyTableForTerm termName term
182 let table = classifyTableForTerm termName term
182− inputSeq = gen table
183+ inputSeq = gen table
183 events = map snd inputSeq
184 events = map snd inputSeq
184 keydowns = map (Bytes . fst) inputSeq
185 keydowns = map (Bytes . fst) inputSeq
185 input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]
186 input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]
@@ -190,7 +191,7 @@ verifyFullSynInputToEvent_2x = forAll $ \(InputBlocksUsingTable gen) ->
190 forEachOf terminalsOfInterest $ \termName -> monadic $ do
191 forEachOf terminalsOfInterest $ \termName -> monadic $ do
191 term <- setupTerm termName
192 term <- setupTerm termName
192 let table = classifyTableForTerm termName term
193 let table = classifyTableForTerm termName term
193− inputSeq = gen table
194+ inputSeq = gen table
194 events = concatMap ((\s -> [s,s]) . snd) inputSeq
195 events = concatMap ((\s -> [s,s]) . snd) inputSeq
195 keydowns = map (Bytes . (\s -> s ++ s) . fst) inputSeq
196 keydowns = map (Bytes . (\s -> s ++ s) . fst) inputSeq
196 input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]
197 input = intersperse (Delay testKeyDelay) keydowns ++ [Delay testKeyDelay]