-- |
-- Module      : Test.Speculate.Utils.Class
-- Copyright   : (c) 2016-2019 Rudy Matela
-- License     : 3-Clause BSD  (see the file LICENSE)
-- Maintainer  : Rudy Matela <rudy@matela.com.br>
--
-- This module is part of Speculate.
--
-- An equivalence class type and functions to manipulate it.
module Test.Speculate.Utils.Class
  ( merge
  , mergesOn
  , mergesThat
  , rep
  , map
  , fromRep
  , Class
  )
where

import Data.Function (on)
import Data.List (partition)
import Prelude hiding (map)
import qualified Prelude as P (map)

type Class a = (a,[a])

map :: (a -> b) -> Class a -> Class b
map :: (a -> b) -> Class a -> Class b
map a -> b
f (a
x,[a]
xs) = (a -> b
f a
x, (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
P.map a -> b
f [a]
xs)

rep :: Class a -> a
rep :: Class a -> a
rep (a
x,[a]
_) = a
x

fromRep :: a -> Class a
fromRep :: a -> Class a
fromRep a
x = (a
x,[])

mergesOn :: Eq b => (a -> b) -> [Class a] -> [Class a]
mergesOn :: (a -> b) -> [Class a] -> [Class a]
mergesOn a -> b
f = (Class (a, b) -> Class a) -> [Class (a, b)] -> [Class a]
forall a b. (a -> b) -> [a] -> [b]
P.map (((a, b) -> a) -> Class (a, b) -> Class a
forall a b. (a -> b) -> Class a -> Class b
map (a, b) -> a
forall a b. (a, b) -> a
fst)
           ([Class (a, b)] -> [Class a])
-> ([Class a] -> [Class (a, b)]) -> [Class a] -> [Class a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, b) -> (a, b) -> Bool) -> [Class (a, b)] -> [Class (a, b)]
forall a. (a -> a -> Bool) -> [Class a] -> [Class a]
mergesThat (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> ((a, b) -> b) -> (a, b) -> (a, b) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (a, b) -> b
forall a b. (a, b) -> b
snd)
           ([Class (a, b)] -> [Class (a, b)])
-> ([Class a] -> [Class (a, b)]) -> [Class a] -> [Class (a, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Class a -> Class (a, b)) -> [Class a] -> [Class (a, b)]
forall a b. (a -> b) -> [a] -> [b]
P.map ((a -> (a, b)) -> Class a -> Class (a, b)
forall a b. (a -> b) -> Class a -> Class b
map ((a -> (a, b)) -> Class a -> Class (a, b))
-> (a -> (a, b)) -> Class a -> Class (a, b)
forall a b. (a -> b) -> a -> b
$ \a
x -> (a
x, a -> b
f a
x))

mergesThat :: (a -> a -> Bool) -> [Class a] -> [Class a]
mergesThat :: (a -> a -> Bool) -> [Class a] -> [Class a]
mergesThat a -> a -> Bool
_     []     = []
mergesThat a -> a -> Bool
(===) (Class a
c:[Class a]
cs) = (Class a -> Class a -> Class a) -> Class a -> [Class a] -> Class a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Class a -> Class a -> Class a
forall a. Class a -> Class a -> Class a
merge Class a
c [Class a]
cs' Class a -> [Class a] -> [Class a]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [Class a] -> [Class a]
forall a. (a -> a -> Bool) -> [Class a] -> [Class a]
mergesThat a -> a -> Bool
(===) [Class a]
cs''
  where
  ([Class a]
cs',[Class a]
cs'') = (Class a -> Bool) -> [Class a] -> ([Class a], [Class a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\Class a
c' -> Class a -> a
forall a. Class a -> a
rep Class a
c a -> a -> Bool
=== Class a -> a
forall a. Class a -> a
rep Class a
c') [Class a]
cs

merge :: Class a -> Class a -> Class a
merge :: Class a -> Class a -> Class a
merge (a
x,[a]
xs) (a
y,[a]
ys) = (a
x,[a]
xs [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ a
ya -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
ys)