FieldTest.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}

module UI.FieldTest
    ( test_field
    ) where

import ClassyPrelude

import UI.Field (Field (Field), backspace, cursorPosition, insertCharacter, insertText,
                 updateCursor, wrap)

import Test.Tasty
import Test.Tasty.HUnit

width :: Int
width = 30

cursorPosition' :: Text -> Int -> (Int, Int)
cursorPosition' text cursor = cursorPosition wrapped width (cursor - offset)
  where
    (wrapped, offset) = wrap width text

test_field :: TestTree
test_field =
    testGroup
        "UI.Field"
        [ testGroup
              "Field cursor left"
              [ testCase
                    "Standard"
                    (assertEqual
                         "Should move left"
                         (Field "Blah" 1)
                         (updateCursor (-1) (Field "Blah" 2)))
              , testCase
                    "Out of bounds"
                    (assertEqual
                         "Should stay 0"
                         (Field "Blah" 0)
                         (updateCursor (-1) (Field "Blah" 0)))
              ]
        , testGroup
              "Field cursor right"
              [ testCase
                    "Standard"
                    (assertEqual
                         "Should move right"
                         (Field "Blah" 3)
                         (updateCursor 1 (Field "Blah" 2)))
              , testCase
                    "At end"
                    (assertEqual
                         "Should move right"
                         (Field "Blah" 4)
                         (updateCursor 1 (Field "Blah" 3)))
              , testCase
                    "Out of bounds"
                    (assertEqual "Should stay" (Field "Blah" 4) (updateCursor 1 (Field "Blah" 4)))
              ]
        , testGroup
              "Field insert character"
              [ testCase
                    "At end"
                    (assertEqual
                         "Should insert character at end"
                         (Field "Blahs" 5)
                         (insertCharacter 's' (Field "Blah" 4)))
              , testCase
                    "At beginning"
                    (assertEqual
                         "Should insert character at beginning"
                         (Field "sBlah" 1)
                         (insertCharacter 's' (Field "Blah" 0)))
              ]
        , testGroup
              "Field backspace"
              [ testCase
                    "At end"
                    (assertEqual
                         "Should remove last character"
                         (Field "Bla" 3)
                         (backspace (Field "Blah" 4)))
              , testCase
                    "At beginning"
                    (assertEqual
                         "Should stay the same"
                         (Field "Blah" 0)
                         (backspace (Field "Blah" 0)))
              , testCase
                    "In middle"
                    (assertEqual "Should remove middle" (Field "Bah" 1) (backspace (Field "Blah" 2)))
              ]
        , testGroup
              "Field insert text"
              [ testCase
                    "At end"
                    (assertEqual
                         "Should insert text at end"
                         (Field "Blah hello" 10)
                         (insertText " hello" (Field "Blah" 4)))
              , testCase
                    "At beginning"
                    (assertEqual
                         "Should insert text at beginning"
                         (Field "Hello Blah" 6)
                         (insertText "Hello " (Field "Blah" 0)))
              ]
        , testGroup
              "Cursor position"
              [ testCase
                    "Empty"
                    (assertEqual "Should be at beginning" (0, 0) (cursorPosition' "" 0))
              , testCase
                    "First line"
                    (assertEqual
                         "Should be on first line"
                         (14, 0)
                         (cursorPosition' "Blah blah blah" 14))
              , testCase
                    "Half way along"
                    (assertEqual
                         "Should be on first line"
                         (7, 0)
                         (cursorPosition' "Blah blah blah" 7))
              , testCase
                    "End of line"
                    (assertEqual
                         "Should be on first line"
                         (29, 0)
                         (cursorPosition' "Blah blah blah blah blah blah" 29))
              , testCase
                    "End of line wrap"
                    (assertEqual
                         "Should wrap"
                         (0, 1)
                         (cursorPosition' "Blah blah blah blah blah blahs" 30))
              , testCase
                    "End of line with space wrap"
                    (assertEqual
                         "Should wrap"
                         (0, 1)
                         (cursorPosition' "Blah blah blah blah blah blah " 30))
              , testCase
                    "Long words"
                    (assertEqual
                         "Should wrap to correct position"
                         (6, 1)
                         (cursorPosition' "Artichoke penguin astronaut wombat" 34))
              , testCase
                    "Long words with space"
                    (assertEqual
                         "Should ignore the space when counting"
                         (16, 1)
                         (cursorPosition' "Blah fish wombat monkey sponge catpult arsonist" 47))
              ]
        ]