these 1.0.1 → 1.2.1
raw patch · 5 files changed
Files
- CHANGELOG.md +33/−0
- src/Data/Functor/These.hs +83/−162
- src/Data/These.hs +146/−197
- src/Data/These/Combinators.hs +8/−35
- these.cabal +26/−64
CHANGELOG.md view
@@ -1,3 +1,36 @@+# 1.2.1++- Support GHC-8.6.5...GHC-9.10.1++# 1.2++- Depend on `bifunctor-classes-compat` instead of `bifunctors`+ See changelog note in `bifunctors-5.6`: https://hackage.haskell.org/package/bifunctors-5.6/changelog+ This is breaking change, but affects only GHC-8.0 and older users.+ In that case you should check various combinations of newer/older+ `bifunctors`, `these` (and e.g. `semialign`) packages.+- Depend on `assoc-1.1`. Since version 1.1 `assoc` has an almost trivial+ dependency footprint, so `these` depends on it unconditionally.+- Add `Bifoldable1 These` instance+- Add `Foldable1 (Data.Functor.These1 f g)` instance+- Change `Eq (These1 f g a)`, `Ord`, `Read`, `Show`, `NFData` instances similarly to how+ they are changed for `Product` and `Sum` in `base-4.18.0.0`.++# 1.1.1.1++- Workaround GCC-4 C-preprocessor bug++# 1.1.1++- These doesn't depend on `base-compat` anymore+- Add `NFData1/2`, `Hashable1/2`, `Eq1/2` ... instances++# 1.1++- Reverse dependency with `aeson`.+ - The `QuickCheck` instances are moved into `quickcheck-instances`+ - The `semigroupoids` instances are gone for now.+ # 1.0.1 - add `partitionEithersNE :: NonEmpty (Either a b) -> These (NonEmpty a) (NonEmpty b)`
src/Data/Functor/These.hs view
@@ -1,64 +1,36 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Trustworthy #-}--#if MIN_VERSION_base(4,9,0)-#define LIFTED_FUNCTOR_CLASSES 1-#else-#if MIN_VERSION_transformers(0,5,0)-#define LIFTED_FUNCTOR_CLASSES 1-#else-#if MIN_VERSION_transformers_compat(0,5,0) && !MIN_VERSION_transformers(0,4,0)-#define LIFTED_FUNCTOR_CLASSES 1-#endif-#endif-#endif- {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Safe #-} module Data.Functor.These ( These1 (..), ) where -import Prelude ()-import Prelude.Compat--import Data.Functor.Classes- (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..), compare1, eq1, readsPrec1,- showsPrec1)+import Data.Foldable (Foldable)+import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..))+import Data.Monoid (Monoid (..))+import Data.Semigroup (Semigroup (..))+import Data.Traversable (Traversable) import GHC.Generics (Generic)+import Prelude+ (Bool (..), Eq (..), Functor, Ord (..), Ordering (..), Read (..),+ Show (..), lex, readParen, return, seq, showChar, showParen, showString,+ ($), (&&), (.)) +import qualified Data.Foldable as F+import qualified Data.Foldable1 as F1 -#if MIN_VERSION_deepseq(1,4,3)-import Control.DeepSeq (NFData (..), NFData1 (..), rnf1)-#endif+import Control.DeepSeq (NFData (..), NFData1 (..)) -#if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1)-#endif -#if __GLASGOW_HASKELL__ >= 708 import Data.Data (Data) import Data.Typeable (Typeable)-#endif -#ifdef MIN_VERSION_aeson-import Data.Aeson- (FromJSON (..), FromJSON1 (..), ToJSON (..), ToJSON1 (..), (.=))-import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Encoding as Aeson (pair)-import qualified Data.HashMap.Strict as HM-#endif--#ifdef MIN_VERSION_QuickCheck-import Test.QuickCheck- (Arbitrary (..), Arbitrary1 (..), arbitrary1, liftShrink2, oneof,- shrink1)-#endif- ------------------------------------------------------------------------------- -- These1 -------------------------------------------------------------------------------@@ -67,21 +39,13 @@ = This1 (f a) | That1 (g a) | These1 (f a) (g a)- deriving (Functor, Foldable, Traversable, Generic-#if __GLASGOW_HASKELL__ >= 706- , Generic1-#endif-#if __GLASGOW_HASKELL__ >= 708- , Typeable, Data-#endif- )+ deriving (Functor, Foldable, Traversable, Generic, Generic1, Typeable, Data) ------------------------------------------------------------------------------- -- Eq1 ------------------------------------------------------------------------------- instance (Eq1 f, Eq1 g) => Eq1 (These1 f g) where-#ifdef LIFTED_FUNCTOR_CLASSES liftEq eq (This1 f) (This1 f') = liftEq eq f f' liftEq eq (That1 g) (That1 g') = liftEq eq g g' liftEq eq (These1 f g) (These1 f' g') = liftEq eq f f' && liftEq eq g g'@@ -89,22 +53,12 @@ liftEq _ This1 {} _ = False liftEq _ That1 {} _ = False liftEq _ These1 {} _ = False-#else- eq1 (This1 f) (This1 f') = eq1 f f'- eq1 (That1 g) (That1 g') = eq1 g g'- eq1 (These1 f g) (These1 f' g') = eq1 f f' && eq1 g g' - eq1 This1 {} _ = False- eq1 That1 {} _ = False- eq1 These1 {} _ = False-#endif- ------------------------------------------------------------------------------- -- Ord1 ------------------------------------------------------------------------------- instance (Ord1 f, Ord1 g) => Ord1 (These1 f g) where-#ifdef LIFTED_FUNCTOR_CLASSES liftCompare cmp (This1 f) (This1 f') = liftCompare cmp f f' liftCompare _cmp (This1 _) _ = LT liftCompare _cmp _ (This1 _) = GT@@ -115,26 +69,12 @@ liftCompare cmp (These1 f g) (These1 f' g') = liftCompare cmp f f' `mappend` liftCompare cmp g g'-#else- compare1 (This1 f) (This1 f') = compare1 f f'- compare1 (This1 _) _ = LT- compare1 _ (This1 _) = GT - compare1 (That1 g) (That1 g') = compare1 g g'- compare1 (That1 _) _ = LT- compare1 _ (That1 _) = GT-- compare1 (These1 f g) (These1 f' g') =- compare1 f f' `mappend` compare1 g g'-#endif-- ------------------------------------------------------------------------------- -- Show1 ------------------------------------------------------------------------------- instance (Show1 f, Show1 g) => Show1 (These1 f g) where-#ifdef LIFTED_FUNCTOR_CLASSES liftShowsPrec sp sl d (This1 f) = showParen (d > 10) $ showString "This1 " . liftShowsPrec sp sl 11 f@@ -146,26 +86,12 @@ . liftShowsPrec sp sl 11 f . showChar ' ' . liftShowsPrec sp sl 11 g-#else- showsPrec1 d (This1 f) = showParen (d > 10)- $ showString "This1 "- . showsPrec1 11 f- showsPrec1 d (That1 g) = showParen (d > 10)- $ showString "That1 "- . showsPrec1 11 g- showsPrec1 d (These1 f g) = showParen (d > 10)- $ showString "These1 "- . showsPrec1 11 f- . showChar ' '- . showsPrec1 11 g-#endif ------------------------------------------------------------------------------- -- Read1 ------------------------------------------------------------------------------- instance (Read1 f, Read1 g) => Read1 (These1 f g) where-#ifdef LIFTED_FUNCTOR_CLASSES liftReadsPrec rp rl d = readParen (d > 10) $ \s0 -> do (t, s1) <- lex s0 case t of@@ -180,102 +106,97 @@ (y, s3) <- liftReadsPrec rp rl 11 s2 return (These1 x y, s3) _ -> []-#else- readsPrec1 d = readParen (d > 10) $ \s0 -> do++-------------------------------------------------------------------------------+-- Eq, Ord, Show, Read+-------------------------------------------------------------------------------++instance (Eq (f a), Eq (g a), Eq a) => Eq (These1 f g a) where+ This1 f == This1 f' = f == f'+ That1 g == That1 g' = g == g'+ These1 f g == These1 f' g' = f == f' && g == g'++ This1 {} == _ = False+ That1 {} == _ = False+ These1 {} == _ = False++instance (Ord (f a), Ord (g a), Ord a) => Ord (These1 f g a) where+ compare (This1 f) (This1 f') = compare f f'+ compare (This1 _) _ = LT+ compare _ (This1 _) = GT++ compare (That1 g) (That1 g') = compare g g'+ compare (That1 _) _ = LT+ compare _ (That1 _) = GT++ compare (These1 f g) (These1 f' g') =+ compare f f' `mappend` compare g g'++instance (Show (f a), Show (g a), Show a) => Show (These1 f g a) where+ showsPrec d (This1 f) = showParen (d > 10)+ $ showString "This1 "+ . showsPrec 11 f+ showsPrec d (That1 g) = showParen (d > 10)+ $ showString "That1 "+ . showsPrec 11 g+ showsPrec d (These1 f g) = showParen (d > 10)+ $ showString "These1 "+ . showsPrec 11 f+ . showChar ' '+ . showsPrec 11 g++instance (Read (f a), Read (g a), Read a) => Read (These1 f g a) where+ readsPrec d = readParen (d > 10) $ \s0 -> do (t, s1) <- lex s0 case t of "This1" -> do- (x, s2) <- readsPrec1 11 s1+ (x, s2) <- readsPrec 11 s1 return (This1 x, s2) "That1" -> do- (y, s2) <- readsPrec1 11 s1+ (y, s2) <- readsPrec 11 s1 return (That1 y, s2) "These1" -> do- (x, s2) <- readsPrec1 11 s1- (y, s3) <- readsPrec1 11 s2+ (x, s2) <- readsPrec 11 s1+ (y, s3) <- readsPrec 11 s2 return (These1 x y, s3) _ -> []-#endif ---------------------------------------------------------------------------------- Eq, Ord, Show, Read----------------------------------------------------------------------------------instance (Eq1 f, Eq1 g, Eq a) => Eq (These1 f g a) where (==) = eq1-instance (Ord1 f, Ord1 g, Ord a) => Ord (These1 f g a) where compare = compare1-instance (Show1 f, Show1 g, Show a) => Show (These1 f g a) where showsPrec = showsPrec1-instance (Read1 f, Read1 g, Read a) => Read (These1 f g a) where readsPrec = readsPrec1--------------------------------------------------------------------------------- -- deepseq ------------------------------------------------------------------------------- -#if MIN_VERSION_deepseq(1,4,3) -- | This instance is available only with @deepseq >= 1.4.3.0@ instance (NFData1 f, NFData1 g) => NFData1 (These1 f g) where liftRnf r (This1 x) = liftRnf r x liftRnf r (That1 y) = liftRnf r y liftRnf r (These1 x y) = liftRnf r x `seq` liftRnf r y --- | This instance is available only with @deepseq >= 1.4.3.0@-instance (NFData1 f, NFData1 g, NFData a) => NFData (These1 f g a) where- rnf = rnf1-#endif+-- | Available always+--+-- @since 1.2+instance (NFData (f a), NFData (g a), NFData a) => NFData (These1 f g a) where+ rnf (This1 x) = rnf x+ rnf (That1 y) = rnf y+ rnf (These1 x y) = rnf x `seq` rnf y ---------------------------------------------------------------------------------- aeson+-- foldable1 ------------------------------------------------------------------------------- -#ifdef MIN_VERSION_aeson-instance (ToJSON1 f, ToJSON1 g) => ToJSON1 (These1 f g) where- liftToJSON tx tl (This1 a) = Aeson.object [ "This" .= liftToJSON tx tl a ]- liftToJSON tx tl (That1 b) = Aeson.object [ "That" .= liftToJSON tx tl b ]- liftToJSON tx tl (These1 a b) = Aeson.object [ "This" .= liftToJSON tx tl a, "That" .= liftToJSON tx tl b ]-- liftToEncoding tx tl (This1 a) = Aeson.pairs $ Aeson.pair "This" (liftToEncoding tx tl a)- liftToEncoding tx tl (That1 b) = Aeson.pairs $ Aeson.pair "That" (liftToEncoding tx tl b)- liftToEncoding tx tl (These1 a b) = Aeson.pairs $- Aeson.pair "This" (liftToEncoding tx tl a) `mappend`- Aeson.pair "That" (liftToEncoding tx tl b)--instance (FromJSON1 f, FromJSON1 g) => FromJSON1 (These1 f g) where- liftParseJSON px pl = Aeson.withObject "These1" (p . HM.toList)- where- p [("This", a), ("That", b)] = These1 <$> liftParseJSON px pl a <*> liftParseJSON px pl b- p [("That", b), ("This", a)] = These1 <$> liftParseJSON px pl a <*> liftParseJSON px pl b- p [("This", a)] = This1 <$> liftParseJSON px pl a- p [("That", b)] = That1 <$> liftParseJSON px pl b- p _ = fail "Expected object with 'This' and 'That' keys only"--instance (ToJSON1 f, ToJSON1 g, ToJSON a) => ToJSON (These1 f g a) where- toJSON = Aeson.toJSON1- toEncoding = Aeson.toEncoding1--instance (FromJSON1 f, FromJSON1 g, FromJSON a) => FromJSON (These1 f g a) where- parseJSON = Aeson.parseJSON1-#endif------------------------------------------------------------------------------------ QuickCheck--------------------------------------------------------------------------------+-- | @since 1.2+instance (F1.Foldable1 f, F1.Foldable1 g) => F1.Foldable1 (These1 f g) where+ foldMap1 f (This1 x) = F1.foldMap1 f x+ foldMap1 f (That1 y) = F1.foldMap1 f y+ foldMap1 f (These1 x y) = F1.foldMap1 f x <> F1.foldMap1 f y -#ifdef MIN_VERSION_QuickCheck-instance (Arbitrary1 f, Arbitrary1 g) => Arbitrary1 (These1 f g) where- liftArbitrary arb = oneof- [ This1 <$> liftArbitrary arb- , That1 <$> liftArbitrary arb- , These1 <$> liftArbitrary arb <*> liftArbitrary arb- ]+ foldrMap1 f g (This1 x) = F1.foldrMap1 f g x+ foldrMap1 f g (That1 y) = F1.foldrMap1 f g y+ foldrMap1 f g (These1 x y) = F.foldr g (F1.foldrMap1 f g y) x - liftShrink shr (This1 x) = This1 <$> liftShrink shr x- liftShrink shr (That1 y) = That1 <$> liftShrink shr y- liftShrink shr (These1 x y) =- [ This1 x, That1 y ] ++- [ These1 x' y'- | (x', y') <- liftShrink2 (liftShrink shr) (liftShrink shr) (x, y)- ]+ head (This1 x) = F1.head x+ head (That1 y) = F1.head y+ head (These1 x _) = F1.head x -instance (Arbitrary1 f, Arbitrary1 g, Arbitrary a) => Arbitrary (These1 f g a) where- arbitrary = arbitrary1- shrink = shrink1-#endif+ last (This1 x) = F1.last x+ last (That1 y) = F1.last y+ last (These1 _ y) = F1.last y
src/Data/These.hs view
@@ -1,9 +1,8 @@-{-# LANGUAGE CPP #-}--- | The 'These' type and associated operations. Now enhanced with "Control.Lens" magic!+-- | The 'These' type and associated operations. {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE Safe #-} module Data.These ( These(..) @@ -20,61 +19,44 @@ -- * Distributivity --- -- | This distributivity combinators aren't isomorphisms!+ -- | These distributivity combinators aren't isomorphisms! , distrThesePair , undistrThesePair , distrPairThese , undistrPairThese ) where -import Prelude ()-import Prelude.Compat--import Control.DeepSeq (NFData (..))-import Data.Bifoldable (Bifoldable (..))-import Data.Bifunctor (Bifunctor (..))-import Data.Binary (Binary (..))-import Data.Bitraversable (Bitraversable (..))-import Data.Data (Data, Typeable)-import Data.Either (partitionEithers)-import Data.Hashable (Hashable (..))-import Data.List.NonEmpty (NonEmpty (..))-import Data.Semigroup (Semigroup (..))-import GHC.Generics (Generic)--#if __GLASGOW_HASKELL__ >= 706-import GHC.Generics (Generic1)-#endif--#ifdef MIN_VERSION_aeson-import Data.Aeson (FromJSON (..), ToJSON (..), (.=))--import qualified Data.Aeson as Aeson-import qualified Data.Aeson.Encoding as Aeson (pair)-import qualified Data.HashMap.Strict as HM-#endif--#ifdef MIN_VERSION_assoc+import Control.Applicative (Applicative (..), (<$>))+import Control.DeepSeq (NFData (..), NFData1 (..), NFData2 (..))+import Data.Bifoldable (Bifoldable (..))+import Data.Bifoldable1 (Bifoldable1 (..))+import Data.Bifunctor (Bifunctor (..)) import Data.Bifunctor.Assoc (Assoc (..)) import Data.Bifunctor.Swap (Swap (..))-#endif--#ifdef MIN_VERSION_semigroupoids-import Data.Functor.Bind (Apply (..), Bind (..))-import Data.Semigroup.Bifoldable (Bifoldable1 (..))-import Data.Semigroup.Bitraversable (Bitraversable1 (..))-#endif--#ifdef MIN_VERSION_QuickCheck-import Test.QuickCheck- (Arbitrary (..), Arbitrary1 (..), Arbitrary2 (..), CoArbitrary (..),- arbitrary1, oneof, shrink1)-import Test.QuickCheck.Function (Function (..), functionMap)-#endif-+import Data.Binary (Binary (..))+import Data.Bitraversable (Bitraversable (..))+import Data.Data (Data, Typeable)+import Data.Either (partitionEithers)+import Data.Foldable (Foldable (..))+import Data.Functor.Classes+ (Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..), Read1 (..), Read2 (..),+ Show1 (..), Show2 (..))+import Data.Hashable (Hashable (..))+import Data.Hashable.Lifted (Hashable1 (..), Hashable2 (..))+import Data.List.NonEmpty (NonEmpty (..))+import Data.Monoid (Monoid (..))+import Data.Semigroup (Semigroup (..))+import Data.Traversable (Traversable (..))+import GHC.Generics (Generic, Generic1)+import Prelude+ (Bool (..), Either (..), Eq (..), Functor (..), Int, Monad (..),+ Ord (..), Ordering (..), Read (..), Show (..), fail, id, lex, readParen,+ seq, showParen, showString, ($), (&&), (.)) -- $setup -- >>> import Control.Lens+-- >>> import Data.List.NonEmpty (NonEmpty (..))+-- >>> import Prelude (Either (..), map, ($)) -- -------------------------------------------------------------------------- -- | The 'These' type represents values with two non-exclusive possibilities.@@ -91,11 +73,7 @@ -- For zipping and unzipping of structures with 'These' values, see -- "Data.Align". data These a b = This a | That b | These a b- deriving (Eq, Ord, Read, Show, Typeable, Data, Generic-#if __GLASGOW_HASKELL__ >= 706- , Generic1-#endif- )+ deriving (Eq, Ord, Read, Show, Typeable, Data, Generic, Generic1) ------------------------------------------------------------------------------- -- Eliminators@@ -164,10 +142,10 @@ -- @since 1.0.1 partitionEithersNE :: NonEmpty (Either a b) -> These (NonEmpty a) (NonEmpty b) partitionEithersNE (x :| xs) = case (x, ls, rs) of- (Left y, ys, []) -> This (y :| ys)- (Left y, ys, (z:zs)) -> These (y :| ys) (z :| zs)- (Right z, [], zs) -> That (z :| zs)- (Right z, (y:ys), zs) -> These (y :| ys) (z :| zs)+ (Left y, ys, []) -> This (y :| ys)+ (Left y, ys, z:zs) -> These (y :| ys) (z :| zs)+ (Right z, [], zs) -> That (z :| zs)+ (Right z, y:ys, zs) -> These (y :| ys) (z :| zs) where (ls, rs) = partitionEithers xs @@ -207,8 +185,6 @@ -- Instances ------------------------------------------------------------------------------- -- instance (Semigroup a, Semigroup b) => Semigroup (These a b) where This a <> This b = This (a <> b) This a <> That y = These a y@@ -245,9 +221,15 @@ instance Bifoldable These where bifold = these id id mappend+ bifoldMap f g = these f g (\x y -> mappend (f x) (g y)) bifoldr f g z = these (`f` z) (`g` z) (\x y -> x `f` (y `g` z)) bifoldl f g z = these (z `f`) (z `g`) (\x y -> (z `f` x) `g` y) +-- | @since 1.2+instance Bifoldable1 These where+ bifold1 = these id id (<>)+ bifoldMap1 f g = these f g (\x y -> f x <> g y)+ instance Bitraversable These where bitraverse f _ (This x) = This <$> f x bitraverse _ g (That x) = That <$> g x@@ -272,13 +254,81 @@ This b -> This (a <> b) That y -> These a y These b y -> These (a <> b) y-instance (Hashable a, Hashable b) => Hashable (These a b) -------------------------------------------------------------------------------+-- Data.Functor.Classes+-------------------------------------------------------------------------------++-- | @since 1.1.1+instance Eq2 These where+ liftEq2 f _ (This a) (This a') = f a a'+ liftEq2 _ g (That b) (That b') = g b b'+ liftEq2 f g (These a b) (These a' b') = f a a' && g b b'+ liftEq2 _ _ _ _ = False++-- | @since 1.1.1+instance Eq a => Eq1 (These a) where+ liftEq = liftEq2 (==)++-- | @since 1.1.1+instance Ord2 These where+ liftCompare2 f _ (This a) (This a') = f a a'+ liftCompare2 _ _ (This _) _ = LT+ liftCompare2 _ _ _ (This _) = GT+ liftCompare2 _ g (That b) (That b') = g b b'+ liftCompare2 _ _ (That _) _ = LT+ liftCompare2 _ _ _ (That _) = GT+ liftCompare2 f g (These a b) (These a' b') = f a a' `mappend` g b b'++-- | @since 1.1.1+instance Ord a => Ord1 (These a) where+ liftCompare = liftCompare2 compare++-- | @since 1.1.1+instance Show a => Show1 (These a) where+ liftShowsPrec = liftShowsPrec2 showsPrec showList++-- | @since 1.1.1+instance Show2 These where+ liftShowsPrec2 sa _ _sb _ d (This a) = showParen (d > 10)+ $ showString "This "+ . sa 11 a+ liftShowsPrec2 _sa _ sb _ d (That b) = showParen (d > 10)+ $ showString "That "+ . sb 11 b+ liftShowsPrec2 sa _ sb _ d (These a b) = showParen (d > 10)+ $ showString "These "+ . sa 11 a+ . showString " "+ . sb 11 b++-- | @since 1.1.1+instance Read2 These where+ liftReadsPrec2 ra _ rb _ d = readParen (d > 10) $ \s -> cons s+ where+ cons s0 = do+ (ident, s1) <- lex s0+ case ident of+ "This" -> do+ (a, s2) <- ra 11 s1+ return (This a, s2)+ "That" -> do+ (b, s2) <- rb 11 s1+ return (That b, s2)+ "These" -> do+ (a, s2) <- ra 11 s1+ (b, s3) <- rb 11 s2+ return (These a b, s3)+ _ -> []++-- | @since 1.1.1+instance Read a => Read1 (These a) where+ liftReadsPrec = liftReadsPrec2 readsPrec readList++------------------------------------------------------------------------------- -- assoc ------------------------------------------------------------------------------- -#ifdef MIN_VERSION_assoc -- | @since 0.8 instance Swap These where swap (This a) = That a@@ -302,7 +352,6 @@ unassoc (These a (This b)) = This (These a b) unassoc (These a (That c)) = These (This a) c unassoc (These a (These b c)) = These (These a b) c-#endif ------------------------------------------------------------------------------- -- deepseq@@ -314,6 +363,18 @@ rnf (That b) = rnf b rnf (These a b) = rnf a `seq` rnf b +-- | @since 1.1.1+instance NFData a => NFData1 (These a) where+ liftRnf _rnfB (This a) = rnf a+ liftRnf rnfB (That b) = rnfB b+ liftRnf rnfB (These a b) = rnf a `seq` rnfB b++-- | @since 1.1.1+instance NFData2 These where+ liftRnf2 rnfA _rnfB (This a) = rnfA a+ liftRnf2 _rnfA rnfB (That b) = rnfB b+ liftRnf2 rnfA rnfB (These a b) = rnfA a `seq` rnfB b+ ------------------------------------------------------------------------------- -- binary -------------------------------------------------------------------------------@@ -333,143 +394,31 @@ _ -> fail "Invalid These index" ---------------------------------------------------------------------------------- semigroupoids----------------------------------------------------------------------------------#ifdef MIN_VERSION_semigroupoids-instance Bifoldable1 These where- bifold1 = these id id (<>)--instance Bitraversable1 These where- bitraverse1 f _ (This x) = This <$> f x- bitraverse1 _ g (That x) = That <$> g x- bitraverse1 f g (These x y) = These <$> f x <.> g y--instance (Semigroup a) => Bind (These a) where- This a >>- _ = This a- That x >>- k = k x- These a x >>- k = case k x of- This b -> This (a <> b)- That y -> These a y- These b y -> These (a <> b) y--instance (Semigroup a) => Apply (These a) where- This a <.> _ = This a- That _ <.> This b = This b- That f <.> That x = That (f x)- That f <.> These b x = These b (f x)- These a _ <.> This b = This (a <> b)- These a f <.> That x = These a (f x)- These a f <.> These b x = These (a <> b) (f x)-#endif------------------------------------------------------------------------------------ aeson----------------------------------------------------------------------------------#ifdef MIN_VERSION_aeson---- | @since 0.7.1-instance (ToJSON a, ToJSON b) => ToJSON (These a b) where- toJSON (This a) = Aeson.object [ "This" .= a ]- toJSON (That b) = Aeson.object [ "That" .= b ]- toJSON (These a b) = Aeson.object [ "This" .= a, "That" .= b ]-- toEncoding (This a) = Aeson.pairs $ "This" .= a- toEncoding (That b) = Aeson.pairs $ "That" .= b- toEncoding (These a b) = Aeson.pairs $ "This" .= a <> "That" .= b---- | @since 0.7.1-instance (FromJSON a, FromJSON b) => FromJSON (These a b) where- parseJSON = Aeson.withObject "These a b" (p . HM.toList)- where- p [("This", a), ("That", b)] = These <$> parseJSON a <*> parseJSON b- p [("That", b), ("This", a)] = These <$> parseJSON a <*> parseJSON b- p [("This", a)] = This <$> parseJSON a- p [("That", b)] = That <$> parseJSON b- p _ = fail "Expected object with 'This' and 'That' keys only"---- | @since 0.7.2-instance Aeson.ToJSON2 These where- liftToJSON2 toa _ _tob _ (This a) = Aeson.object [ "This" .= toa a ]- liftToJSON2 _toa _ tob _ (That b) = Aeson.object [ "That" .= tob b ]- liftToJSON2 toa _ tob _ (These a b) = Aeson.object [ "This" .= toa a, "That" .= tob b ]-- liftToEncoding2 toa _ _tob _ (This a) = Aeson.pairs $ Aeson.pair "This" (toa a)- liftToEncoding2 _toa _ tob _ (That b) = Aeson.pairs $ Aeson.pair "That" (tob b)- liftToEncoding2 toa _ tob _ (These a b) = Aeson.pairs $ Aeson.pair "This" (toa a) <> Aeson.pair "That" (tob b)---- | @since 0.7.2-instance ToJSON a => Aeson.ToJSON1 (These a) where- liftToJSON _tob _ (This a) = Aeson.object [ "This" .= a ]- liftToJSON tob _ (That b) = Aeson.object [ "That" .= tob b ]- liftToJSON tob _ (These a b) = Aeson.object [ "This" .= a, "That" .= tob b ]-- liftToEncoding _tob _ (This a) = Aeson.pairs $ "This" .= a- liftToEncoding tob _ (That b) = Aeson.pairs $ Aeson.pair "That" (tob b)- liftToEncoding tob _ (These a b) = Aeson.pairs $ "This" .= a <> Aeson.pair "That" (tob b)---- | @since 0.7.2-instance Aeson.FromJSON2 These where- liftParseJSON2 pa _ pb _ = Aeson.withObject "These a b" (p . HM.toList)- where- p [("This", a), ("That", b)] = These <$> pa a <*> pb b- p [("That", b), ("This", a)] = These <$> pa a <*> pb b- p [("This", a)] = This <$> pa a- p [("That", b)] = That <$> pb b- p _ = fail "Expected object with 'This' and 'That' keys only"---- | @since 0.7.2-instance FromJSON a => Aeson.FromJSON1 (These a) where- liftParseJSON pb _ = Aeson.withObject "These a b" (p . HM.toList)- where- p [("This", a), ("That", b)] = These <$> parseJSON a <*> pb b- p [("That", b), ("This", a)] = These <$> parseJSON a <*> pb b- p [("This", a)] = This <$> parseJSON a- p [("That", b)] = That <$> pb b- p _ = fail "Expected object with 'This' and 'That' keys only"-#endif------------------------------------------------------------------------------------ QuickCheck+-- hashable ------------------------------------------------------------------------------- -#ifdef MIN_VERSION_QuickCheck--- | @since 0.7.4-instance Arbitrary2 These where- liftArbitrary2 arbA arbB = oneof- [ This <$> arbA- , That <$> arbB- , These <$> arbA <*> arbB- ]-- liftShrink2 shrA _shrB (This x) = This <$> shrA x- liftShrink2 _shrA shrB (That y) = That <$> shrB y- liftShrink2 shrA shrB (These x y) =- [This x, That y] ++ [These x' y' | (x', y') <- liftShrink2 shrA shrB (x, y)]---- | @since 0.7.4-instance (Arbitrary a) => Arbitrary1 (These a) where- liftArbitrary = liftArbitrary2 arbitrary- liftShrink = liftShrink2 shrink---- | @since 0.7.1-instance (Arbitrary a, Arbitrary b) => Arbitrary (These a b) where- arbitrary = arbitrary1- shrink = shrink1---- | @since 0.7.1-instance (Function a, Function b) => Function (These a b) where- function = functionMap g f- where- g (This a) = Left a- g (That b) = Right (Left b)- g (These a b) = Right (Right (a, b))+instance (Hashable a, Hashable b) => Hashable (These a b) where+ hashWithSalt salt (This a) =+ salt `hashWithSalt` (0 :: Int) `hashWithSalt` a+ hashWithSalt salt (That b) =+ salt `hashWithSalt` (1 :: Int) `hashWithSalt` b+ hashWithSalt salt (These a b) =+ salt `hashWithSalt` (2 :: Int) `hashWithSalt` a `hashWithSalt` b - f (Left a) = This a- f (Right (Left b)) = That b- f (Right (Right (a, b))) = These a b+-- | @since 1.1.1+instance Hashable a => Hashable1 (These a) where+ liftHashWithSalt _hashB salt (This a) =+ salt `hashWithSalt` (0 :: Int) `hashWithSalt` a+ liftHashWithSalt hashB salt (That b) =+ (salt `hashWithSalt` (1 :: Int)) `hashB` b+ liftHashWithSalt hashB salt (These a b) =+ (salt `hashWithSalt` (2 :: Int) `hashWithSalt` a) `hashB` b --- | @since 0.7.1-instance (CoArbitrary a, CoArbitrary b) => CoArbitrary (These a b)-#endif+-- | @since 1.1.1+instance Hashable2 These where+ liftHashWithSalt2 hashA _hashB salt (This a) =+ (salt `hashWithSalt` (0 :: Int)) `hashA` a+ liftHashWithSalt2 _hashA hashB salt (That b) =+ (salt `hashWithSalt` (1 :: Int)) `hashB` b+ liftHashWithSalt2 hashA hashB salt (These a b) =+ (salt `hashWithSalt` (2 :: Int)) `hashA` a `hashB` b
src/Data/These/Combinators.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE Trustworthy #-}-{-# LANGUAGE CPP #-} -- | This module provides -- -- * specialised versions of class members e.g. 'bitraverseThese'@@ -80,19 +79,19 @@ mapThese, ) where -import Prelude ()-import Prelude.Compat--import Data.Bifunctor (bimap, first, second)-import Data.Bitraversable (bitraverse)-import Data.Maybe (isJust, mapMaybe)+import Control.Applicative (Applicative (..))+import Data.Bifunctor (bimap, first, second)+import Data.Bitraversable (bitraverse)+import Data.Maybe (isJust, mapMaybe) import Data.These+import Prelude (Bool (..), Maybe (..), curry, uncurry, (.)) -#ifdef MIN_VERSION_assoc import Data.Bifunctor.Assoc (assoc, unassoc) import Data.Bifunctor.Swap (swap)-#endif +-- $setup+-- >>> import Data.These+ ------------------------------------------------------------------------------- -- bifunctors -------------------------------------------------------------------------------@@ -125,13 +124,7 @@ -- -- @since 0.8 swapThese :: These a b -> These b a-#ifdef MIN_VERSION_assoc swapThese = swap-#else-swapThese (This a) = That a-swapThese (That b) = This b-swapThese (These a b) = These b a-#endif -- | 'These' is associative. --@@ -142,33 +135,13 @@ -- -- @since 0.8 assocThese :: These (These a b) c -> These a (These b c)-#ifdef MIN_VERSION_assoc assocThese = assoc-#else-assocThese (This (This a)) = This a-assocThese (This (That b)) = That (This b)-assocThese (That c) = That (That c)-assocThese (These (That b) c) = That (These b c)-assocThese (This (These a b)) = These a (This b)-assocThese (These (This a) c) = These a (That c)-assocThese (These (These a b) c) = These a (These b c)-#endif -- | 'These' is associative. See 'assocThese'. -- -- @since 0.8 unassocThese :: These a (These b c) -> These (These a b) c-#ifdef MIN_VERSION_assoc unassocThese = unassoc-#else-unassocThese (This a) = This (This a)-unassocThese (That (This b)) = This (That b)-unassocThese (That (That c)) = That c-unassocThese (That (These b c)) = These (That b) c-unassocThese (These a (This b)) = This (These a b)-unassocThese (These a (That c)) = These (This a) c-unassocThese (These a (These b c)) = These (These a b) c-#endif ------------------------------------------------------------------------------- -- preview
these.cabal view
@@ -1,8 +1,8 @@ cabal-version: >=1.10 name: these-version: 1.0.1+version: 1.2.1 synopsis: An either-or-both data type.-homepage: https://github.com/isomorphism/these+homepage: https://github.com/haskellari/these license: BSD3 license-file: LICENSE author: C. McCann, Oleg Grenrus@@ -31,40 +31,25 @@ * <http://hackage.haskell.org/package/monad-chronicle monad-chronicle> For transformers variant of @These@. tested-with:- GHC ==7.4.2 || ==7.6.3 || ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1+ GHC ==8.6.5+ || ==8.8.4+ || ==8.10.7+ || ==9.0.2+ || ==9.2.8+ || ==9.4.8+ || ==9.6.5+ || ==9.8.2+ || ==9.10.1 source-repository head type: git- location: https://github.com/isomorphism/these.git--flag aeson- description: Build with aeson dependency- manual: True- default: True--flag assoc- description: Build with assoc dependency- manual: True- default: True--flag semigroupoids- description: Build with semigroupoids dependency- manual: True- default: True--flag QuickCheck- description: Build with QuickCheck dependency- manual: True- default: True+ location: https://github.com/haskellari/these.git+ subdir: these library- default-language: Haskell2010- ghc-options: -Wall-- if impl(ghc >=8.0)- ghc-options: -Wno-trustworthy-safe-- hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall -Wno-trustworthy-safe+ hs-source-dirs: src exposed-modules: Data.Functor.These Data.These@@ -72,41 +57,18 @@ -- ghc boot libs build-depends:- base >=4.5.1.0 && <4.13- , binary >=0.5.1.0 && <0.10- , deepseq >=1.3.0.0 && <1.5+ base >=4.12.0.0 && <4.21+ , binary >=0.8.6.0 && <0.10+ , deepseq >=1.4.4.0 && <1.6 -- other dependencies+ -- note: we need to depend on assoc-1.1 to be sure that+ -- Bifunctor type class comes from bifunctor-classes-compat build-depends:- base-compat >=0.10.5 && <0.11- , hashable >=1.2.7.0 && <1.4-- if impl(ghc <7.5)- build-depends: ghc-prim-- if !impl(ghc >=8.2)- build-depends: bifunctors >=5.5.4 && <5.6-- if !impl(ghc >=8.0)- build-depends:- semigroups >=0.18.5 && <0.20- , transformers >=0.3.0.0 && <0.6- , transformers-compat >=0.6.5 && <0.7-- -- Ensure Data.Functor.Classes is always available- if impl(ghc >=7.10)- build-depends: transformers >=0.4.2.0-- if flag(aeson)- build-depends:- aeson >=1.4.2.0 && <1.5- , unordered-containers >=0.2.8.0 && <0.3-- if flag(assoc)- build-depends: assoc >=1 && <1.1+ assoc >=1.1.1 && <1.2+ , hashable >=1.4.4.0 && <1.5 - if flag(semigroupoids)- build-depends: semigroupoids >=5.3.2 && <5.4+ if !impl(ghc >=9.6)+ build-depends: foldable1-classes-compat >=0.1 && <0.2 - if flag(quickcheck)- build-depends: QuickCheck >=2.12.6.1 && <2.14+ x-docspec-extra-packages: lens