these-1.1.1.1/0000755000000000000000000000000007346545000011152 5ustar0000000000000000these-1.1.1.1/CHANGELOG.md0000644000000000000000000000617407346545000012773 0ustar0000000000000000# 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.1.1.1/LICENSE0000644000000000000000000000300407346545000012154 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.1.1.1/src/Data/Functor/0000755000000000000000000000000007346545000014232 5ustar0000000000000000these-1.1.1.1/src/Data/Functor/These.hs0000644000000000000000000001571007346545000015642 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# 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 (..), compare1, eq1, readsPrec1, showsPrec1) import Data.Monoid (Monoid (..)) import Data.Traversable (Traversable) import GHC.Generics (Generic) import Prelude (Bool (..), Eq (..), Functor, Ord (..), Ordering (..), Read (..), Show (..), lex, readParen, return, seq, showChar, showParen, showString, ($), (&&), (.)) #if MIN_VERSION_deepseq(1,4,3) import Control.DeepSeq (NFData (..), NFData1 (..), rnf1) #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 (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 these-1.1.1.1/src/Data/0000755000000000000000000000000007346545000012612 5ustar0000000000000000these-1.1.1.1/src/Data/These.hs0000644000000000000000000003733607346545000014232 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 -- -- | This distributivity combinators aren't isomorphisms! , distrThesePair , undistrThesePair , distrPairThese , undistrPairThese ) where import Control.Applicative (Applicative (..), (<$>)) 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.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 -- -------------------------------------------------------------------------- -- | 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 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) 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 ------------------------------------------------------------------------------- #ifdef MIN_VERSION_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 #endif ------------------------------------------------------------------------------- -- 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.1.1.1/src/Data/These/0000755000000000000000000000000007346545000013662 5ustar0000000000000000these-1.1.1.1/src/Data/These/Combinators.hs0000644000000000000000000001652207346545000016504 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 ------------------------------------------------------------------------------- -- 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.1.1.1/these.cabal0000644000000000000000000000506107346545000013250 0ustar0000000000000000cabal-version: >=1.10 name: these version: 1.1.1.1 synopsis: An either-or-both data type. homepage: https://github.com/isomorphism/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.3 || ==8.10.1 , GHCJS ==8.4 source-repository head type: git location: https://github.com/isomorphism/these.git flag assoc description: Build with assoc dependency manual: True default: True 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.15 , binary >=0.5.1.0 && <0.10 , deepseq >=1.3.0.0 && <1.5 -- other dependencies build-depends: 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(assoc) build-depends: assoc >=1 && <1.1