{-# 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
-}