module Data.Tuple.Strict (
Pair(..)
, fst
, snd
, curry
, uncurry
, swap
, zip
, unzip
) where
import Data.Strict.Tuple (Pair ((:!:)), curry, fst, snd, uncurry)
import Prelude hiding (curry, fst, snd, uncurry, unzip,
zip)
import Control.Applicative (Applicative ((<*>)), (<$>))
import Control.DeepSeq (NFData (..))
#if MIN_VERSION_lens(4,0,0)
import Control.Lens.At (Index)
import Control.Lens.Each (Each(..))
#else
import Control.Lens.Each (Index, Each(..))
#endif
import Control.Lens.Iso (Strict (..), Swapped (..), iso)
import Control.Lens.Indexed (indexed)
import Control.Lens.Operators ((<&>))
import Control.Lens.Tuple (Field1 (..), Field2 (..))
import Data.Aeson (FromJSON (..), ToJSON (..))
import Data.Bifoldable (Bifoldable (..))
import Data.Bifunctor (Bifunctor (..))
import Data.Bitraversable (Bitraversable (..))
import Data.Binary (Binary (..))
#if MIN_VERSION_base(4,7,0)
import Data.Data (Data (..), Typeable)
#else
import Data.Data (Data (..), Typeable2 (..))
#endif
import Data.Monoid (Monoid (..))
import qualified Data.Tuple as L ()
#if __GLASGOW_HASKELL__ >= 706
import GHC.Generics (Generic (..))
#endif
import Test.QuickCheck (Arbitrary (..))
toStrict :: (a, b) -> Pair a b
toStrict (a, b) = a :!: b
toLazy :: Pair a b -> (a, b)
toLazy (a :!: b) = (a, b)
deriving instance (Data a, Data b) => Data (Pair a b)
#if MIN_VERSION_base(4,7,0)
deriving instance Typeable Pair
#else
deriving instance Typeable2 Pair
#endif
#if __GLASGOW_HASKELL__ >= 706
deriving instance Generic (Pair a b)
#endif
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 (NFData a, NFData b) => NFData (Pair a b) where
rnf = rnf . toLazy
instance (Binary a, Binary b) => Binary (Pair a b) where
put = put . toLazy
get = toStrict <$> get
instance (ToJSON a, ToJSON b) => ToJSON (Pair a b) where
toJSON = toJSON . toLazy
instance (FromJSON a, FromJSON b) => FromJSON (Pair a b) where
parseJSON val = toStrict <$> parseJSON val
instance (Arbitrary a, Arbitrary b) => Arbitrary (Pair a b) where
arbitrary = toStrict <$> arbitrary
shrink = map toStrict . shrink . toLazy
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
instance Bifoldable Pair where
bifold (a :!: b) = a `mappend` b
bifoldMap f g (a :!: b) = f a `mappend` g b
bifoldr f g c (a :!: b) = g b (f a c)
bifoldl f g c (a :!: b) = g (f c a) b
instance Bitraversable Pair where
bitraverse f g (a :!: b) = (:!:) <$> f a <*> g b
bisequenceA (a :!: b) = (:!:) <$> a <*> b
instance Strict (a, b) (Pair a b) where
strict = iso toStrict toLazy
instance Field1 (Pair a b) (Pair a' b) a a' where
_1 k (a :!: b) = indexed k (0 :: Int) a <&> \a' -> (a' :!: b)
instance Field2 (Pair a b) (Pair a b') b b' where
_2 k (a :!: b) = indexed k (1 :: Int) b <&> \b' -> (a :!: b')
instance Swapped Pair where
swapped = iso swap swap
type instance Index (Pair a b) = Int
#if MIN_VERSION_lens(4,0,0)
instance (a~a', b~b') => Each (Pair a a') (Pair b b') a b where
each f ~(a :!: b) = (:!:) <$> f a <*> f b
#else
instance (Applicative f, a~a', b~b') => Each f (Pair a a') (Pair b b') a b where
each f (a :!: b) = (:!:) <$> indexed f (0::Int) a <*> indexed f (1::Int) b
#endif
swap :: Pair a b -> Pair b a
swap (a :!: b) = b :!: a
zip :: [a] -> [b] -> [Pair a b]
zip x y = zipWith (:!:) x y
unzip :: [Pair a b] -> ([a], [b])
unzip x = ( map fst x
, map snd x
)