{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE StandaloneDeriving    #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- | Copyright :  (c) 2006-2007 Roman Leshchinskiy
--                (c) 2013 Simon Meier
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Simon Meier <iridcode@gmail.com>
-- Stability   :  experimental
-- Portability :  GHC
--
-- The strict variant of the standard Haskell pairs and the corresponding
-- variants of the functions from "Data.Tuple".
--
-----------------------------------------------------------------------------


module Data.Tuple.Strict (
    Pair(..)
  , fst
  , snd
  , curry
  , uncurry
  , 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 ((<$>))
import           Control.DeepSeq     (NFData (..))
import           Control.Lens.Iso    (Strict (..), iso)
import           Data.Aeson          (FromJSON (..), ToJSON (..))
import           Data.Binary         (Binary (..))
import           Data.Data           (Data (..), Typeable2 (..))
import           Data.Monoid         (Monoid (..))
#if __GLASGOW_HASKELL__ >= 706
import           GHC.Generics        (Generic (..))
#endif
import           Test.QuickCheck     (Arbitrary (..))

-- Utilities
------------

toStrict :: (a, b) -> Pair a b
toStrict (a, b) = a :!: b

toLazy :: Pair a b -> (a, b)
toLazy (a :!: b) = (a, b)


-- missing instances
--------------------

deriving instance (Data a, Data b) => Data     (Pair a b)
deriving instance Typeable2 Pair

-- fails with compiler panic on GHC 7.4.2
#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)

-- deepseq
instance (NFData a, NFData b) => NFData (Pair a b) where
  rnf = rnf . toLazy

-- binary
instance (Binary a, Binary b) => Binary (Pair a b) where
  put = put . toLazy
  get = toStrict <$> get

-- aeson
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

-- quickcheck
instance (Arbitrary a, Arbitrary b) => Arbitrary (Pair a b) where
  arbitrary = toStrict <$> arbitrary
  shrink    = map toStrict . shrink . toLazy

-- lens
instance Strict (a, b) (Pair a b) where
  strict = iso toStrict toLazy



{-  To be added once they make it to base

instance Foldable (Pair e) where
  foldMap f (_,x) = f x

instance Traversable (Pair e) where
  traverse f (e,x) = (,) e <$> f x
-}


-- missing functions
--------------------

-- | Zip for strict pairs (defined with zipWith).
zip :: [a] -> [b] -> [Pair a b]
zip x y = zipWith (:!:) x y

-- | Unzip for stict pairs into a (lazy) pair of lists.
unzip :: [Pair a b] -> ([a], [b])
unzip x = ( map fst x
          , map snd x
          )

------------------------------------------------------------------------------
-- Code required to make this module independent of the 'strict' package
------------------------------------------------------------------------------

{-
-- | The type of strict pairs. Note that
--
-- > (x :!: _|_) = (_|_ :!: y) = _|_
data Pair a b = !a :!: !b
    deriving(Eq, Ord, Show, Read, Bounded, Ix, Data, Typeable, Generic)

instance StrictType (Pair a b) where
    type LazyVariant (Pair a b) = (a, b)

    toStrict (a, b)    = a :!: b
    toLazy   (a :!: b) = (a, b)

instance Functor (Pair e) where
    fmap f = toStrict . fmap f . toLazy

-- | Extract the first component of a strict pair.
fst :: Pair a b -> a
fst (x :!: _) = x

-- | Extract the second component of a strict pair.
snd :: Pair a b -> b
snd (_ :!: y) = y

-- | Curry a function on strict pairs.
curry :: (Pair a b -> c) -> a -> b -> c
curry f x y = f (x :!: y)

-- | Convert a curried function to a function on strict pairs.
uncurry :: (a -> b -> c) -> Pair a b -> c
uncurry f (x :!: y) = f x y
-}