-- |
-- Module      : Test.Extrapolate.Utils
-- Copyright   : (c) 2017-2019 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of Extrapolate,
-- a library for generalization of counter-examples.
--
-- Miscellaneous utility functions.
--
-- This is not intended to be used by users of Extrapolate, only by modules of
-- Extrapolate itself.  Expect symbols exported here to come and go with every
-- minor version.
module Test.Extrapolate.Utils
  ( (+++)
  , nubMerge
  , nubMergeOn
  , nubMergeBy
  , foldr0
  , fromLeft
  , fromRight
  , elemBy
  , listEq,   listOrd
  , maybeEq,  maybeOrd
  , eitherEq, eitherOrd
  , pairEq,   pairOrd
  , tripleEq, tripleOrd
  , quadrupleEq, quadrupleOrd
  , minimumOn
  , maximumOn
  , takeBound
  , nubMergeMap
  , compareIndex
  )
where

import Data.Function (on)
import Data.List (minimumBy, elemIndex)

nubMergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp (a
x:[a]
xs) (a
y:[a]
ys) = case a
x a -> a -> Ordering
`cmp` a
y of
                                 Ordering
LT -> a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp [a]
xs (a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)
                                 Ordering
GT -> a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a]
ys
                                 Ordering
EQ -> a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:(a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp [a]
xs [a]
ys
nubMergeBy a -> a -> Ordering
_ [a]
xs [a]
ys = [a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
ys

nubMergeOn :: Ord b => (a -> b) -> [a] -> [a] -> [a]
nubMergeOn :: (a -> b) -> [a] -> [a] -> [a]
nubMergeOn a -> b
f = (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering) -> (a -> b) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)

nubMerge :: Ord a => [a] -> [a] -> [a]
nubMerge :: [a] -> [a] -> [a]
nubMerge = (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

(+++) :: Ord a => [a] -> [a] -> [a]
+++ :: [a] -> [a] -> [a]
(+++) = [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
nubMerge
infixr 5 +++

-- variation of foldr that only uses "zero" when the list is empty
foldr0 :: (a -> a -> a) -> a -> [a] -> a
foldr0 :: (a -> a -> a) -> a -> [a] -> a
foldr0 a -> a -> a
f a
z [a]
xs | [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs   = a
z
              | Bool
otherwise = (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 a -> a -> a
f [a]
xs

-- note these versions of fromLeft and fromRight differ from the ones of
-- Data.Either since 4.10.0.0.
fromLeft :: Either a b -> a
fromLeft :: Either a b -> a
fromLeft (Left a
x) = a
x
fromLeft Either a b
_        = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"fromLeft: not a left"

fromRight :: Either a b -> b
fromRight :: Either a b -> b
fromRight (Right b
x) = b
x
fromRight Either a b
_         = [Char] -> b
forall a. HasCallStack => [Char] -> a
error [Char]
"fromRight: not a right"

elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
elemBy :: (a -> a -> Bool) -> a -> [a] -> Bool
elemBy a -> a -> Bool
(==) a
x = (a -> Bool) -> [a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> a -> Bool
== a
x)

listEq :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listEq :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listEq a -> a -> Bool
(==) []     []     = Bool
True
listEq a -> a -> Bool
(==) (a
x:[a]
xs) []     = Bool
False
listEq a -> a -> Bool
(==) []     (a
y:[a]
ys) = Bool
False
listEq a -> a -> Bool
(==) (a
x:[a]
xs) (a
y:[a]
ys) = a
x a -> a -> Bool
== a
y Bool -> Bool -> Bool
&& (a -> a -> Bool) -> [a] -> [a] -> Bool
forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
listEq a -> a -> Bool
(==) [a]
xs [a]
ys

listOrd :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listOrd :: (a -> a -> Bool) -> [a] -> [a] -> Bool
listOrd a -> a -> Bool
(<=) []     []     = Bool
True
listOrd a -> a -> Bool
(<=) (a
x:[a]
xs) []     = Bool
False
listOrd a -> a -> Bool
(<=) []     (a
y:[a]
ys) = Bool
True
listOrd a -> a -> Bool
(<=) (a
x:[a]
xs) (a
y:[a]
ys) = a
x a -> a -> Bool
<  a
y
                          Bool -> Bool -> Bool
|| a
x a -> a -> Bool
== a
y Bool -> Bool -> Bool
&& (a -> a -> Bool) -> [a] -> [a] -> Bool
forall a. (a -> a -> Bool) -> [a] -> [a] -> Bool
listOrd a -> a -> Bool
(<=) [a]
xs [a]
ys
  where
  a
x < :: a -> a -> Bool
<  a
y = a
x a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<= a
x)
  a
x == :: a -> a -> Bool
== a
y = a
x a -> a -> Bool
<= a
y Bool -> Bool -> Bool
&&      a
y a -> a -> Bool
<= a
x

maybeEq :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeEq :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeEq a -> a -> Bool
(==) Maybe a
Nothing  Maybe a
Nothing  = Bool
True
maybeEq a -> a -> Bool
(==) Maybe a
Nothing  (Just a
y) = Bool
False
maybeEq a -> a -> Bool
(==) (Just a
x) Maybe a
Nothing  = Bool
False
maybeEq a -> a -> Bool
(==) (Just a
x) (Just a
y) = a
x a -> a -> Bool
== a
y

maybeOrd :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeOrd :: (a -> a -> Bool) -> Maybe a -> Maybe a -> Bool
maybeOrd a -> a -> Bool
(<=) Maybe a
Nothing  Maybe a
Nothing  = Bool
True
maybeOrd a -> a -> Bool
(<=) Maybe a
Nothing  (Just a
y) = Bool
True
maybeOrd a -> a -> Bool
(<=) (Just a
x) Maybe a
Nothing  = Bool
False
maybeOrd a -> a -> Bool
(<=) (Just a
x) (Just a
y) = a
x a -> a -> Bool
<= a
y

eitherEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherEq :: (a -> a -> Bool)
-> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherEq a -> a -> Bool
(==) b -> b -> Bool
_ (Left  a
x) (Left  a
y) = a
x a -> a -> Bool
== a
y
eitherEq a -> a -> Bool
_ b -> b -> Bool
(==) (Right b
x) (Right b
y) = b
x b -> b -> Bool
== b
y
eitherEq a -> a -> Bool
_ b -> b -> Bool
_ Either a b
_ Either a b
_ = Bool
False

eitherOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherOrd :: (a -> a -> Bool)
-> (b -> b -> Bool) -> Either a b -> Either a b -> Bool
eitherOrd a -> a -> Bool
(<=) b -> b -> Bool
_ (Left  a
x) (Left  a
y) = a
x a -> a -> Bool
<= a
y
eitherOrd a -> a -> Bool
_ b -> b -> Bool
(<=) (Right b
x) (Right b
y) = b
x b -> b -> Bool
<= b
y
eitherOrd a -> a -> Bool
_    b -> b -> Bool
_ (Left  a
_) (Right b
_) = Bool
True
eitherOrd a -> a -> Bool
_    b -> b -> Bool
_ (Right b
_) (Left  a
_) = Bool
False

pairEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a,b) -> (a,b) -> Bool
pairEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
pairEq a -> a -> Bool
(==.) b -> b -> Bool
(.==) (a
x1,b
y1) (a
x2,b
y2) = a
x1 a -> a -> Bool
==. a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.== b
y2

pairOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a,b) -> (a,b) -> Bool
pairOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
pairOrd a -> a -> Bool
(<=.) b -> b -> Bool
(.<=) (a
x1,b
y1) (a
x2,b
y2) = a
x1 a -> a -> Bool
<. a
x2
                                   Bool -> Bool -> Bool
|| a
x1 a -> a -> Bool
==. a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.<= b
y2
  where
  a
x <. :: a -> a -> Bool
<.  a
y = a
x a -> a -> Bool
<=. a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<=. a
x)
  a
x ==. :: a -> a -> Bool
==. a
y = a
x a -> a -> Bool
<=. a
y Bool -> Bool -> Bool
&&      a
y a -> a -> Bool
<=. a
x

tripleEq :: (a -> a -> Bool) -> (b -> b -> Bool) -> (c -> c -> Bool)
         -> (a,b,c) -> (a,b,c) -> Bool
tripleEq :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (a, b, c)
-> (a, b, c)
-> Bool
tripleEq a -> a -> Bool
(==..) b -> b -> Bool
(.==.) c -> c -> Bool
(..==) (a
x1,b
y1,c
z1) (a
x2,b
y2,c
z2) =
  a
x1 a -> a -> Bool
==.. a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.==. b
y2 Bool -> Bool -> Bool
&& c
z1 c -> c -> Bool
..== c
z2

tripleOrd :: (a -> a -> Bool) -> (b -> b -> Bool) -> (c -> c -> Bool)
          -> (a,b,c) -> (a,b,c) -> Bool
tripleOrd :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (a, b, c)
-> (a, b, c)
-> Bool
tripleOrd a -> a -> Bool
(<=..) b -> b -> Bool
(.<=.) c -> c -> Bool
(..<=) (a
x1,b
y1,c
z1) (a
x2,b
y2,c
z2) =
  a
x1 a -> a -> Bool
<.. a
x2 Bool -> Bool -> Bool
|| a
x1 a -> a -> Bool
==.. a
x2 Bool -> Bool -> Bool
&& (b -> b -> Bool) -> (c -> c -> Bool) -> (b, c) -> (b, c) -> Bool
forall a b.
(a -> a -> Bool) -> (b -> b -> Bool) -> (a, b) -> (a, b) -> Bool
pairOrd b -> b -> Bool
(.<=.) c -> c -> Bool
(..<=) (b
y1,c
z1) (b
y2,c
z2)
  where
  a
x <.. :: a -> a -> Bool
<..  a
y = a
x a -> a -> Bool
<=.. a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<=.. a
x)
  a
