module Data.UniformPair (Pair(..), fstP,sndP, firstP, secondP, compareSwap) where
import Data.Monoid (Monoid(..),(<>))
import Data.Functor ((<$>))
import Data.Foldable (Foldable(..))
import Data.Traversable (Traversable(..))
import Control.Applicative (Applicative(..))
import Text.ShowF (ShowF(..))
infix 1 :#
data Pair a = a :# a deriving (Eq, Ord, Show, Functor, Foldable,Traversable)
instance ShowF Pair where
showsPrecF = showsPrec
fstP :: Pair a -> a
fstP (a :# _) = a
sndP :: Pair a -> a
sndP (_ :# b) = b
firstP, secondP :: (a -> a) -> (Pair a -> Pair a)
firstP f (a :# b) = f a :# b
secondP g (a :# b) = a :# g b
instance Monoid a => Monoid (Pair a) where
mempty = mempty :# mempty
(a :# b) `mappend` (c :# d) = (a <> c) :# (b <> d)
instance Applicative Pair where
pure a = a :# a
(f :# g) <*> (a :# b) = f a :# g b
instance Monad Pair where
return = pure
m >>= f = joinP (f <$> m)
joinP :: Pair (Pair a) -> Pair a
joinP ((a :# _) :# (_ :# d)) = a :# d
compareSwap :: Ord a => Pair a -> Pair a
compareSwap (a :# b) | a <= b = a :# b
| otherwise = b :# a