TextSpec.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeApplications #-}

module Cursor.TextSpec
  ( spec,
  )
where

import Control.Monad
import Cursor.List
import Cursor.Text
import Cursor.Text.Gen
import Data.Char
import Data.Text (Text)
import qualified Data.Text as T
import Test.Hspec
import Test.QuickCheck
import Test.Validity

spec :: Spec
spec = do
  eqSpec @TextCursor
  genValidSpec @TextCursor
  describe "Validity TextCursor" $ do
    it "considers a text cursor with a newline in the previous characters invalid" $
      shouldBeInvalid $
        TextCursor {textCursorList = ListCursor {listCursorPrev = "\n", listCursorNext = ""}}
    it "considers a text cursor with a newline in the next characters invalid" $
      shouldBeInvalid $
        TextCursor {textCursorList = ListCursor {listCursorPrev = "", listCursorNext = "\n"}}
    it "considers a text cursor with an unsafe character in the previous characters invalid" $
      shouldBeInvalid $
        TextCursor {textCursorList = ListCursor {listCursorPrev = "\55810", listCursorNext = ""}}
    it "considers a text cursor with an unsafe character in the next characters invalid" $
      shouldBeInvalid $
        TextCursor {textCursorList = ListCursor {listCursorPrev = "\55810", listCursorNext = "\n"}}
  describe "emptyTextCursor" $ it "is valid" $ shouldBeValid emptyTextCursor
  describe "makeTextCursor" $
    it "produces valid list cursors" $
      producesValid makeTextCursor
  describe "makeTextCursorWithSelection" $
    it "produces valid list cursors" $
      producesValid2 makeTextCursorWithSelection
  describe "rebuildTextCursor" $ do
    it "produces valid lists" $ producesValid rebuildTextCursor
    it "is the inverse of makeTextCursor" $
      inverseFunctionsIfFirstSucceeds makeTextCursor rebuildTextCursor
    it "is the inverse of makeTextCursorWithSelection for any index" $
      forAllValid $
        \i ->
          inverseFunctionsIfFirstSucceeds (makeTextCursorWithSelection i) rebuildTextCursor
  describe "textCursorNull" $ it "produces valid bools" $ producesValid textCursorNull
  describe "textCursorLength" $ it "produces valid ints" $ producesValid textCursorLength
  describe "textCursorIndex" $ it "produces valid indices" $ producesValid textCursorIndex
  describe "textCursorSelectPrev" $ do
    it "produces valid cursors" $ producesValid textCursorSelectPrev
    it "is a movement" $ isMovementM textCursorSelectPrev
    it "selects the previous position" pending
  describe "textCursorSelectNext" $ do
    it "produces valid cursors" $ producesValid textCursorSelectNext
    it "is a movement" $ isMovementM textCursorSelectNext
    it "selects the next position" pending
  describe "textCursorSelectIndex" $ do
    it "produces valid cursors" $ producesValid2 textCursorSelectIndex
    it "is a movement" $ forAllValid $ \ix -> isMovement (textCursorSelectIndex ix)
    it "selects the position at the given index" pending
    it "produces a cursor that has the given selection for valid selections in the cursor" $
      forAllValid $
        \tc ->
          forAll (choose (0, textCursorLength tc)) $ \i ->
            textCursorIndex (textCursorSelectIndex i tc) `shouldBe` i
  describe "textCursorSelectStart" $ do
    it "produces valid cursors" $ producesValid textCursorSelectStart
    it "is a movement" $ isMovement textCursorSelectStart
    it "is idempotent" $ idempotent textCursorSelectStart
    it "selects the starting position" pending
  describe "textCursorSelectEnd" $ do
    it "produces valid cursors" $ producesValid textCursorSelectEnd
    it "is a movement" $ isMovement textCursorSelectEnd
    it "is idempotent" $ idempotent textCursorSelectEnd
    it "selects the end position" pending
  describe "textCursorPrevChar" $ do
    it "produces valid items" $ producesValid textCursorPrevChar
    it "returns the item before the position" pending
  describe "textCursorNextChar" $ do
    it "produces valid items" $ producesValid textCursorNextChar
    it "returns the item after the position" pending
  describe "textCursorSelectBeginWord" $ do
    it "produces valid items" $ producesValid textCursorSelectBeginWord
    it "is a movement" $ isMovement textCursorSelectBeginWord
    it "is idempotent" $ isIdempotentForSentence textCursorSelectBeginWord
    it "works for this example" $
      textCursorSelectBeginWord (buildTestTextCursor "hell" "o") `shouldBe` buildTestTextCursor "" "hello"
    it "works for this example" $
      textCursorSelectBeginWord (buildTestTextCursor "hello  " " world") `shouldBe` buildTestTextCursor "" "hello   world"
    it "works for this example" $
      textCursorSelectBeginWord (buildTestTextCursor "hello " "world") `shouldBe` buildTestTextCursor "hello " "world"
    it "works for this example" $
      textCursorSelectBeginWord (buildTestTextCursor "" " hello") `shouldBe` buildTestTextCursor "" " hello"
  describe "textCursorSelectEndWord" $ do
    it "produces valid items" $ producesValid textCursorSelectEndWord
    it "is a movement" $ isMovement textCursorSelectEndWord
    it "is idempotent" $ isIdempotentForSentence textCursorSelectEndWord
    it "works for this example" $
      textCursorSelectEndWord (buildTestTextCursor "hell" "o") `shouldBe` buildTestTextCursor "hello" ""
    it "works for this example" $
      textCursorSelectEndWord (buildTestTextCursor "hello  " " world") `shouldBe` buildTestTextCursor "hello   world" ""
    it "works for this example" $
      textCursorSelectEndWord (buildTestTextCursor "hello" " world") `shouldBe` buildTestTextCursor "hello" " world"
    it "works for this example" $
      textCursorSelectEndWord (buildTestTextCursor "hello " "") `shouldBe` buildTestTextCursor "hello " ""
  describe "textCursorSelectNextWord" $ do
    it "produces valid items" $ producesValid textCursorSelectNextWord
    it "is a movement" $ isMovement textCursorSelectNextWord
    it "works for this example" $
      textCursorSelectNextWord (buildTestTextCursor "" "hello") `shouldBe` buildTestTextCursor "hello" ""
    it "works for this example" $
      textCursorSelectNextWord (buildTestTextCursor "hell" "o world") `shouldBe` buildTestTextCursor "hello " "world"
    it "works for this example" $
      textCursorSelectNextWord (buildTestTextCursor "hello" " world") `shouldBe` buildTestTextCursor "hello " "world"
    it "works for this example" $
      textCursorSelectNextWord (buildTestTextCursor "hello " "") `shouldBe` buildTestTextCursor "hello " ""
    it "goes to the end of the cursor" $
      textCursorSelectNextWord (buildTestTextCursor "a\v" "b") `shouldBe` buildTestTextCursor "a\vb" ""
    it "chooses the next word correctly" $
      textCursorSelectNextWord (buildTestTextCursor "a" " b c") `shouldBe` buildTestTextCursor "a " "b c"
  describe "textCursorSelectPrevWord" $ do
    it "produces valid items" $ producesValid textCursorSelectPrevWord
    it "is a movement" $ isMovement textCursorSelectPrevWord
    it "works for this example" $
      textCursorSelectPrevWord (buildTestTextCursor "hello" "") `shouldBe` buildTestTextCursor "" "hello"
    it "works for this example" $
      textCursorSelectPrevWord (buildTestTextCursor "hello w" "orld") `shouldBe` buildTestTextCursor "hello" " world"
    it "works for this example" $
      textCursorSelectPrevWord (buildTestTextCursor "hello " "world") `shouldBe` buildTestTextCursor "hello" " world"
    it "works for this example" $
      textCursorSelectPrevWord (buildTestTextCursor " h" "ello") `shouldBe` buildTestTextCursor "" " hello"
    it "goes to the beginning of the cursor" $
      textCursorSelectPrevWord (buildTestTextCursor "a" "\vb") `shouldBe` buildTestTextCursor "" "a\vb"
    it "chooses the previous word correctly" $
      textCursorSelectPrevWord (buildTestTextCursor "a b" " c") `shouldBe` buildTestTextCursor "a" " b c"
  describe "textCursorInsert" $ do
    it "produces valids" $ forAllValid $ \d -> producesValid (textCursorInsert d)
    it "inserts an item before the cursor" pending
  describe "textCursorAppend" $ do
    it "produces valids" $ forAllValid $ \d -> producesValid (textCursorAppend d)
    it "inserts an item after the cursor" pending
  describe "textCursorInsertString" $ do
    it "produces valids" $ forAllValid $ \d -> producesValid (textCursorInsertString d)
    it "works for this example" $
      (makeTextCursor "hello" >>= textCursorInsertString " world")
        `shouldBe` makeTextCursor "hello world"
  describe "textCursorAppendString" $
    it "produces valids" $
      forAllValid $
        \d -> producesValid (textCursorAppendString d)
  describe "textCursorInsertText" $
    it "produces valids" $
      forAllValid $
        \d -> producesValid (textCursorInsertText d)
  describe "textCursorAppendText" $
    it "produces valids" $
      forAllValid $
        \d -> producesValid (textCursorAppendText d)
  describe "textCursorRemove" $ do
    it "produces valids" $ validIfSucceeds textCursorRemove
    it "removes an item before the cursor" pending
  describe "textCursorDelete" $ do
    it "produces valids" $ validIfSucceeds textCursorDelete
    it "removes an item before the cursor" pending
  describe "textCursorSplit" $ do
    it "produces valids" $ producesValid textCursorSplit
    it "produces two list cursors that rebuild to the rebuilding of the original" $
      forAllValid $
        \lc ->
          let (lc1, lc2) = textCursorSplit lc
           in (rebuildTextCursor lc1 <> rebuildTextCursor lc2) `shouldBe` rebuildTextCursor lc
  describe "textCursorCombine" $ do
    it "produces valids" $ producesValid2 textCursorCombine
    it "produces a list that rebuilds to the rebuilding of the original two cursors" $
      forAllValid $
        \lc1 ->
          forAllValid $ \lc2 ->
            let lc = textCursorCombine lc1 lc2
             in rebuildTextCursor lc `shouldBe` (rebuildTextCursor lc1 <> rebuildTextCursor lc2)