x ==.. :: a -> a -> Bool
==.. a
y = a
x a -> a -> Bool
<=.. a
y Bool -> Bool -> Bool
&&      a
y a -> a -> Bool
<=.. a
x

quadrupleEq :: (a->a->Bool) -> (b->b->Bool) -> (c->c->Bool) -> (d->d->Bool)
            -> (a,b,c,d) -> (a,b,c,d) -> Bool
quadrupleEq :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (d -> d -> Bool)
-> (a, b, c, d)
-> (a, b, c, d)
-> Bool
quadrupleEq a -> a -> Bool
(==...) b -> b -> Bool
(.==..) c -> c -> Bool
(..==.) d -> d -> Bool
(...==) (a
x1,b
y1,c
z1,d
w1) (a
x2,b
y2,c
z2,d
w2) =
  a
x1 a -> a -> Bool
==... a
x2 Bool -> Bool -> Bool
&& b
y1 b -> b -> Bool
.==.. b
y2 Bool -> Bool -> Bool
&& c
z1 c -> c -> Bool
..==. c
z2 Bool -> Bool -> Bool
&& d
w1 d -> d -> Bool
...== d
w2

quadrupleOrd :: (a->a->Bool) -> (b->b->Bool) -> (c->c->Bool) -> (d->d->Bool)
             -> (a,b,c,d) -> (a,b,c,d) -> Bool
