{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} module Cursor.TextFieldSpec ( spec, ) where import Control.Monad import Cursor.List.NonEmpty import Cursor.TextField import Cursor.TextField.Gen () import Cursor.Types import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import Test.Hspec import Test.QuickCheck import Test.Validity import Text.Show.Pretty (ppShow) spec :: Spec spec = do eqSpec @TextFieldCursor genValidSpec @TextFieldCursor describe "Validity TextFieldCursor" $ do it "consider a textfield with a newline in the previous lines invalid" $ forAllValid $ \tc -> shouldBeInvalid $ TextFieldCursor { textFieldCursorNonEmpty = NonEmptyCursor { nonEmptyCursorPrev = ["\n"], nonEmptyCursorCurrent = tc, nonEmptyCursorNext = [] } } it "consider a textfield with a newline in the next lines invalid" $ forAllValid $ \tc -> shouldBeInvalid $ TextFieldCursor { textFieldCursorNonEmpty = NonEmptyCursor { nonEmptyCursorPrev = [], nonEmptyCursorCurrent = tc, nonEmptyCursorNext = ["\n"] } } describe "makeTextFieldCursor" $ do it "produces a valid cursor for \"\\n\"" $ shouldBeValid $ makeTextFieldCursor "\n" it "produces a valid cursor for \"\\n\\n\"" $ shouldBeValid $ makeTextFieldCursor "\n\n" it "produces valid cursors" $ producesValid makeTextFieldCursor describe "makeTextFieldCursorWithSelection" $ do it "produces a valid cursor for \"\\n\"" $ forAllValid $ \x -> forAllValid $ \y -> shouldBeValid $ makeTextFieldCursorWithSelection x y "\n" it "produces a valid cursor for \"\\n\\n\"" $ forAllValid $ \x -> forAllValid $ \y -> shouldBeValid $ makeTextFieldCursorWithSelection x y "\n\n" it "produces valid cursors" $ producesValid3 makeTextFieldCursorWithSelection it "is the inverse of rebuildTextFieldCursor when using the current selection" $ forAllValid $ \tfc -> do let (x, y) = textFieldCursorSelection tfc t = rebuildTextFieldCursor tfc case makeTextFieldCursorWithSelection x y t of Nothing -> expectationFailure "makeTextFieldCursorWithSelection should not have failed." Just tfc' -> unless (tfc' == tfc) $ expectationFailure $ unlines [ "expected", ppShow tfc, "actual", ppShow tfc', "The selection of the original (expected) cursor was:", show (x, y), "The rebuild text was:", show t ] describe "rebuildTextFieldCursorLines" $ do it "produces valid lists" $ producesValid rebuildTextFieldCursorLines it "produces texts without newlines" $ forAllValid $ \tfc -> do let ls = NE.toList $ rebuildTextFieldCursorLines tfc unless (all (T.all (/= '\n')) ls) $ expectationFailure $ unlines $ "Some of the following lines contain a newline:" : map show ls describe "rebuildTextFieldCursor" $ do it "produces valid texts" $ producesValid rebuildTextFieldCursor it "is the inverse of makeTextFieldCursor" $ inverseFunctions makeTextFieldCursor rebuildTextFieldCursor it "is the inverse of makeTextFieldCursorWithSelection for integers, for any index" $ forAllValid $ \x -> forAllValid $ \y -> inverseFunctionsIfFirstSucceeds (makeTextFieldCursorWithSelection x y) rebuildTextFieldCursor describe "textFieldCursorSelection" $ it "produces valid tuples" $ producesValid textFieldCursorSelection describe "emptyTextFieldCursor" $ it "is valid" $ shouldBeValid emptyTextFieldCursor describe "nullTextFieldCursor" $ it "produces valid" $ producesValid nullTextFieldCursor describe "textFieldCursorSelectPrevLine" $ do it "produces valid cursors" $ producesValid textFieldCursorSelectPrevLine it "is a movement" $ isMovementM textFieldCursorSelectPrevLine it "selects the previous line" pending describe "textFieldCursorSelectNextLine" $ do it "produces valid cursors" $ producesValid textFieldCursorSelectNextLine it "is a movement" $ isMovementM textFieldCursorSelectNextLine it "selects the next line" pending describe "textFieldCursorSelectFirstLine" $ do it "produces valid cursors" $ producesValid textFieldCursorSelectFirstLine it "is a movement" $ isMovement textFieldCursorSelectFirstLine it "is idempotent" $ idempotent textFieldCursorSelectFirstLine it "selects the first line" pending describe "textFieldCursorSelectLastLine" $ do it "produces valid cursors" $ producesValid textFieldCursorSelectLastLine it "is a movement" $ isMovement textFieldCursorSelectLastLine it "is idempotent" $ idempotent textFieldCursorSelectLastLine it "selects the last line" pending describe "textFieldCursorSelectPrevChar" $ do it "produces valid cursors" $ producesValid textFieldCursorSelectPrevChar it "selects the previous character on the current line" pending describe "textFieldCursorSelectNextChar" $ do it "produces valid cursors" $ producesValid textFieldCursorSelectNextChar it "selects the previous character on the current line" pending describe "textFieldCursorSelectBeginWord" $ it "produces valid cursors" $ producesValid textFieldCursorSelectBeginWord describe "textFieldCursorSelectEndWord" $ it "produces valid cursors" $ producesValid textFieldCursorSelectEndWord describe "textFieldCursorSelectPrevWord" $ it "produces valid cursors" $ producesValid textFieldCursorSelectPrevWord describe "textFieldCursorSelectNextWord" $ it "produces valid cursors" $ producesValid textFieldCursorSelectNextWord describe "textFieldCursorIndexOnLine" $ do it "produces valid indices" $ producesValid textFieldCursorIndexOnLine it "returns the index on the current line" pending describe "textFieldCursorSelectIndexOnLine" $ do it "produces valid cursors for any index" $ producesValid2 textFieldCursorSelectIndexOnLine it "selects the given index on the current line" pending describe "textFieldCursorInsertChar" $ do it "produces valid cursors" $ forAllValid $ \d -> producesValid (textFieldCursorInsertChar d) it "inserts a character before the cursor on the current line" pending describe "textFieldCursorAppendChar" $ do it "produces valid cursors" $ forAllValid $ \d -> producesValid (textFieldCursorAppendChar d) it "inserts a character after the cursor on the currrent line" pending describe "textFieldCursorInsertNewline" $ do it "produces valid cursors" $ producesValid textFieldCursorInsertNewline it "inserts a new line" pending describe "textFieldCursorAppendNewline" $ it "produces valid cursors" $ producesValid textFieldCursorAppendNewline describe "textFieldCursorRemove" $ do it "produces valid cursors" $ producesValid textFieldCursorRemove it "removes empty text field cursor" $ textFieldCursorRemove emptyTextFieldCursor `shouldBe` Just Deleted it "removes a character or a line" pending describe "textFieldCursorDelete" $ do it "produces valid cursors" $ producesValid textFieldCursorDelete it "removes empty text field cursor" $ textFieldCursorDelete emptyTextFieldCursor `shouldBe` Just Deleted it "deletes a character or a line" pending describe "textFieldCursorSelectStartOfLine" $ do it "produces valid cursors" $ producesValid textFieldCursorSelectStartOfLine it "selects the start of the current line" pending describe "textFieldCursorSelectEndOfLine" $ do it "produces valid cursors" $ producesValid textFieldCursorSelectEndOfLine it "selects the end of the current line" pending isMovementM :: (TextFieldCursor -> Maybe TextFieldCursor) -> Property isMovementM func = forAllValid $ \tfc -> case func tfc of Nothing -> pure () -- Fine Just tfc' -> let tf = rebuildTextFieldCursor tfc tf' = rebuildTextFieldCursor tfc' in unless (tf == tf') $ expectationFailure $ unlines [ "Cursor before:\n" ++ show tfc, "TextField before: \n" ++ show tf, "Cursor after: \n" ++ show tfc', "TextField after: \n" ++ show tf' ] isMovement :: (TextFieldCursor -> TextFieldCursor) -> Property isMovement func = forAllValid $ \tfc -> rebuildTextFieldCursor tfc `shouldBe` rebuildTextFieldCursor (func tfc)