-- |
-- Module: NetSpider.Pair
-- Description: Swap-insensitive two-element homogeneous tuple
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- 
module NetSpider.Pair
       ( Pair(..),
         sortPair
       ) where

import Control.Applicative (Applicative(..))
import Data.Foldable (Foldable(..))
import Data.Hashable (Hashable(hashWithSalt))
import Data.Traversable (Traversable(..))

-- | 'Pair' is a two-element tuple of the same type that is
-- insensitive to swapping. 'Eq', 'Ord' and 'Hashable' instances treat
-- 'Pair's with swapped elements as equivalent.
newtype Pair a = Pair { Pair a -> (a, a)
unPair :: (a,a) }
               deriving (Int -> Pair a -> ShowS
[Pair a] -> ShowS
Pair a -> String
(Int -> Pair a -> ShowS)
-> (Pair a -> String) -> ([Pair a] -> ShowS) -> Show (Pair a)
forall a. Show a => Int -> Pair a -> ShowS
forall a. Show a => [Pair a] -> ShowS
forall a. Show a => Pair a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Pair a] -> ShowS
$cshowList :: forall a. Show a => [Pair a] -> ShowS
show :: Pair a -> String
$cshow :: forall a. Show a => Pair a -> String
showsPrec :: Int -> Pair a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Pair a -> ShowS
Show)

instance Eq a => Eq (Pair a) where
  (Pair (a
al, a
ar)) == :: Pair a -> Pair a -> Bool
== (Pair (a
bl, a
br)) = (a
al a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
bl Bool -> Bool -> Bool
&& a
ar a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
br) Bool -> Bool -> Bool
|| (a
al a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
br Bool -> Bool -> Bool
&& a
ar a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
bl)

instance Ord a => Ord (Pair a) where
  compare :: Pair a -> Pair a -> Ordering
compare Pair a
l Pair a
r = (a, a) -> (a, a) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Pair a -> (a, a)
forall a. Pair a -> (a, a)
unPair (Pair a -> (a, a)) -> Pair a -> (a, a)
forall a b. (a -> b) -> a -> b
$ Pair a -> Pair a
forall a. Ord a => Pair a -> Pair a
sortPair Pair a
l) (Pair a -> (a, a)
forall a. Pair a -> (a, a)
unPair (Pair a -> (a, a)) -> Pair a -> (a, a)
forall a b. (a -> b) -> a -> b
$ Pair a -> Pair a
forall a. Ord a => Pair a -> Pair a
sortPair Pair a
r)

instance (Ord a, Hashable a) => Hashable (Pair a) where
  hashWithSalt :: Int -> Pair a -> Int
hashWithSalt Int
s Pair a
p = Int -> (a, a) -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s ((a, a) -> Int) -> (a, a) -> Int
forall a b. (a -> b) -> a -> b
$ Pair a -> (a, a)
forall a. Pair a -> (a, a)
unPair (Pair a -> (a, a)) -> Pair a -> (a, a)
forall a b. (a -> b) -> a -> b
$ Pair a -> Pair a
forall a. Ord a => Pair a -> Pair a
sortPair Pair a
p

instance Functor Pair where
  fmap :: (a -> b) -> Pair a -> Pair b
fmap a -> b
f (Pair (a
l,a
r)) = (b, b) -> Pair b
forall a. (a, a) -> Pair a
Pair (a -> b
f a
l, a -> b
f a
r)

instance Applicative Pair where
  pure :: a -> Pair a
pure a
a = (a, a) -> Pair a
forall a. (a, a) -> Pair a
Pair (a
a,a
a)
  (Pair (a -> b
fl,a -> b
fr)) <*> :: Pair (a -> b) -> Pair a -> Pair b
<*> (Pair (a
al,a
ar)) = (b, b) -> Pair b
forall a. (a, a) -> Pair a
Pair (a -> b
fl a
al, a -> b
fr a
ar)

instance Foldable Pair where
  foldr :: (a -> b -> b) -> b -> Pair a -> b
foldr a -> b -> b
f b
start (Pair (a
l,a
r)) = (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
start [a
l,a
r]

instance Traversable Pair where
  traverse :: (a -> f b) -> Pair a -> f (Pair b)
traverse a -> f b
f (Pair (a
l,a
r)) = ((b, b) -> Pair b) -> f (b, b) -> f (Pair b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b, b) -> Pair b
forall a. (a, a) -> Pair a
Pair (f (b, b) -> f (Pair b)) -> f (b, b) -> f (Pair b)
forall a b. (a -> b) -> a -> b
$ (,) (b -> b -> (b, b)) -> f b -> f (b -> (b, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b
f a
l) f (b -> (b, b)) -> f b -> f (b, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (a -> f b
f a
r)

-- | Sort the elements in the 'Pair'.
sortPair :: Ord a => Pair a -> Pair a
sortPair :: Pair a -> Pair a
sortPair p :: Pair a
p@(Pair (a
l,a
r)) = if a
l a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
r
                          then Pair a
p
                          else (a, a) -> Pair a
forall a. (a, a) -> Pair a
Pair (a
r,a
l)