quadrupleOrd :: (a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (d -> d -> Bool)
-> (a, b, c, d)
-> (a, b, c, d)
-> Bool
quadrupleOrd a -> a -> Bool
(<=...) b -> b -> Bool
(.<=..) c -> c -> Bool
(..<=.) d -> d -> Bool
(...<=) (a
x1,b
y1,c
z1,d
w1) (a
x2,b
y2,c
z2,d
w2) =
  a
x1 a -> a -> Bool
<... a
x2 Bool -> Bool -> Bool
|| a
x1 a -> a -> Bool
==... a
x2 Bool -> Bool -> Bool
&& (b -> b -> Bool)
-> (c -> c -> Bool)
-> (d -> d -> Bool)
-> (b, c, d)
-> (b, c, d)
-> Bool
forall a b c.
(a -> a -> Bool)
-> (b -> b -> Bool)
-> (c -> c -> Bool)
-> (a, b, c)
-> (a, b, c)
-> Bool
tripleOrd b -> b -> Bool
(.<=..) c -> c -> Bool
(..<=.) d -> d -> Bool
(...<=) (b
y1,c
z1,d
w1) (b
y2,c
z2,d
w2)
  where
  a
x <... :: a -> a -> Bool
<...  a
y = a
x a -> a -> Bool
<=... a
y Bool -> Bool -> Bool
&& Bool -> Bool
not (a
y a -> a -> Bool
<=... a
x)
  a
x ==... :: a -> a -> Bool
==... a
y = a
x a -> a -> Bool
<=... a
y Bool -> Bool -> Bool
&&      a
y a -> a -> Bool
<=... a
x

minimumOn :: Ord b => (a -> b) -> [a] -> a
minimumOn :: (a -> b) -> [a] -> a
minimumOn a -> b
f = (a -> a -> Ordering) -> [a] -> a
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering) -> (a -> b) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)

