these-1.2/0000755000000000000000000000000007346545000010655 5ustar0000000000000000these-1.2/CHANGELOG.md0000644000000000000000000000754707346545000012503 0ustar0000000000000000# 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)` # 1 This is major package reogranisation. Old `these` were split into - `these` providing only `These` type and some combinators - `these-lens` providing *lens* combinators - `semialign` providing `Semialign`, `Align`, `Zip`, `Unalign` and `Unzip` classes - `semialign-indexed` providing `SemialignWithIndex` (`izipWith` and `ialignWith` members). - `monad-chronicle` providing `ChronicleT` and `MonadChronicle` Also noticeable change is `unalign :: f (These a b) -> (f a, f b)`. For the old `f (These a b) -> (f (Maybe a), f (Maybe b))` use `unzipWith (unalign . Just)`. - Many instances are added. - Since annotations are removed for all but `these` package. # 0.8.1 - Add `Semialign` `Tree`, `Tagged`, `(->) e`; `Align` `Compose` and `Proxy` instances - Allow `semigroups-0.19` and `hashable-1.3` # 0.8.0 - Split `align` and `alignWith` into own class: `Semialign`. - `ialign` has default implementation - Add `Semialign` `NonEmpty` and `Identity` instances - Add `Swap` and `Assoc` instances (type classes from `assoc` package) - Move optics into `Data.These.Lens` module, and and some combinators `Data.These.Combinators`. Also some combinators are renamed, so naming is now consistent. As the result `Data.These` has very minimal exports. - Change type of `partitionThese` (nested pairs to triple) - Add `partitionHereThere :: [These a b] -> ([a],[b])` # 0.7.6 - Tigthen lower bounds - Add dependency on `lens` - Add `assoc`, `reassoc`, `swap` and `Swapped` instance - Add since annotations for things added in 0.7.x - Add `AlignWithKey ZipList` instance - Add `Data.Align.Indexed` module. - Add `Data.Functor.These` with `These1` data type. - Add associativity law - Add `toList` property to enforce "align"-feel. - `Map` and `IntMap` `Align` instances implemented using merge combinators (when available) # 0.7.5 - Add `Compose` and `(,)` `Crosswalk` instances - Add `bitraverseThese` - GHC-8.6 support # 0.7.4 - `QuickCheck-2.10` support: `Arbitrary1/2` instances - GHC-8.2 support # 0.7.3 - Add `salign :: (Align f, Semigroup a) => f a -> f a -> f a` # 0.7.2 - Support `aeson-1`: add `FromJSON1`, `FromJSON2` `ToJSON1`, and `ToJSON2` `These` instances. # 0.7.1 - Add `AlignWithKey` in `Data.Align.Key` (added dependency `keys`) - Add `These` instances for - `binary`: `Binary` - `aeson`: `FromJSON`, `ToJSON` - `QuickCheck`: `Arbitrary`, `CoArbitrary`, `Function` - `deepseq`: `NFData` # 0.7 - Breaking change: Generalized `Monad`, `Applicative` instances of `These` and `Chronicle` to require only a `Semigroup` constraint - More efficient `Align Seq` implementation - Add `Crosswalk Seq` and `Vector` instances # 0.6.2.1 - Support quickcheck-instances-0.3.12 (tests) # 0.6.2.0 - Add support to bifunctors-5.1 these-1.2/LICENSE0000644000000000000000000000300407346545000011657 0ustar0000000000000000Copyright (c) 2012, C. McCann, 2015-2019 Oleg Grenrus All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of C. McCann nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. these-1.2/src/Data/Functor/0000755000000000000000000000000007346545000013735 5ustar0000000000000000these-1.2/src/Data/Functor/These.hs0000644000000000000000000002237507346545000015352 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Safe #-} #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 module Data.Functor.These ( These1 (..), ) where 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 (..)) #else import Control.DeepSeq (NFData (..)) #endif #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif #if __GLASGOW_HASKELL__ >= 708 import Data.Data (Data) import Data.Typeable (Typeable) #endif ------------------------------------------------------------------------------- -- These1 ------------------------------------------------------------------------------- data These1 f g a = 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 ) ------------------------------------------------------------------------------- -- 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' 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 liftCompare cmp (That1 g) (That1 g') = liftCompare cmp g g' liftCompare _cmp (That1 _) _ = LT liftCompare _cmp _ (That1 _) = GT 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 liftShowsPrec sp sl d (That1 g) = showParen (d > 10) $ showString "That1 " . liftShowsPrec sp sl 11 g liftShowsPrec sp sl d (These1 f g) = showParen (d > 10) $ showString "These1 " . 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 "This1" -> do (x, s2) <- liftReadsPrec rp rl 11 s1 return (This1 x, s2) "That1" -> do (y, s2) <- liftReadsPrec rp rl 11 s1 return (That1 y, s2) "These1" -> do (x, s2) <- liftReadsPrec rp rl 11 s1 (y, s3) <- liftReadsPrec rp rl 11 s2 return (These1 x y, s3) _ -> [] #else readsPrec1 d = readParen (d > 10) $ \s0 -> do (t, s1) <- lex s0 case t of "This1" -> do (x, s2) <- readsPrec1 11 s1 return (This1 x, s2) "That1" -> do (y, s2) <- readsPrec1 11 s1 return (That1 y, s2) "These1" -> do (x, s2) <- readsPrec1 11 s1 (y, s3) <- readsPrec1 11 s2 return (These1 x y, s3) _ -> [] #endif ------------------------------------------------------------------------------- -- 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) <- readsPrec 11 s1 return (This1 x, s2) "That1" -> do (y, s2) <- readsPrec 11 s1 return (That1 y, s2) "These1" -> do (x, s2) <- readsPrec 11 s1 (y, s3) <- readsPrec 11 s2 return (These1 x y, s3) _ -> [] ------------------------------------------------------------------------------- -- 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 #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 ------------------------------------------------------------------------------- -- foldable1 ------------------------------------------------------------------------------- -- | @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 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 head (This1 x) = F1.head x head (That1 y) = F1.head y head (These1 x _) = F1.head x last (This1 x) = F1.last x last (That1 y) = F1.last y last (These1 _ y) = F1.last y these-1.2/src/Data/0000755000000000000000000000000007346545000012315 5ustar0000000000000000these-1.2/src/Data/These.hs0000644000000000000000000004001407346545000013720 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | The 'These' type and associated operations. Now enhanced with "Control.Lens" magic! {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Safe #-} #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 module Data.These ( These(..) -- * Functions to get rid of 'These' , these , fromThese , mergeThese , mergeTheseWith -- * Partition , partitionThese , partitionHereThere , partitionEithersNE -- * Distributivity -- -- | These distributivity combinators aren't isomorphisms! , distrThesePair , undistrThesePair , distrPairThese , undistrPairThese ) where import Control.Applicative (Applicative (..), (<$>)) import Control.DeepSeq (NFData (..)) import Data.Bifoldable (Bifoldable (..)) import Data.Bifoldable1 (Bifoldable1 (..)) import Data.Bifunctor (Bifunctor (..)) import Data.Binary (Binary (..)) import Data.Bitraversable (Bitraversable (..)) import Data.Data (Data, Typeable) import Data.Either (partitionEithers) import Data.Foldable (Foldable (..)) 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) import Prelude (Bool (..), Either (..), Eq (..), Functor (..), Int, Monad (..), Ord (..), Ordering (..), Read (..), Show (..), fail, id, lex, readParen, seq, showParen, showString, ($), (&&), (.)) #if MIN_VERSION_deepseq(1,4,3) import Control.DeepSeq (NFData1 (..), NFData2 (..)) #endif #if __GLASGOW_HASKELL__ >= 706 import GHC.Generics (Generic1) #endif #ifdef MIN_VERSION_assoc import Data.Bifunctor.Assoc (Assoc (..)) import Data.Bifunctor.Swap (Swap (..)) #endif #ifdef LIFTED_FUNCTOR_CLASSES import Data.Functor.Classes (Eq1 (..), Eq2 (..), Ord1 (..), Ord2 (..), Read1 (..), Read2 (..), Show1 (..), Show2 (..)) #else import Data.Functor.Classes (Eq1 (..), Ord1 (..), Read1 (..), Show1 (..)) #endif -- $setup -- >>> import Control.Lens -- >>> import Data.List.NonEmpty (NonEmpty (..)) -- >>> import Prelude (Either (..), map, ($)) -- -------------------------------------------------------------------------- -- | The 'These' type represents values with two non-exclusive possibilities. -- -- This can be useful to represent combinations of two values, where the -- combination is defined if either input is. Algebraically, the type -- @'These' A B@ represents @(A + B + AB)@, which doesn't factor easily into -- sums and products--a type like @'Either' A (B, 'Maybe' A)@ is unclear and -- awkward to use. -- -- 'These' has straightforward instances of 'Functor', 'Monad', &c., and -- behaves like a hybrid error/writer monad, as would be expected. -- -- 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 ) ------------------------------------------------------------------------------- -- Eliminators ------------------------------------------------------------------------------- -- | Case analysis for the 'These' type. these :: (a -> c) -> (b -> c) -> (a -> b -> c) -> These a b -> c these l _ _ (This a) = l a these _ r _ (That x) = r x these _ _ lr (These a x) = lr a x -- | Takes two default values and produces a tuple. fromThese :: a -> b -> These a b -> (a, b) fromThese x y = these (`pair` y) (x `pair`) pair where pair = (,) -- | Coalesce with the provided operation. mergeThese :: (a -> a -> a) -> These a a -> a mergeThese = these id id -- | 'bimap' and coalesce results with the provided operation. mergeTheseWith :: (a -> c) -> (b -> c) -> (c -> c -> c) -> These a b -> c mergeTheseWith f g op t = mergeThese op $ bimap f g t ------------------------------------------------------------------------------- -- Partitioning ------------------------------------------------------------------------------- -- | Select each constructor and partition them into separate lists. partitionThese :: [These a b] -> ([a], [b], [(a, b)]) partitionThese [] = ([], [], []) partitionThese (t:ts) = case t of This x -> (x : xs, ys, xys) That y -> ( xs, y : ys, xys) These x y -> ( xs, ys, (x,y) : xys) where ~(xs,ys,xys) = partitionThese ts -- | Select 'here' and 'there' elements and partition them into separate lists. -- -- @since 0.8 partitionHereThere :: [These a b] -> ([a], [b]) partitionHereThere [] = ([], []) partitionHereThere (t:ts) = case t of This x -> (x : xs, ys) That y -> ( xs, y : ys) These x y -> (x : xs, y : ys) where ~(xs,ys) = partitionHereThere ts -- | Like 'partitionEithers' but for 'NonEmpty' types. -- -- * either all are 'Left' -- * either all are 'Right' -- * or there is both 'Left' and 'Right' stuff -- -- /Note:/ this is not online algorithm. In the worst case it will traverse -- the whole list before deciding the result constructor. -- -- >>> partitionEithersNE $ Left 'x' :| [Right 'y'] -- These ('x' :| "") ('y' :| "") -- -- >>> partitionEithersNE $ Left 'x' :| map Left "yz" -- This ('x' :| "yz") -- -- @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) where (ls, rs) = partitionEithers xs ------------------------------------------------------------------------------- -- Distributivity ------------------------------------------------------------------------------- distrThesePair :: These (a, b) c -> (These a c, These b c) distrThesePair (This (a, b)) = (This a, This b) distrThesePair (That c) = (That c, That c) distrThesePair (These (a, b) c) = (These a c, These b c) undistrThesePair :: (These a c, These b c) -> These (a, b) c undistrThesePair (This a, This b) = This (a, b) undistrThesePair (That c, That _) = That c undistrThesePair (These a c, These b _) = These (a, b) c undistrThesePair (This _, That c) = That c undistrThesePair (This a, These b c) = These (a, b) c undistrThesePair (That c, This _) = That c undistrThesePair (That c, These _ _) = That c undistrThesePair (These a c, This b) = These (a, b) c undistrThesePair (These _ c, That _) = That c distrPairThese :: (These a b, c) -> These (a, c) (b, c) distrPairThese (This a, c) = This (a, c) distrPairThese (That b, c) = That (b, c) distrPairThese (These a b, c) = These (a, c) (b, c) undistrPairThese :: These (a, c) (b, c) -> (These a b, c) undistrPairThese (This (a, c)) = (This a, c) undistrPairThese (That (b, c)) = (That b, c) undistrPairThese (These (a, c) (b, _)) = (These a b, c) ------------------------------------------------------------------------------- -- 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 This a <> These b y = These (a <> b) y That x <> This b = These b x That x <> That y = That (x <> y) That x <> These b y = These b (x <> y) These a x <> This b = These (a <> b) x These a x <> That y = These a (x <> y) These a x <> These b y = These (a <> b) (x <> y) instance Functor (These a) where fmap _ (This x) = This x fmap f (That y) = That (f y) fmap f (These x y) = These x (f y) instance Foldable (These a) where foldr _ z (This _) = z foldr f z (That x) = f x z foldr f z (These _ x) = f x z instance Traversable (These a) where traverse _ (This a) = pure $ This a traverse f (That x) = That <$> f x traverse f (These a x) = These a <$> f x sequenceA (This a) = pure $ This a sequenceA (That x) = That <$> x sequenceA (These a x) = These a <$> x instance Bifunctor These where bimap f _ (This a ) = This (f a) bimap _ g (That x) = That (g x) bimap f g (These a x) = These (f a) (g x) 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 bitraverse f g (These x y) = These <$> f x <*> g y instance (Semigroup a) => Applicative (These a) where pure = That 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) instance (Semigroup a) => Monad (These a) where return = pure 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 ------------------------------------------------------------------------------- -- Data.Functor.Classes ------------------------------------------------------------------------------- #ifdef LIFTED_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 #else -- | @since 1.1.1 instance Eq a => Eq1 (These a) where eq1 = (==) -- | @since 1.1.1 instance Ord a => Ord1 (These a) where compare1 = compare -- | @since 1.1.1 instance Show a => Show1 (These a) where showsPrec1 = showsPrec -- | @since 1.1.1 instance Read a => Read1 (These a) where readsPrec1 = readsPrec #endif ------------------------------------------------------------------------------- -- assoc ------------------------------------------------------------------------------- -- | @since 0.8 instance Swap These where swap (This a) = That a swap (That b) = This b swap (These a b) = These b a -- | @since 0.8 instance Assoc These where assoc (This (This a)) = This a assoc (This (That b)) = That (This b) assoc (That c) = That (That c) assoc (These (That b) c) = That (These b c) assoc (This (These a b)) = These a (This b) assoc (These (This a) c) = These a (That c) assoc (These (These a b) c) = These a (These b c) unassoc (This a) = This (This a) unassoc (That (This b)) = This (That b) unassoc (That (That c)) = That c unassoc (That (These b c)) = These (That b) c 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 ------------------------------------------------------------------------------- -- deepseq ------------------------------------------------------------------------------- -- | @since 0.7.1 instance (NFData a, NFData b) => NFData (These a b) where rnf (This a) = rnf a rnf (That b) = rnf b rnf (These a b) = rnf a `seq` rnf b #if MIN_VERSION_deepseq(1,4,3) -- | @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 #endif ------------------------------------------------------------------------------- -- binary ------------------------------------------------------------------------------- -- | @since 0.7.1 instance (Binary a, Binary b) => Binary (These a b) where put (This a) = put (0 :: Int) >> put a put (That b) = put (1 :: Int) >> put b put (These a b) = put (2 :: Int) >> put a >> put b get = do i <- get case (i :: Int) of 0 -> This <$> get 1 -> That <$> get 2 -> These <$> get <*> get _ -> fail "Invalid These index" ------------------------------------------------------------------------------- -- hashable ------------------------------------------------------------------------------- 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 -- | @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 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 these-1.2/src/Data/These/0000755000000000000000000000000007346545000013365 5ustar0000000000000000these-1.2/src/Data/These/Combinators.hs0000644000000000000000000001656607346545000016217 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} -- | This module provides -- -- * specialised versions of class members e.g. 'bitraverseThese' -- * non-lens variants of "Data.These.Lens" things, e.g 'justHere' module Data.These.Combinators ( -- * Specialised combinators -- ** Bifunctor bimapThese, mapHere, mapThere, -- ** Bitraversable bitraverseThese, -- ** Associativity and commutativity swapThese, assocThese, unassocThese, -- * Other operations -- ** preview -- -- | -- @ -- 'justThis' = 'Control.Lens.preview' '_This' -- 'justThat' = 'Control.Lens.preview' '_That' -- 'justThese' = 'Control.Lens.preview' '_These' -- 'justHere' = 'Control.Lens.preview' 'here' -- 'justThere' = 'Control.Lens.preview' 'there' -- @ justThis, justThat, justThese, justHere, justThere, -- ** toListOf -- -- | -- @ -- 'catThis' = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_This') -- 'catThat' = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_That') -- 'catThese' = 'Control.Lens.toListOf' ('Control.Lens.folded' . '_These') -- 'catHere' = 'Control.Lens.toListOf' ('Control.Lens.folded' . 'here') -- 'catThere' = 'Control.Lens.toListOf' ('Control.Lens.folded' . 'there') -- @ catThis, catThat, catThese, catHere, catThere, -- * is / has -- -- | -- @ -- 'isThis' = 'Control.Lens.Extra.is' '_This' -- 'isThat' = 'Control.Lens.Extra.is' '_That' -- 'isThese' = 'Control.Lens.Extra.is' '_These' -- 'hasHere' = 'Control.Lens.has' 'here' -- 'hasThere' = 'Control.Lens.has' 'there' -- @ isThis, isThat, isThese, hasHere, hasThere, -- * over / map -- -- @ -- 'mapThis' = 'Control.Lens.over' '_This' -- 'mapThat' = 'Control.Lens.over' '_That' -- 'mapThese' = 'Control.Lens.over' '_These' -- 'mapHere' = 'Control.Lens.over' 'here' -- 'mapThere' = 'Control.Lens.over' 'there' -- @ mapThis, mapThat, mapThese, ) where 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 ------------------------------------------------------------------------------- -- | 'Bifunctor' 'bimap'. bimapThese :: (a -> c) -> (b -> d) -> These a b -> These c d bimapThese = bimap -- | @'mapHere' = 'Control.Lens.over' 'here'@ mapHere :: (a -> c) -> These a b -> These c b mapHere = first -- | @'mapThere' = 'Control.Lens.over' 'there'@ mapThere :: (b -> d) -> These a b -> These a d mapThere = second -- | 'Bitraversable' 'bitraverse'. bitraverseThese :: Applicative f => (a -> f c) -> (b -> f d) -> These a b -> f (These c d) bitraverseThese = bitraverse ------------------------------------------------------------------------------- -- assoc ------------------------------------------------------------------------------- -- | 'These' is commutative. -- -- @ -- 'swapThese' . 'swapThese' = 'id' -- @ -- -- @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. -- -- @ -- 'assocThese' . 'unassocThese' = 'id' -- 'unassocThese' . 'assocThese' = 'id' -- @ -- -- @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 ------------------------------------------------------------------------------- -- | -- -- >>> justHere (This 'x') -- Just 'x' -- -- >>> justHere (That 'y') -- Nothing -- -- >>> justHere (These 'x' 'y') -- Just 'x' -- justHere :: These a b -> Maybe a justHere (This a) = Just a justHere (That _) = Nothing justHere (These a _) = Just a -- | -- -- >>> justThere (This 'x') -- Nothing -- -- >>> justThere (That 'y') -- Just 'y' -- -- >>> justThere (These 'x' 'y') -- Just 'y' -- justThere :: These a b -> Maybe b justThere (This _) = Nothing justThere (That b) = Just b justThere (These _ b) = Just b justThis :: These a b -> Maybe a justThis (This a) = Just a justThis _ = Nothing justThat :: These a b -> Maybe b justThat (That x) = Just x justThat _ = Nothing justThese :: These a b -> Maybe (a, b) justThese (These a x) = Just (a, x) justThese _ = Nothing ------------------------------------------------------------------------------- -- toListOf ------------------------------------------------------------------------------- -- | Select all 'This' constructors from a list. catThis :: [These a b] -> [a] catThis = mapMaybe justThis -- | Select all 'That' constructors from a list. catThat :: [These a b] -> [b] catThat = mapMaybe justThat -- | Select all 'These' constructors from a list. catThese :: [These a b] -> [(a, b)] catThese = mapMaybe justThese catHere :: [These a b] -> [a] catHere = mapMaybe justHere catThere :: [These a b] -> [b] catThere = mapMaybe justThere ------------------------------------------------------------------------------- -- is ------------------------------------------------------------------------------- isThis, isThat, isThese :: These a b -> Bool -- | @'isThis' = 'isJust' . 'justThis'@ isThis = isJust . justThis -- | @'isThat' = 'isJust' . 'justThat'@ isThat = isJust . justThat -- | @'isThese' = 'isJust' . 'justThese'@ isThese = isJust . justThese hasHere, hasThere :: These a b -> Bool -- | @'hasHere' = 'isJust' . 'justHere'@ hasHere = isJust . justHere -- | @'hasThere' = 'isJust' . 'justThere'@ hasThere = isJust . justThere ------------------------------------------------------------------------------- -- over / map ------------------------------------------------------------------------------- mapThis :: (a -> a) -> These a b -> These a b mapThis f (This x) = This (f x) mapThis _ y = y mapThat :: (b -> b) -> These a b -> These a b mapThat f (That x) = That (f x) mapThat _ y = y mapThese :: ((a, b) -> (a, b)) -> These a b -> These a b mapThese f (These x y) = uncurry These (curry f x y) mapThese _ z = z these-1.2/these.cabal0000644000000000000000000000543407346545000012757 0ustar0000000000000000cabal-version: >=1.10 name: these version: 1.2 synopsis: An either-or-both data type. homepage: https://github.com/haskellari/these license: BSD3 license-file: LICENSE author: C. McCann, Oleg Grenrus maintainer: Oleg Grenrus category: Data, These build-type: Simple extra-source-files: CHANGELOG.md description: This package provides a data type @These a b@ which can hold a value of either type or values of each type. This is usually thought of as an "inclusive or" type (contrasting @Either a b@ as "exclusive or") or as an "outer join" type (contrasting @(a, b)@ as "inner join"). . @ data These a b = This a | That b | These a b @ . Since version 1, this package was split into parts: . * For @Align@ and @Zip@ type-classes. . * For @SemialignWithIndex@ class, providing @ialignWith@ and @izipWith@. . * For lens combinators. . * 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.4 || ==8.10.7 || ==9.0.2 || ==9.2.7 || ==9.4.4 || ==9.6.1 , GHCJS ==8.4 source-repository head type: git 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 exposed-modules: Data.Functor.These Data.These Data.These.Combinators -- ghc boot libs build-depends: base >=4.5.1.0 && <4.19 , binary >=0.5.1.0 && <0.10 , deepseq >=1.3.0.0 && <1.5 -- 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: assoc >=1.1 && <1.2 , hashable >=1.2.7.0 && <1.5 if impl(ghc <7.5) build-depends: ghc-prim if !impl(ghc >=9.6) build-depends: foldable1-classes-compat >=0.1 && <0.2 if !impl(ghc >=8.2) build-depends: bifunctor-classes-compat >=0.1 && <0.2 if !impl(ghc >=8.0) build-depends: semigroups >=0.18.5 && <0.21 , transformers >=0.3.0.0 && <0.7 , transformers-compat >=0.6.5 && <0.8 -- Ensure Data.Functor.Classes is always available if impl(ghc >=7.10) build-depends: transformers >=0.4.2.0 x-docspec-extra-packages: lens