rest-rewrite-0.1: src/Language/REST/EquivalenceClass.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}

module Language.REST.EquivalenceClass
    ( isMember
    , isSingleton
    , insert
    , union
    , singleton
    , fromList
    , toList
    , head
    , EquivalenceClass
    , elems
    , toPairs
    , isSubsetOf
    ) where

import GHC.Generics (Generic)
import Data.Hashable
import qualified Data.Set as S
import qualified Data.List as L
import Prelude hiding (head)

import Language.REST.Types
import Language.REST.SMT

newtype EquivalenceClass a =
  EquivalenceClass (S.Set a) deriving (Ord, Eq, Generic, Hashable)

instance Show a => Show (EquivalenceClass a) where
    show (EquivalenceClass xs) = L.intercalate " = " (map show (S.toList xs)) 



{-# INLINE isSubsetOf #-}
isSubsetOf (EquivalenceClass xs) (EquivalenceClass ys) = xs `S.isSubsetOf` ys

head :: EquivalenceClass a -> a
head (EquivalenceClass xs) = L.head $ S.toList xs

isSingleton (EquivalenceClass xs) = S.size xs == 1

{-# INLINE isMember #-}
isMember :: (Ord a, Eq a, Hashable a) => a -> EquivalenceClass a -> Bool
isMember x (EquivalenceClass xs) = S.member x xs

insert :: (Ord a, Eq a, Hashable a) => a -> EquivalenceClass a -> EquivalenceClass a
insert x (EquivalenceClass xs) = EquivalenceClass (S.insert x xs)

union :: (Ord a, Eq a, Hashable a) => EquivalenceClass a -> EquivalenceClass a -> EquivalenceClass a
union (EquivalenceClass xs) (EquivalenceClass ys) = 
    EquivalenceClass (S.union xs ys)

singleton :: (Ord a, Eq a, Hashable a) => a -> EquivalenceClass a
singleton = EquivalenceClass . S.singleton

fromList :: (Ord a, Eq a, Hashable a) => [a] -> EquivalenceClass a
fromList = EquivalenceClass . S.fromList

toList :: EquivalenceClass a -> [a]
toList (EquivalenceClass s) = S.toList s

toPairs e =
  let
    list = toList e
  in
    if length list < 2
    then []
    else zip list (tail list)

{-# INLINE elems #-}
elems (EquivalenceClass ec) = ec