{-# 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 'L.Either' type and the
-- corresponding variants of the functions from "Data.Either".
--
-- Note that the strict 'Either' type is not an applicative functor, and
-- therefore also no monad. The reasons are the same as the ones for the
-- strict @Maybe@ type, which are explained in "Data.Maybe.Strict".
--
-----------------------------------------------------------------------------
module Data.Either.Strict (
    Either(Left, Right)
  , isRight
  , isLeft
  , either
  , lefts
  , rights
  , partitionEithers
) where

import           Data.Strict.Either  (Either (Left, Right), either, isLeft,
                                      isRight)
import           Prelude             hiding (Either (..), either)
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 (..))
#if __GLASGOW_HASKELL__ >= 706
import           GHC.Generics        (Generic (..))
#endif
import           Test.QuickCheck     (Arbitrary (..))


-- Utilities
------------
toStrict :: L.Either a b -> Either a b
toStrict (L.Left x)  = Left x
toStrict (L.Right y) = Right y

toLazy :: Either a b -> L.Either a b
toLazy (Left x)  = L.Left x
toLazy (Right y) = L.Right y


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

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

#if __GLASGOW_HASKELL__ >= 706
deriving instance Generic  (Either a b)
#endif


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

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

-- aeson
instance (ToJSON a, ToJSON b) => ToJSON (Either a b) where
  toJSON = toJSON . toLazy

instance (FromJSON a, FromJSON b) => FromJSON (Either a b) where
  parseJSON val = toStrict <$> parseJSON val

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

-- lens
instance Strict (L.Either a b) (Either a b) where
  strict = iso toStrict toLazy

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

-- | Analogous to 'L.lefts' in "Data.Either".
lefts   :: [Either a b] -> [a]
lefts x = [a | Left a <- x]

-- | Analogous to 'L.rights' in "Data.Either".
rights   :: [Either a b] -> [b]
rights x = [a | Right a <- x]

-- | Analogous to 'L.partitionEithers' in "Data.Either".
partitionEithers :: [Either a b] -> ([a],[b])
partitionEithers =
    Prelude.foldr (either left right) ([],[])
  where
    left  a ~(l, r) = (a:l, r)
    right a ~(l, r) = (l, a:r)


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

{-
-- | The strict choice type.
--
-- Note that this type is not an applicative functor, and therefore also no
-- monad. The reasons are the same as the ones explained in the documentation
-- of the strict 'Data.Strict.Maybe.Maybe' type.
data Either a b = Left !a | Right !b
    deriving(Eq, Ord, Read, Show)
-}

{-
instance Functor (Either a) where
  fmap f  = toStrict . fmap f . toLazy

instance Foldable (Either a) where
  foldr _ y (Left _)  = y
  foldr f y (Right x) = f x y

  foldl _ y (Left _)  = y
  foldl f y (Right x) = f y x

instance Traversable (Either e) where
  traverse _ (Left x)  = pure (Left x)
  traverse f (Right x) = Right <$> f x

-- | Analogous to 'L.either' in "Data.Either".
either :: (a -> c) -> (b -> c) -> Either a b -> c
either f g = L.either f g . toLazy
-}

{-
-- | Analogous to 'L.isLeft' in "Data.Either", which will be included in base
-- \> 4.6.
isLeft :: Either a b -> Bool
isLeft (Left  _) = True
isLeft (Right _) = False

-- | Analogous to 'L.isRight' in "Data.Either", which will be included in base
-- \> 4.6.
isRight :: Either a b -> Bool
isRight (Left  _) = False
isRight (Right _) = True
-}