{-# OPTIONS_GHC -fno-warn-orphans #-}

module Cursor.Text.Gen
  ( genSafeChar,
    genTextCursorChar,
    textCursorSentenceGen,
    textCursorWithGen,
    textCursorWithIndex0,
    shrinkSentence,
  )
where

import Cursor.List
import Cursor.List.Gen
import Cursor.Text
import Cursor.Types
import Data.Char (isSpace)
import Data.GenValidity
import Data.GenValidity.Text ()
import Test.QuickCheck

instance GenValid TextCursor where
  genValid :: Gen TextCursor
genValid = ListCursor Char -> TextCursor
TextCursor (ListCursor Char -> TextCursor)
-> Gen (ListCursor Char) -> Gen TextCursor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen (ListCursor Char)
forall a. Gen a -> Gen (ListCursor a)
listCursorWithGen Gen Char
genTextCursorChar
  shrinkValid :: TextCursor -> [TextCursor]
shrinkValid = TextCursor -> [TextCursor]
forall a.
(Validity a, Generic a, GValidRecursivelyShrink (Rep a),
 GValidSubterms (Rep a) a) =>
a -> [a]
shrinkValidStructurally

genSafeChar :: Gen Char
genSafeChar :: Gen Char
genSafeChar = (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
choose (Char
forall a. Bounded a => a
minBound, Char
forall a. Bounded a => a
maxBound) Gen Char -> (Char -> Bool) -> Gen Char
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` Char -> Bool
isSafeChar

genSpaceChar :: Gen Char
genSpaceChar :: Gen Char
genSpaceChar = [Char] -> Gen Char
forall a. [a] -> Gen a
elements [Char
' ', Char
'\t', Char
'\v']

genTextCursorChar :: Gen Char
genTextCursorChar :: Gen Char
genTextCursorChar = Gen Char
genSafeChar Gen Char -> (Char -> Bool) -> Gen Char
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')

textCursorWithGen :: Gen Char -> Gen TextCursor
textCursorWithGen :: Gen Char -> Gen TextCursor
textCursorWithGen Gen Char
gen = ListCursor Char -> TextCursor
TextCursor (ListCursor Char -> TextCursor)
-> Gen (ListCursor Char) -> Gen TextCursor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen (ListCursor Char)
forall a. Gen a -> Gen (ListCursor a)
listCursorWithGen Gen Char
gen

textCursorWithIndex0 :: Gen Char -> Gen TextCursor
textCursorWithIndex0 :: Gen Char -> Gen TextCursor
textCursorWithIndex0 Gen Char
gen = ListCursor Char -> TextCursor
TextCursor (ListCursor Char -> TextCursor)
-> Gen (ListCursor Char) -> Gen TextCursor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen (ListCursor Char)
forall a. Gen a -> Gen (ListCursor a)
listCursorWithIndex0 Gen Char
gen

textCursorSentenceGen :: Gen TextCursor
textCursorSentenceGen :: Gen TextCursor
textCursorSentenceGen = Gen Char -> Gen TextCursor
textCursorWithGen Gen Char
sentenceGen
  where
    sentenceGen :: Gen Char
    sentenceGen :: Gen Char
sentenceGen = [(Int, Gen Char)] -> Gen Char
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
1, Gen Char
genSpaceChar), (Int
5, Gen Char
genSafeChar)]

shrinkSentence :: TextCursor -> [TextCursor]
shrinkSentence :: TextCursor -> [TextCursor]
shrinkSentence tc :: TextCursor
tc@(TextCursor (ListCursor [Char]
before [Char]
after)) =
  (TextCursor -> Bool) -> [TextCursor] -> [TextCursor]
forall a. (a -> Bool) -> [a] -> [a]
filter (TextCursor -> TextCursor -> Bool
forall a. Eq a => a -> a -> Bool
/= TextCursor
tc) [ListCursor Char -> TextCursor
TextCursor ([Char] -> [Char] -> ListCursor Char
forall a. [a] -> [a] -> ListCursor a
ListCursor ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f [Char]
before) ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f [Char]
after))]
  where
    f :: Char -> Char
    f :: Char -> Char
f Char
x
      | Char -> Bool
isSpace Char
x = Char
' '
      | Bool
otherwise = Char
'a'