isMovementM :: (TextCursor -> Maybe TextCursor) -> Property
isMovementM func =
  forAllValid $ \tc ->
    case func tc of
      Nothing -> pure () -- Fine
      Just tc' ->
        let t = rebuildTextCursor tc
            t' = rebuildTextCursor tc'
         in unless (t == t') $
              expectationFailure $
                unlines
                  [ "Cursor before:\n" ++ show tc,
                    "Text before:  \n" ++ show t,
                    "Cursor after: \n" ++ show tc',
                    "Text after:   \n" ++ show t'
                  ]

isMovement :: (TextCursor -> TextCursor) -> Property
isMovement func =
  forAllValid $ \lec -> rebuildTextCursor lec `shouldBe` rebuildTextCursor (func lec)

isIdempotentForSentence :: (TextCursor -> TextCursor) -> Property
isIdempotentForSentence f =
  checkCoverage $
    forAllShrink textCursorSentenceGen shrinkSentence $ \tc ->
      let txt = rebuildTextCursor tc
          numChars = T.length txt
          numSpaces = T.length . T.filter isSpace $ txt
       in cover 50 (numSpaces >= 1 && numChars > 2) "non trivial" $ f (f tc) `shouldBe` f tc

buildTestTextCursor :: Text -> Text -> TextCursor
buildTestTextCursor befores afters = TextCursor {textCursorList = ListCursor {listCursorPrev = T.unpack . T.reverse $ befores, listCursorNext = T.unpack afters}}