{-# LANGUAGE LambdaCase #-}

module Test.Util.Split.Tests (tests) where

import           Data.Either (isLeft, isRight)
import           Data.Maybe (mapMaybe)
import           Data.Word (Word64)
import           Test.Tasty
import           Test.Tasty.QuickCheck
import           Test.Util.Split


{-------------------------------------------------------------------------------
  Properties
-------------------------------------------------------------------------------}

tests :: TestTree
tests :: TestTree
tests = TestName -> [TestTree] -> TestTree
testGroup TestName
"Test.Util.Split" ([TestTree] -> TestTree) -> [TestTree] -> TestTree
forall a b. (a -> b) -> a -> b
$
    [ TestName -> ([Either Int Char] -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"prop_spanLeft"    [Either Int Char] -> Property
prop_spanLeft
    , TestName -> ([Either Int Char] -> Word64 -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"prop_splitAtJust" [Either Int Char] -> Word64 -> Property
prop_splitAtJust
    ]

prop_spanLeft :: [Either Int Char] -> Property
prop_spanLeft :: [Either Int Char] -> Property
prop_spanLeft [Either Int Char]
xs =
    Property
rebuild Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
    Property
count Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
    Property
tickIsReversed
  where
    result :: ([Int], Maybe (Char, [Either Int Char]))
result@([Int]
pre, Maybe (Char, [Either Int Char])
mbPost) = (Either Int Char -> Either Int Char)
-> [Either Int Char] -> ([Int], Maybe (Char, [Either Int Char]))
forall x a b. (x -> Either a b) -> [x] -> ([a], Maybe (b, [x]))
spanLeft Either Int Char -> Either Int Char
forall a. a -> a
id [Either Int Char]
xs

    rebuild :: Property
rebuild = TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"does not rebuild" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
              TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (([Int], Maybe (Char, [Either Int Char])) -> TestName
forall a. Show a => a -> TestName
show ([Int], Maybe (Char, [Either Int Char]))
result) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
              [Either Int Char]
actual [Either Int Char] -> [Either Int Char] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [Either Int Char]
expected
      where
        expected :: [Either Int Char]
expected = [Either Int Char]
xs
        actual :: [Either Int Char]
actual   = case Maybe (Char, [Either Int Char])
mbPost of
          Maybe (Char, [Either Int Char])
Nothing        -> (Int -> Either Int Char) -> [Int] -> [Either Int Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Either Int Char
forall a b. a -> Either a b
Left [Int]
pre
          Just (Char
b, [Either Int Char]
post) -> (Int -> Either Int Char) -> [Int] -> [Either Int Char]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Either Int Char
forall a b. a -> Either a b
Left [Int]
pre [Either Int Char] -> [Either Int Char] -> [Either Int Char]
forall a. [a] -> [a] -> [a]
++ Char -> Either Int Char
forall a b. b -> Either a b
Right Char
b Either Int Char -> [Either Int Char] -> [Either Int Char]
forall a. a -> [a] -> [a]
: [Either Int Char]
post

    count :: Property
count = TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"wrong count" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
            TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (([Int], Maybe (Char, [Either Int Char])) -> TestName
forall a. Show a => a -> TestName
show ([Int], Maybe (Char, [Either Int Char]))
result) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
            Int
actual Int -> Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int
expected
      where
        expected :: Int
expected = [Either Int Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Either Int Char] -> Int) -> [Either Int Char] -> Int
forall a b. (a -> b) -> a -> b
$ (Either Int Char -> Bool) -> [Either Int Char] -> [Either Int Char]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile Either Int Char -> Bool
forall a b. Either a b -> Bool
isLeft [Either Int Char]
xs
        actual :: Int
actual   = [Int] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
pre

    tickIsReversed :: Property
tickIsReversed = TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"is not reverse" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                     [Int] -> [Int]
forall a. [a] -> [a]
reverse [Int]
pre [Int] -> [Int] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ([Int], Maybe (Char, [Either Int Char])) -> [Int]
forall a b. (a, b) -> a
fst ((Either Int Char -> Either Int Char)
-> [Either Int Char] -> ([Int], Maybe (Char, [Either Int Char]))
forall x a b. (x -> Either a b) -> [x] -> ([a], Maybe (b, [x]))
spanLeft' Either Int Char -> Either Int Char
forall a. a -> a
id [Either Int Char]
xs)

prop_splitAtJust :: [Either Int Char] -> Word64 -> Property
prop_splitAtJust :: [Either Int Char] -> Word64 -> Property
prop_splitAtJust [Either Int Char]
xs Word64
rawN =
    Property
rebuild Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&.
    Property
count
  where
    prj :: Either a b -> Maybe b
prj = Either a b -> Maybe b
forall a b. Either a b -> Maybe b
prjRight
    lim :: Word64
lim = TestName -> Word64
forall a. [a] -> Word64
wlength (TestName -> Word64) -> TestName -> Word64
forall a b. (a -> b) -> a -> b
$ (Either Int Char -> Maybe Char) -> [Either Int Char] -> TestName
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Either Int Char -> Maybe Char
forall a b. Either a b -> Maybe b
prj [Either Int Char]
xs
    n :: Word64
n = if Word64
0 Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
lim then Word64
rawN else Word64
rawN Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`mod` (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
lim)

    result :: (Maybe ([Either Int Char], Char), [Either Int Char])
result@(Maybe ([Either Int Char], Char)
mbPre, [Either Int Char]
post) = (Either Int Char -> Maybe Char)
-> Word64
-> [Either Int Char]
-> (Maybe ([Either Int Char], Char), [Either Int Char])
forall x b.
(x -> Maybe b) -> Word64 -> [x] -> (Maybe ([x], b), [x])
splitAtJust Either Int Char -> Maybe Char
forall a b. Either a b -> Maybe b
prj Word64
n [Either Int Char]
xs

    rebuild :: Property
rebuild = TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"does not rebuild" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
              TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample ((Maybe ([Either Int Char], Char), [Either Int Char]) -> TestName
forall a. Show a => a -> TestName
show (Maybe ([Either Int Char], Char), [Either Int Char])
result) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
              [Either Int Char]
actual [Either Int Char] -> [Either Int Char] -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [Either Int Char]
expected
      where
        expected :: [Either Int Char]
expected = [Either Int Char]
xs
        actual :: [Either Int Char]
actual   = case Maybe ([Either Int Char], Char)
mbPre of
          Maybe ([Either Int Char], Char)
Nothing       -> [Either Int Char]
post
          Just ([Either Int Char]
pre, Char
b) -> [Either Int Char]
pre [Either Int Char] -> [Either Int Char] -> [Either Int Char]
forall a. [a] -> [a] -> [a]
++ Char -> Either Int Char
forall a b. b -> Either a b
Right Char
b Either Int Char -> [Either Int Char] -> [Either Int Char]
forall a. a -> [a] -> [a]
: [Either Int Char]
post

    count :: Property
count = TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample TestName
"wrong count" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
            TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample ((Maybe ([Either Int Char], Char), [Either Int Char]) -> TestName
forall a. Show a => a -> TestName
show (Maybe ([Either Int Char], Char), [Either Int Char])
result) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
            Word64
actual Word64 -> Word64 -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Word64
expected
      where
        expected :: Word64
expected = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min Word64
n ([Either Int Char] -> Word64
forall a. [a] -> Word64
wlength ([Either Int Char] -> Word64) -> [Either Int Char] -> Word64
forall a b. (a -> b) -> a -> b
$ (Either Int Char -> Bool) -> [Either Int Char] -> [Either Int Char]
forall a. (a -> Bool) -> [a] -> [a]
filter Either Int Char -> Bool
forall a b. Either a b -> Bool
isRight [Either Int Char]
xs)
        actual :: Word64
actual   = case Maybe ([Either Int Char], Char)
mbPre of
          Maybe ([Either Int Char], Char)
Nothing       -> Word64
0
          Just ([Either Int Char]
pre, Char
_) -> Word64 -> Word64
forall a. Enum a => a -> a
succ ([Either Int Char] -> Word64
forall a. [a] -> Word64
wlength ([Either Int Char] -> Word64) -> [Either Int Char] -> Word64
forall a b. (a -> b) -> a -> b
$ (Either Int Char -> Bool) -> [Either Int Char] -> [Either Int Char]
forall a. (a -> Bool) -> [a] -> [a]
filter Either Int Char -> Bool
forall a b. Either a b -> Bool
isRight [Either Int Char]
pre)

{-------------------------------------------------------------------------------
  Auxiliaries
-------------------------------------------------------------------------------}

wlength :: [a] -> Word64
wlength :: forall a. [a] -> Word64
wlength = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> ([a] -> Int) -> [a] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length

prjRight :: Either a b -> Maybe b
prjRight :: forall a b. Either a b -> Maybe b
prjRight = \case
  Left{}  -> Maybe b
forall a. Maybe a
Nothing
  Right b
x -> b -> Maybe b
forall a. a -> Maybe a
Just b
x