module Data.Strict.Tuple (
Pair(..)
, (:!:)
, fst
, snd
, curry
, uncurry
, swap
, zip
, unzip
) where
import Prelude hiding (fst, snd, curry, uncurry, zip, unzip)
import Data.Semigroup(Semigroup(..))
import Data.Bifunctor (Bifunctor(..))
import Data.Ix (Ix)
import GHC.Generics (Generic, Generic1)
import Data.Data (Data, Typeable)
import Data.Strict.Class
infixl 2 :!:
data Pair a b = !a :!: !b
deriving (Eq, Ord, Show, Read, Bounded, Ix, Functor, Foldable, Traversable, Generic, Generic1, Data, Typeable)
type (:!:) = Pair
instance IsStrict (a, b) (Pair a b) where
toStrict (a, b) = a :!: b
fromStrict (a :!: b) = (a, b)
instance (Semigroup a, Semigroup b) => Semigroup (Pair a b) where
(x1 :!: y1) <> (x2 :!: y2) = (x1 <> x2) :!: (y1 <> y2)
instance (Monoid a, Monoid b) => Monoid (Pair a b) where
mempty = mempty :!: mempty
(x1 :!: y1) `mappend` (x2 :!: y2) = (x1 `mappend` x2) :!: (y1 `mappend` y2)
instance Bifunctor Pair where
bimap f g (a :!: b) = f a :!: g b
first f (a :!: b) = f a :!: b
second g (a :!: b) = a :!: g b
fst :: Pair a b -> a
fst (x :!: _) = x
snd :: Pair a b -> b
snd (_ :!: y) = y
curry :: (Pair a b -> c) -> a -> b -> c
curry f x y = f (x :!: y)
uncurry :: (a -> b -> c) -> Pair a b -> c
uncurry f (x :!: y) = f x y
swap :: Pair a b -> Pair b a
swap (a :!: b) = b :!: a
zip :: [a] -> [b] -> [Pair a b]
zip = zipWith (:!:)
unzip :: [Pair a b] -> ([a], [b])
unzip x = (map fst x, map snd x)