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 qualified Prelude as L
import Control.Applicative (Applicative ((<*>)), (<$>))
import Control.DeepSeq (NFData (..))
import Control.Lens.Each (Index, Each(..))
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 (..))
import Data.Data (Data (..), Typeable2 (..))
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)
deriving instance Typeable2 Pair
#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
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
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
)