module UI.EditorSpec where import qualified Data.List as DL import qualified Data.Vector.Mutable as MV import System.Console.ANSI (Color(..)) import Test.Hspec import Test.Hspec.Hedgehog import "spade" Common import Compiler.Lexer import Compiler.Parser (tokenize) import qualified Data.Text as T import qualified Data.Text.IO as T import Hedgehog.Gen (int, list) import Hedgehog.Range (linear) import UI.Widgets.Common as C import UI.Widgets.Editor import UI.Widgets.Editor.Cursor data ReferenceScreenState = ReferenceScreenState { rssLines :: [[StyledText]] , rssCursorInfo :: CursorInfo } assertReferenceScreenState :: ReferenceScreenState -> WRef EditorWidget -> WidgetM IO () assertReferenceScreenState ReferenceScreenState {..} ewRef = do EditorWidget {..} <- readWRef ewRef ss <- wsScreenState <$> get let linesRef = (ssLines ss) lines' <- MV.foldr'(:) [] linesRef liftIO $ if lines' == rssLines then do T.putStrLn $ "Got expected screen\n" <> (renderLines rssLines) else expectationFailure $ "Screens differ, expected:\n" <> (T.unpack $ renderLines rssLines) <> "\nBut got\n" <> (T.unpack $ renderLines lines') <> "\n" <> show lines' liftIO $ ewCursorInfo `shouldBe` rssCursorInfo testEditor :: Text -> [KeyEvent] -> ReferenceScreenState -> Expectation testEditor content kEvents expectedSs = do runWidgetM $ do csInitialize $ Dimensions 18 10 ewRef <- editor (\_ -> pure []) Nothing modifyWRef ewRef (\ew -> ew { ewPos = ScreenPos 0 0, ewDim = Dimensions 18 10, ewContent = content }) csClear mapM_ (handleInput ewRef) kEvents draw ewRef csDraw assertReferenceScreenState expectedSs ewRef mkKeys :: Int -> CtrlKey -> [KeyEvent] mkKeys count' ctrlKey = DL.take count' $ DL.repeat (KeyCtrl False False False ctrlKey) mkCharKeys :: Int -> Char -> [KeyEvent] mkCharKeys count' c = DL.take count' $ DL.repeat (KeyChar False False False c) spec :: Spec spec = do modifyMaxSuccess (const 100) $ describe "Screenpos round tripping" $ it "has consitent behavior" $ hedgehog $ do lineWidths <- forAll (list (linear 0 5) (int (linear 0 10))) offset <- forAll (int (linear 0 10)) -- liftIO $ putStrLn $ show (lineWidths, offset) case offsetToScreenPos 5 lineWidths offset of Just (sp, _) -> case screenPosToOffset lineWidths 5 sp of Just (offset', _, _) -> do footnote $ "Failed data: " <> (show lineWidths) (offset === offset') Nothing -> pure () Nothing -> pure () describe "Editor Behavior" $ do let expected = [[Plain "\9484\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9488"],[Plain "\9474",Plain " ",StyledText (FgBg White Black) [Plain " 1"],Plain " ",StyledText NoStyle [Plain "abcd"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9492\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9496"]] it "when content length is less than width and no key pressed" $ do -- Cursor is at the begining of text on load. testEditor "abcd" [] (ReferenceScreenState expected (ScreenPos 0 0, Bar)) it "when content length is less than width and left key pressed" $ do -- Cursor remains at the begining, even when left arrow is pressed, because there is no space on left. testEditor "abcd" (mkKeys 1 ArrowLeft) (ReferenceScreenState expected (ScreenPos 0 0, Bar)) it "when content length is less than width and right key pressed" $ do -- Cursor moves one place right when right arrow is pressed. testEditor "abcd" (mkKeys 1 ArrowRight) (ReferenceScreenState expected (ScreenPos 1 0, Bar)) let expected_1 = [[Plain "\9484\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9488"],[Plain "\9474",Plain " ",StyledText (FgBg White Black) [Plain " 1"],Plain " ",StyledText NoStyle [Plain "abcd"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain " 2",Plain " ",StyledText NoStyle [Plain "efgh"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9492\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9496"]] it "when there is two lines and no key pressed" $ do testEditor "abcd\nefgh" [] (ReferenceScreenState expected_1 (ScreenPos 0 0, Bar)) it "when there is two lines and 4 right arrow pressed" $ do -- After four right arrows, Cursor is just beyond the last char in first line. testEditor "abcd\nefgh" (mkKeys 4 ArrowRight) (ReferenceScreenState expected_1 (ScreenPos 4 0, Bar)) it "when there is two lines and 5 right arrow pressed" $ do let expectedSecondLineActive = [[Plain "\9484\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9488"],[Plain "\9474",Plain " ",Plain " 1",Plain " ",StyledText NoStyle [Plain "abcd"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",StyledText (FgBg White Black) [Plain " 2"],Plain " ",StyledText NoStyle [Plain "efgh"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9492\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9496"]] -- After five right arrows, Cursor wraps to the start of the next line. testEditor "abcd\nefgh" (mkKeys 5 ArrowRight) (ReferenceScreenState expectedSecondLineActive (ScreenPos 0 1, Bar)) let expected_2 = [[Plain "\9484\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9488"],[Plain "\9474",Plain " ",StyledText (FgBg White Black) [Plain " 1"],Plain " ",StyledText NoStyle [Plain "abcd 12345"],Plain "\9474"],[Plain "\9474",Plain " ",StyledText NoStyle [Plain "6789"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain " 2",Plain " ",StyledText NoStyle [Plain "efgh"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9492\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9496"]] it "when there is two lines and first line is longer than width and no key pressed" $ do -- The long line wrap into the line below. testEditor "abcd 123456789\nefgh" [] (ReferenceScreenState expected_2 (ScreenPos 0 0, Bar)) it "when there is two lines and first line is longer than width and right arrow pressed beyond screen width" $ do -- TODO: Ideally it should move to ScreenPos 7 2, but right now it goes to ScreenPos 8 2. testEditor "abcd 123456789\nefgh" (mkKeys 11 ArrowRight) (ReferenceScreenState expected_2 (ScreenPos 1 1, Bar)) it "when there is two lines and first line is longer than width and down arrow pressed" $ do let expected' = [[Plain "\9484\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9488"],[Plain "\9474",Plain " ",StyledText (FgBg White Black) [Plain " 1"],Plain " ",StyledText NoStyle [Plain "abcd 12345"],Plain "\9474"],[Plain "\9474",Plain " ",StyledText NoStyle [Plain "6789"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain " 2",Plain " ",StyledText NoStyle [Plain "efgh"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9492\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9496"]] -- The cursor moves into the part of the same line. testEditor "abcd 123456789\nefgh" (mkKeys 1 ArrowDown) (ReferenceScreenState expected' (ScreenPos 0 1, Bar)) let expected_3 = [[Plain "\9484\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9488"],[Plain "\9474",Plain " ",StyledText (FgBg White Black) [Plain " 1"],Plain " ",StyledText NoStyle [Plain "abcdefghij"],Plain "\9474"],[Plain "\9474",Plain " ",Plain " 2",Plain " ",StyledText NoStyle [Plain "klm"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9492\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9496"]] it "when one line length is exactly same as width and there is a second line" $ do testEditor "abcdefghij\nklm" [] (ReferenceScreenState expected_3 (ScreenPos 0 0, Bar)) let expected_4 = [[Plain "\9484\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9488"],[Plain "\9474",Plain " ",StyledText (FgBg White Black) [Plain " 1"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9492\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9496"]] it "backspace erases last char" $ do -- Cursor is at the begining of text on load. testEditor "" (mkCharKeys 1 'a' <> mkKeys 1 Backspace) (ReferenceScreenState expected_4 (ScreenPos 0 0, Bar)) let expected_5 = [[Plain "\9484\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9488"],[Plain "\9474",Plain " ",StyledText (FgBg White Black) [Plain " 1"],Plain " ",StyledText NoStyle [Plain "a"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9492\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9496"]] it "when initial content is empty and a key is pressed" $ do -- Cursor is at the begining of text on load. testEditor "" (mkCharKeys 1 'a') (ReferenceScreenState expected_5 (ScreenPos 1 0, Bar)) let expected_6 = [[Plain "\9484\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9488"],[Plain "\9474",Plain " ",Plain " 1",Plain " ",StyledText NoStyle [Plain "aaa"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",StyledText (FgBg White Black) [Plain " 2"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9492\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9496"]] it "when enter key is pressed at the end of a line" $ do -- Cursor is at the begining of text on load. testEditor "" (mkCharKeys 3 'a' <> mkKeys 1 Return) (ReferenceScreenState expected_6 (ScreenPos 0 1, Bar)) let expected_7 = [[Plain "\9484\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9488"],[Plain "\9474",Plain " ",Plain " 1",Plain " ",StyledText NoStyle [Plain "aaa"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",StyledText (FgBg White Black) [Plain " 2"],Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain "\9474"],[Plain "\9492\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9496"]] it "when down arrow key is pressed at the start of a line and the next line is empty" $ do -- Cursor is at the begining of text on load. testEditor "" (mkCharKeys 3 'a' <> mkKeys 1 Return <> mkKeys 1 ArrowUp <> mkKeys 1 ArrowDown) (ReferenceScreenState expected_7 (ScreenPos 0 1, Bar)) let expected_8 = [[Plain "\9484\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9488"],[Plain "\9474",Plain " ",Plain " 2",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain " 3",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain " 4",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain " 5",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain " 6",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain " 7",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",Plain " 8",Plain " ",Plain "\9474"],[Plain "\9474",Plain " ",StyledText (FgBg White Black) [Plain " 9"],Plain " ",Plain "\9474"],[Plain "\9492\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9472\9496"]] it "when enter is pressed and moves cursor beyond screen bottom" $ do -- Cursor is at the begining of text on load. testEditor "" (mkKeys 8 Return) (ReferenceScreenState expected_8 (ScreenPos 0 8, Bar)) describe "Highlighting" $ do it "test 1" $ do tokenStack <- tokenize "for i = 1 to 10" let unwrap' (Token tr _ _) = tr unwrap :: ([(Text, Maybe Token)], [Token]) -> ([(Text, Maybe TokenRaw)], [TokenRaw]) unwrap (lst1, tokenlst) = ((\(a, b) -> (a, unwrap' <$> b)) <$> lst1, unwrap' <$> tokenlst) (unwrap $ pairWithTokens tokenStack 0 "for i = 1 to 10") `shouldBe` ([("for",Just $ TkKeyword KwFor),(" ",Just $ TkWhitespace (Space 1)),("i",Just $ TkIdentifier (Identifier {unIdentifer = "i"})),(" ",Just $ TkWhitespace (Space 1)),("=",Just $ TkKeyword KwAssignment),(" ",Just $ TkWhitespace (Space 1)),("1",Just $ TkLiteral (LitNumber 1)),(" ",Just $ TkWhitespace (Space 1)),("to",Just $ TkKeyword KwTo),(" ",Just $ TkWhitespace (Space 1)),("10",Just $ TkLiteral (LitNumber 10))],[]) pure () describe "Token pairing" $ do it "Should pair single token" $ do genericPairWithTokens stOffsetEnd stLoc 0 "Something" [mkSimpleToken "Something" 0] `shouldBe` ([("Something", Just $ mkSimpleToken "Something" 0)], []) it "Should pair single partial start" $ do genericPairWithTokens stOffsetEnd stLoc 0 "Somet" [mkSimpleToken "Something" 0] `shouldBe` ([("Somet", Just $ mkSimpleToken "Something" 0)], [mkSimpleToken "Something" 0]) it "Should pair single partial end" $ do genericPairWithTokens stOffsetEnd stLoc 5 "hing" [mkSimpleToken "Something" 0] `shouldBe` ([("hing", Just $ mkSimpleToken "Something" 0)], []) it "Should pair single partial end incomplete" $ do genericPairWithTokens stOffsetEnd stLoc 5 "hin" [mkSimpleToken "Something" 0] `shouldBe` ([("hin", Just $ mkSimpleToken "Something" 0)], [mkSimpleToken "Something" 0]) describe "Editor cursor positioning" $ do it "test1" $ do (fst <$> offsetToScreenPos 5 [5,5] 9) `shouldBe` (Just $ ScreenPos 3 1) it "test2" $ do (fst <$> offsetToScreenPos 5 [5,3] 5) `shouldBe` (Just $ ScreenPos 5 0) it "test2.1" $ do (fst <$> offsetToScreenPos 5 [5,3] 6) `shouldBe` (Just $ ScreenPos 0 1) it "test3" $ do (fst <$> offsetToScreenPos 5 [5,3] 0) `shouldBe` (Just $ ScreenPos 0 0) it "test5" $ do (fst <$> offsetToScreenPos 5 [10,5] 9) `shouldBe` (Just $ ScreenPos 4 1) it "test5.1" $ do (fst <$> offsetToScreenPos 5 [10,5] 10) `shouldBe` (Just $ ScreenPos 5 1) it "test6" $ do (fst <$> offsetToScreenPos 5 [10,5] 5) `shouldBe` (Just $ ScreenPos 0 1) it "test7" $ do (fst <$> offsetToScreenPos 5 [8,5] 7) `shouldBe` (Just $ ScreenPos 2 1) it "test8" $ do (fst <$> offsetToScreenPos 5 [5,3,5] 7) `shouldBe` (Just $ ScreenPos 1 1) it "test9" $ do (fst <$> offsetToScreenPos 5 [5,3,0,5] 10) `shouldBe` (Just $ ScreenPos 0 2) it "test10" $ do (fst <$> offsetToScreenPos 5 [0,5,3] 1) `shouldBe` (Just $ ScreenPos 0 1) describe "Editor reverse cursor positioning" $ do it "test1" $ do (screenPosToOffset [2,5] 5 (ScreenPos 5 0)) `shouldBe` (Just (2, 1, ScreenPos 2 0)) mkSimpleToken :: Text -> Int -> SimpleToken mkSimpleToken x offset = NormalToken x (Location 0 0 offset) (offset + T.length x - 1) data SimpleToken = NormalToken { stContent :: Text, stLoc :: Location, stOffsetEnd :: Int } deriving (Show, Eq)