-- left/head-biased, which is different from Prelude's maximum
maximumOn :: Ord b => (a -> b) -> [a] -> a
maximumOn :: (a -> b) -> [a] -> a
maximumOn a -> b
f []     = [Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"maximumOn: empty list"
maximumOn a -> b
f [a
x]    = a
x
maximumOn a -> b
f (a
x:[a]
xs) = let y :: a
y = (a -> b) -> [a] -> a
forall b a. Ord b => (a -> b) -> [a] -> a
maximumOn a -> b
f [a]
xs
                     in if a -> b
f a
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< a -> b
f a
y
                          then a
y
                          else a
x

takeBound :: Maybe Int -> [a] -> [a]
takeBound :: Maybe Int -> [a] -> [a]
takeBound Maybe Int
Nothing  [a]
xs  =  [a]
xs
takeBound (Just Int
n) [a]
xs  =  Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
take Int
n [a]
xs

nubMerges :: Ord a => [[a]] -> [a]
nubMerges :: [[a]] -> [a]
nubMerges = (a -> a -> Ordering) -> [[a]] -> [a]
forall a. Ord a => (a -> a -> Ordering) -> [[a]] -> [a]
nubMergesBy a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare

nubMergesBy :: Ord a => (a -> a -> Ordering) -> [[a]] -> [a]
nubMergesBy :: (a -> a -> Ordering) -> [[a]] -> [a]
nubMergesBy a -> a -> Ordering
cmp [] = []
nubMergesBy a -> a -> Ordering
cmp [[a]
xs] = [a]
xs
nubMergesBy a -> a -> Ordering
cmp [[a]]
xss = (a -> a -> Ordering) -> [a] -> [a] -> [a]
forall a. (a -> a -> Ordering) -> [a] -> [a] -> [a]
nubMergeBy a -> a -> Ordering
cmp ([[a]] -> [a]
forall a. Ord a => [[a]] -> [a]
nubMerges [[a]]
yss) ([[a]] -> [a]
forall a. Ord a => [[a]] -> [a]
nubMerges [[a]]
zss)
  where
  ([[a]]
yss,[[a]]
zss) = [[a]] -> ([[a]], [[a]])
forall a. [a] -> ([a], [a])
splitHalf [[a]]
xss
  splitHalf :: [a] -> ([a], [a])
splitHalf [a]
xs = Int -> [a] -> ([a], [a])
forall a. Int -> [a] -> ([a], [a])
splitAt ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) [a]
xs

nubMergeMap :: Ord b => (a -> [b]) -> [a] -> [b]
nubMergeMap :: (a -> [b]) -> [a] -> [b]
nubMergeMap a -> [b]
f = [[b]] -> [b]
forall a. Ord a => [[a]] -> [a]
nubMerges ([[b]] -> [b]) -> ([a] -> [[b]]) -> [a] -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> [b]) -> [a] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [b]
f

compareIndex :: Eq a => [a] -> a -> a -> Ordering
compareIndex :: [a] -> a -> a -> Ordering
compareIndex [a]
xs a
x a
y =
  case (a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
x [a]
xs, a -> [a] -> Maybe Int
forall a. Eq a => a -> [a] -> Maybe Int
elemIndex a
y [a]
xs) of
    (Just  Int
i, Just  Int
j) -> Int
i Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int
j
    (Maybe Int
Nothing, Just  Int
_) -> Ordering
GT
    (Just  Int
_, Maybe Int
Nothing) -> Ordering
LT
    (Maybe Int, Maybe Int)
_                  -> Ordering
EQ