these-1.2.1/0000755000000000000000000000000007346545000011014 5ustar0000000000000000these-1.2.1/CHANGELOG.md0000644000000000000000000000762207346545000012634 0ustar0000000000000000# 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)` # 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.1/LICENSE0000644000000000000000000000300407346545000012016 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.1/src/Data/Functor/0000755000000000000000000000000007346545000014074 5ustar0000000000000000these-1.2.1/src/Data/Functor/These.hs0000644000000000000000000001613707346545000015510 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Safe #-} 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 import Control.DeepSeq (NFData (..), NFData1 (..)) import GHC.Generics (Generic1) import Data.Data (Data) import Data.Typeable (Typeable) ------------------------------------------------------------------------------- -- These1 ------------------------------------------------------------------------------- data These1 f g a = This1 (f a) | That1 (g a) | These1 (f a) (g a) deriving (Functor, Foldable, Traversable, Generic, Generic1, Typeable, Data) ------------------------------------------------------------------------------- -- Eq1 ------------------------------------------------------------------------------- instance (Eq1 f, Eq1 g) => Eq1 (These1 f g) where 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 ------------------------------------------------------------------------------- -- Ord1 ------------------------------------------------------------------------------- instance (Ord1 f, Ord1 g) => Ord1 (These1 f g) where 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' ------------------------------------------------------------------------------- -- Show1 ------------------------------------------------------------------------------- instance (Show1 f, Show1 g) => Show1 (These1 f g) where 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 ------------------------------------------------------------------------------- -- Read1 ------------------------------------------------------------------------------- instance (Read1 f, Read1 g) => Read1 (These1 f g) where 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) _ -> [] ------------------------------------------------------------------------------- -- 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 ------------------------------------------------------------------------------- -- | 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 -- | 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.1/src/Data/0000755000000000000000000000000007346545000012454 5ustar0000000000000000these-1.2.1/src/Data/These.hs0000644000000000000000000003572607346545000014075 0ustar0000000000000000-- | The 'These' type and associated operations. {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Safe #-} 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 (..), NFData1 (..), NFData2 (..)) import Data.Bifoldable (Bifoldable (..)) import Data.Bifoldable1 (Bifoldable1 (..)) import Data.Bifunctor (Bifunctor (..)) import Data.Bifunctor.Assoc (Assoc (..)) import Data.Bifunctor.Swap (Swap (..)) 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. -- -- 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, Generic1) ------------------------------------------------------------------------------- -- 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 ------------------------------------------------------------------------------- -- | @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 ------------------------------------------------------------------------------- -- | @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 -- | @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 ------------------------------------------------------------------------------- -- | @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.1/src/Data/These/0000755000000000000000000000000007346545000013524 5ustar0000000000000000these-1.2.1/src/Data/These/Combinators.hs0000644000000000000000000001463307346545000016347 0ustar0000000000000000{-# 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, (.)) import Data.Bifunctor.Assoc (assoc, unassoc) import Data.Bifunctor.Swap (swap) -- $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 swapThese = swap -- | 'These' is associative. -- -- @ -- 'assocThese' . 'unassocThese' = 'id' -- 'unassocThese' . 'assocThese' = 'id' -- @ -- -- @since 0.8 assocThese :: These (These a b) c -> These a (These b c) assocThese = assoc -- | 'These' is associative. See 'assocThese'. -- -- @since 0.8 unassocThese :: These a (These b c) -> These (These a b) c unassocThese = unassoc ------------------------------------------------------------------------------- -- 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.1/these.cabal0000644000000000000000000000432107346545000013110 0ustar0000000000000000cabal-version: >=1.10 name: these version: 1.2.1 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 ==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/haskellari/these.git subdir: these library default-language: Haskell2010 ghc-options: -Wall -Wno-trustworthy-safe hs-source-dirs: src exposed-modules: Data.Functor.These Data.These Data.These.Combinators -- ghc boot libs build-depends: 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: assoc >=1.1.1 && <1.2 , hashable >=1.4.4.0 && <1.5 if !impl(ghc >=9.6) build-depends: foldable1-classes-compat >=0.1 && <0.2 x-docspec-extra-packages: lens