bifunctors-4.1.0.1/0000755000000000000000000000000012226627070012223 5ustar0000000000000000bifunctors-4.1.0.1/.travis.yml0000644000000000000000000000033712226627070014337 0ustar0000000000000000language: haskell notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313bifunctors\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" bifunctors-4.1.0.1/bifunctors.cabal0000644000000000000000000000213512226627070015366 0ustar0000000000000000name: bifunctors category: Data, Functors version: 4.1.0.1 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/bifunctors/ bug-reports: http://github.com/ekmett/bifunctors/issues copyright: Copyright (C) 2008-2013 Edward A. Kmett synopsis: Bifunctors description: Bifunctors build-type: Simple extra-source-files: .travis.yml source-repository head type: git location: git://github.com/ekmett/bifunctors.git library hs-source-dirs: src build-depends: base == 4.*, semigroups >= 0.8.3.1, semigroupoids == 4.*, tagged >= 0.4.4 && < 1 exposed-modules: Data.Biapplicative Data.Bifunctor Data.Bifunctor.Apply Data.Bifunctor.Clown Data.Bifunctor.Flip Data.Bifunctor.Joker Data.Bifunctor.Product Data.Bifunctor.Wrapped Data.Bifoldable Data.Bitraversable Data.Semigroup.Bifoldable Data.Semigroup.Bitraversable ghc-options: -Wall bifunctors-4.1.0.1/LICENSE0000644000000000000000000000236412226627070013235 0ustar0000000000000000Copyright 2008-2013 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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. bifunctors-4.1.0.1/Setup.lhs0000644000000000000000000000016512226627070014035 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain bifunctors-4.1.0.1/src/0000755000000000000000000000000012226627070013012 5ustar0000000000000000bifunctors-4.1.0.1/src/Data/0000755000000000000000000000000012226627070013663 5ustar0000000000000000bifunctors-4.1.0.1/src/Data/Biapplicative.hs0000644000000000000000000000543712226627070017004 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Bifunctor.Apply -- Copyright : (C) 2011-2013 Edward Kmett, -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Biapplicative ( -- * Biapplicative bifunctors Biapplicative(..) , (<<$>>) , (<<**>>) , biliftA2 , biliftA3 , module Data.Bifunctor ) where import Control.Applicative import Data.Bifunctor import Data.Bifunctor.Apply ((<<$>>)) import Data.Monoid import Data.Tagged infixl 4 <<*>>, <<*, *>>, <<**>> class Bifunctor p => Biapplicative p where bipure :: a -> b -> p a b (<<*>>) :: p (a -> b) (c -> d) -> p a c -> p b d -- | -- @ -- a '*>' b ≡ 'const' 'id' '<$>' a '<*>' b -- @ (*>>) :: p a b -> p c d -> p c d a *>> b = bimap (const id) (const id) <<$>> a <<*>> b {-# INLINE (*>>) #-} -- | -- @ -- a '<*' b ≡ 'const' '<$>' a '<.>' b -- @ (<<*) :: p a b -> p c d -> p a b a <<* b = bimap const const <<$>> a <<*>> b {-# INLINE (<<*) #-} (<<**>>) :: Biapplicative p => p a c -> p (a -> b) (c -> d) -> p b d (<<**>>) = biliftA2 (flip id) (flip id) {-# INLINE (<<**>>) #-} -- | Lift binary functions biliftA2 :: Biapplicative w => (a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f biliftA2 f g a b = bimap f g <<$>> a <<*>> b {-# INLINE biliftA2 #-} -- | Lift ternary functions biliftA3 :: Biapplicative w => (a -> b -> c -> d) -> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h biliftA3 f g a b c = bimap f g <<$>> a <<*>> b <<*>> c {-# INLINE biliftA3 #-} instance Biapplicative (,) where bipure = (,) {-# INLINE bipure #-} (f, g) <<*>> (a, b) = (f a, g b) {-# INLINE (<<*>>) #-} instance Monoid x => Biapplicative ((,,) x) where bipure = (,,) mempty {-# INLINE bipure #-} (x, f, g) <<*>> (x', a, b) = (mappend x x', f a, g b) {-# INLINE (<<*>>) #-} instance (Monoid x, Monoid y) => Biapplicative ((,,,) x y) where bipure = (,,,) mempty mempty {-# INLINE bipure #-} (x, y, f, g) <<*>> (x', y', a, b) = (mappend x x', mappend y y', f a, g b) {-# INLINE (<<*>>) #-} instance (Monoid x, Monoid y, Monoid z) => Biapplicative ((,,,,) x y z) where bipure = (,,,,) mempty mempty mempty {-# INLINE bipure #-} (x, y, z, f, g) <<*>> (x', y', z', a, b) = (mappend x x', mappend y y', mappend z z', f a, g b) {-# INLINE (<<*>>) #-} instance Biapplicative Tagged where bipure _ b = Tagged b {-# INLINE bipure #-} Tagged f <<*>> Tagged x = Tagged (f x) {-# INLINE (<<*>>) #-} instance Biapplicative Const where bipure a _ = Const a {-# INLINE bipure #-} Const f <<*>> Const x = Const (f x) {-# INLINE (<<*>>) #-} bifunctors-4.1.0.1/src/Data/Bifoldable.hs0000644000000000000000000001045412226627070016246 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Bifoldable -- Copyright : (C) 2011 Edward Kmett, -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Bifoldable ( Bifoldable(..) , bifoldr' , bifoldrM , bifoldl' , bifoldlM , bitraverse_ , bifor_ , bimapM_ , biforM_ , bisequenceA_ , bisequence_ , biList , biconcat , biconcatMap , biany , biall ) where import Control.Applicative import Data.Monoid import Data.Tagged class Bifoldable p where bifold :: Monoid m => p m m -> m bifold = bifoldMap id id {-# INLINE bifold #-} bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty {-# INLINE bifoldMap #-} bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> p a b -> c bifoldr f g z t = appEndo (bifoldMap (Endo . f) (Endo . g) t) z {-# INLINE bifoldr #-} bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> p a b -> c bifoldl f g z t = appEndo (getDual (bifoldMap (Dual . Endo . flip f) (Dual . Endo . flip g) t)) z {-# INLINE bifoldl #-} instance Bifoldable (,) where bifoldMap f g ~(a, b) = f a `mappend` g b {-# INLINE bifoldMap #-} instance Bifoldable Const where bifoldMap f _ (Const a) = f a {-# INLINE bifoldMap #-} instance Bifoldable ((,,) x) where bifoldMap f g ~(_,a,b) = f a `mappend` g b {-# INLINE bifoldMap #-} instance Bifoldable ((,,,) x y) where bifoldMap f g ~(_,_,a,b) = f a `mappend` g b {-# INLINE bifoldMap #-} instance Bifoldable ((,,,,) x y z) where bifoldMap f g ~(_,_,_,a,b) = f a `mappend` g b {-# INLINE bifoldMap #-} instance Bifoldable Tagged where bifoldMap _ g (Tagged b) = g b {-# INLINE bifoldMap #-} instance Bifoldable Either where bifoldMap f _ (Left a) = f a bifoldMap _ g (Right b) = g b {-# INLINE bifoldMap #-} bifoldr' :: Bifoldable t => (a -> c -> c) -> (b -> c -> c) -> c -> t a b -> c bifoldr' f g z0 xs = bifoldl f' g' id xs z0 where f' k x z = k $! f x z g' k x z = k $! g x z {-# INLINE bifoldr' #-} bifoldrM :: (Bifoldable t, Monad m) => (a -> c -> m c) -> (b -> c -> m c) -> c -> t a b -> m c bifoldrM f g z0 xs = bifoldl f' g' return xs z0 where f' k x z = f x z >>= k g' k x z = g x z >>= k {-# INLINE bifoldrM #-} bifoldl':: Bifoldable t => (a -> b -> a) -> (a -> c -> a) -> a -> t b c -> a bifoldl' f g z0 xs = bifoldr f' g' id xs z0 where f' x k z = k $! f z x g' x k z = k $! g z x {-# INLINE bifoldl' #-} bifoldlM :: (Bifoldable t, Monad m) => (a -> b -> m a) -> (a -> c -> m a) -> a -> t b c -> m a bifoldlM f g z0 xs = bifoldr f' g' return xs z0 where f' x k z = f z x >>= k g' x k z = g z x >>= k {-# INLINE bifoldlM #-} bitraverse_ :: (Bifoldable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f () bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ()) {-# INLINE bitraverse_ #-} bifor_ :: (Bifoldable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f () bifor_ t f g = bitraverse_ f g t {-# INLINE bifor_ #-} bimapM_:: (Bifoldable t, Monad m) => (a -> m c) -> (b -> m d) -> t a b -> m () bimapM_ f g = bifoldr ((>>) . f) ((>>) . g) (return ()) {-# INLINE bimapM_ #-} biforM_ :: (Bifoldable t, Monad m) => t a b -> (a -> m c) -> (b -> m d) -> m () biforM_ t f g = bimapM_ f g t {-# INLINE biforM_ #-} bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f () bisequenceA_ = bifoldr (*>) (*>) (pure ()) {-# INLINE bisequenceA_ #-} bisequence_ :: (Bifoldable t, Monad m) => t (m a) (m b) -> m () bisequence_ = bifoldr (>>) (>>) (return ()) {-# INLINE bisequence_ #-} biList :: Bifoldable t => t a a -> [a] biList = bifoldr (:) (:) [] {-# INLINE biList #-} biconcat :: Bifoldable t => t [a] [a] -> [a] biconcat = bifold {-# INLINE biconcat #-} biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c] biconcatMap = bifoldMap {-# INLINE biconcatMap #-} biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool biany p q = getAny . bifoldMap (Any . p) (Any . q) {-# INLINE biany #-} biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool biall p q = getAll . bifoldMap (All . p) (All . q) {-# INLINE biall #-} bifunctors-4.1.0.1/src/Data/Bifunctor.hs0000644000000000000000000000514612226627070016160 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Bifunctor -- Copyright : (C) 2008-2013 Edward Kmett, -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Bifunctor ( Bifunctor(..) ) where import Control.Applicative import Data.Tagged -- | Minimal definition either 'bimap' or 'first' and 'second' -- | Formally, the class 'Bifunctor' represents a bifunctor -- from @Hask@ -> @Hask@. -- -- Intuitively it is a bifunctor where both the first and second arguments are covariant. -- -- You can define a 'Bifunctor' by either defining 'bimap' or by defining both -- 'first' and 'second'. -- -- If you supply 'bimap', you should ensure that: -- -- @'bimap' 'id' 'id' ≡ 'id'@ -- -- If you supply 'first' and 'second', ensure: -- -- @ -- 'first' 'id' ≡ 'id' -- 'second' 'id' ≡ 'id' -- @ -- -- If you supply both, you should also ensure: -- -- @'bimap' f g ≡ 'first' f '.' 'second' g@ -- -- These ensure by parametricity: -- -- @ -- 'bimap' (f '.' g) (h '.' i) ≡ 'bimap' f h '.' 'bimap' g i -- 'first' (f '.' g) ≡ 'first' f '.' 'first' g -- 'second' (f '.' g) ≡ 'second' f '.' 'second' g -- @ class Bifunctor p where -- | Map over both arguments at the same time. -- -- @'bimap' f g ≡ 'first' f '.' 'second' g@ bimap :: (a -> b) -> (c -> d) -> p a c -> p b d bimap f g = first f . second g {-# INLINE bimap #-} -- | Map covariantly over the first argument. -- -- @'first' f ≡ 'bimap' f 'id'@ first :: (a -> b) -> p a c -> p b c first f = bimap f id {-# INLINE first #-} -- | Map covariantly over the second argument. -- -- @'second' ≡ 'bimap' 'id'@ second :: (b -> c) -> p a b -> p a c second = bimap id {-# INLINE second #-} instance Bifunctor (,) where bimap f g ~(a, b) = (f a, g b) {-# INLINE bimap #-} instance Bifunctor ((,,) x) where bimap f g ~(x, a, b) = (x, f a, g b) {-# INLINE bimap #-} instance Bifunctor ((,,,) x y) where bimap f g ~(x, y, a, b) = (x, y, f a, g b) {-# INLINE bimap #-} instance Bifunctor ((,,,,) x y z) where bimap f g ~(x, y, z, a, b) = (x, y, z, f a, g b) {-# INLINE bimap #-} instance Bifunctor Either where bimap f _ (Left a) = Left (f a) bimap _ g (Right b) = Right (g b) {-# INLINE bimap #-} instance Bifunctor Const where bimap f _ (Const a) = Const (f a) {-# INLINE bimap #-} instance Bifunctor Tagged where bimap _ g (Tagged b) = Tagged (g b) {-# INLINE bimap #-} bifunctors-4.1.0.1/src/Data/Bitraversable.hs0000644000000000000000000001035312226627070017006 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Bitraversable -- Copyright : (C) 2011 Edward Kmett, -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Bitraversable ( Bitraversable(..) , bifor , biforM , bimapAccumL , bimapAccumR , bimapDefault , bifoldMapDefault ) where import Control.Applicative import Data.Bifunctor import Data.Bifoldable import Data.Monoid import Data.Tagged class (Bifunctor t, Bifoldable t) => Bitraversable t where bitraverse :: Applicative f => (a -> f c) -> (b -> f d) -> t a b -> f (t c d) bitraverse f g = bisequenceA . bimap f g {-# INLINE bitraverse #-} bisequenceA :: Applicative f => t (f a) (f b) -> f (t a b) bisequenceA = bitraverse id id {-# INLINE bisequenceA #-} bimapM :: Monad m => (a -> m c) -> (b -> m d) -> t a b -> m (t c d) bimapM f g = unwrapMonad . bitraverse (WrapMonad . f) (WrapMonad . g) {-# INLINE bimapM #-} bisequence :: Monad m => t (m a) (m b) -> m (t a b) bisequence = bimapM id id {-# INLINE bisequence #-} instance Bitraversable (,) where bitraverse f g ~(a, b) = (,) <$> f a <*> g b {-# INLINE bitraverse #-} instance Bitraversable ((,,) x) where bitraverse f g ~(x, a, b) = (,,) x <$> f a <*> g b {-# INLINE bitraverse #-} instance Bitraversable ((,,,) x y) where bitraverse f g ~(x, y, a, b) = (,,,) x y <$> f a <*> g b {-# INLINE bitraverse #-} instance Bitraversable ((,,,,) x y z) where bitraverse f g ~(x, y, z, a, b) = (,,,,) x y z <$> f a <*> g b {-# INLINE bitraverse #-} instance Bitraversable Either where bitraverse f _ (Left a) = Left <$> f a bitraverse _ g (Right b) = Right <$> g b {-# INLINE bitraverse #-} instance Bitraversable Const where bitraverse f _ (Const a) = Const <$> f a {-# INLINE bitraverse #-} instance Bitraversable Tagged where bitraverse _ g (Tagged b) = Tagged <$> g b {-# INLINE bitraverse #-} bifor :: (Bitraversable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f (t c d) bifor t f g = bitraverse f g t {-# INLINE bifor #-} biforM :: (Bitraversable t, Monad m) => t a b -> (a -> m c) -> (b -> m d) -> m (t c d) biforM t f g = bimapM f g t {-# INLINE biforM #-} -- | left-to-right state transformer newtype StateL s a = StateL { runStateL :: s -> (s, a) } instance Functor (StateL s) where fmap f (StateL k) = StateL $ \ s -> let (s', v) = k s in (s', f v) {-# INLINE fmap #-} instance Applicative (StateL s) where pure x = StateL (\ s -> (s, x)) {-# INLINE pure #-} StateL kf <*> StateL kv = StateL $ \ s -> let (s', f) = kf s (s'', v) = kv s' in (s'', f v) {-# INLINE (<*>) #-} bimapAccumL :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e) bimapAccumL f g s t = runStateL (bitraverse (StateL . flip f) (StateL . flip g) t) s {-# INLINE bimapAccumL #-} -- | right-to-left state transformer newtype StateR s a = StateR { runStateR :: s -> (s, a) } instance Functor (StateR s) where fmap f (StateR k) = StateR $ \ s -> let (s', v) = k s in (s', f v) {-# INLINE fmap #-} instance Applicative (StateR s) where pure x = StateR (\ s -> (s, x)) {-# INLINE pure #-} StateR kf <*> StateR kv = StateR $ \ s -> let (s', v) = kv s (s'', f) = kf s' in (s'', f v) {-# INLINE (<*>) #-} bimapAccumR :: Bitraversable t => (a -> b -> (a, c)) -> (a -> d -> (a, e)) -> a -> t b d -> (a, t c e) bimapAccumR f g s t = runStateR (bitraverse (StateR . flip f) (StateR . flip g) t) s {-# INLINE bimapAccumR #-} newtype Id a = Id { getId :: a } instance Functor Id where fmap f (Id x) = Id (f x) {-# INLINE fmap #-} instance Applicative Id where pure = Id {-# INLINE pure #-} Id f <*> Id x = Id (f x) {-# INLINE (<*>) #-} bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d bimapDefault f g = getId . bitraverse (Id . f) (Id . g) {-# INLINE bimapDefault #-} bifoldMapDefault :: (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m bifoldMapDefault f g = getConst . bitraverse (Const . f) (Const . g) {-# INLINE bifoldMapDefault #-} bifunctors-4.1.0.1/src/Data/Bifunctor/0000755000000000000000000000000012226627070015616 5ustar0000000000000000bifunctors-4.1.0.1/src/Data/Bifunctor/Apply.hs0000644000000000000000000000464112226627070017244 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Bifunctor.Apply -- Copyright : (C) 2011 Edward Kmett, -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Bifunctor.Apply ( -- * Biappliable bifunctors Biapply(..) , (<<$>>) , (<<..>>) , bilift2 , bilift3 , module Data.Bifunctor ) where import Control.Applicative import Data.Bifunctor import Data.Semigroup import Data.Tagged infixl 4 <<$>>, <<.>>, <<., .>>, <<..>> (<<$>>) :: (a -> b) -> a -> b (<<$>>) = id {-# INLINE (<<$>>) #-} class Bifunctor p => Biapply p where (<<.>>) :: p (a -> b) (c -> d) -> p a c -> p b d -- | -- @ -- a '.>' b ≡ 'const' 'id' '<$>' a '<.>' b -- @ (.>>) :: p a b -> p c d -> p c d a .>> b = bimap (const id) (const id) <<$>> a <<.>> b {-# INLINE (.>>) #-} -- | -- @ -- a '<.' b ≡ 'const' '<$>' a '<.>' b -- @ (<<.) :: p a b -> p c d -> p a b a <<. b = bimap const const <<$>> a <<.>> b {-# INLINE (<<.) #-} (<<..>>) :: Biapply p => p a c -> p (a -> b) (c -> d) -> p b d (<<..>>) = bilift2 (flip id) (flip id) {-# INLINE (<<..>>) #-} -- | Lift binary functions bilift2 :: Biapply w => (a -> b -> c) -> (d -> e -> f) -> w a d -> w b e -> w c f bilift2 f g a b = bimap f g <<$>> a <<.>> b {-# INLINE bilift2 #-} -- | Lift ternary functions bilift3 :: Biapply w => (a -> b -> c -> d) -> (e -> f -> g -> h) -> w a e -> w b f -> w c g -> w d h bilift3 f g a b c = bimap f g <<$>> a <<.>> b <<.>> c {-# INLINE bilift3 #-} instance Biapply (,) where (f, g) <<.>> (a, b) = (f a, g b) {-# INLINE (<<.>>) #-} instance Semigroup x => Biapply ((,,) x) where (x, f, g) <<.>> (x', a, b) = (x <> x', f a, g b) {-# INLINE (<<.>>) #-} instance (Semigroup x, Semigroup y) => Biapply ((,,,) x y) where (x, y, f, g) <<.>> (x', y', a, b) = (x <> x', y <> y', f a, g b) {-# INLINE (<<.>>) #-} instance (Semigroup x, Semigroup y, Semigroup z) => Biapply ((,,,,) x y z) where (x, y, z, f, g) <<.>> (x', y', z', a, b) = (x <> x', y <> y', z <> z', f a, g b) {-# INLINE (<<.>>) #-} instance Biapply Const where Const f <<.>> Const x = Const (f x) {-# INLINE (<<.>>) #-} instance Biapply Tagged where Tagged f <<.>> Tagged x = Tagged (f x) {-# INLINE (<<.>>) #-} bifunctors-4.1.0.1/src/Data/Bifunctor/Clown.hs0000644000000000000000000000455112226627070017241 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Bifunctor.Clown -- Copyright : (C) 2008-2013 Edward Kmett, -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- From the Functional Pearl \"Clowns to the Left of me, Jokers to the Right: Dissecting Data Structures\" -- by Conor McBride. ---------------------------------------------------------------------------- module Data.Bifunctor.Clown ( Clown(..) ) where import Control.Applicative import Data.Biapplicative import Data.Bifunctor.Apply import Data.Bifoldable import Data.Bitraversable import Data.Foldable import Data.Functor.Apply import Data.Monoid import Data.Semigroup.Bifoldable import Data.Semigroup.Bitraversable import Data.Semigroup.Foldable import Data.Semigroup.Traversable import Data.Traversable -- | Make a 'Functor' over the first argument of a 'Bifunctor'. newtype Clown f a b = Clown { runClown :: f a } deriving (Eq,Ord,Show,Read) instance Functor f => Bifunctor (Clown f) where first f = Clown . fmap f . runClown {-# INLINE first #-} second _ = Clown . runClown {-# INLINE second #-} bimap f _ = Clown . fmap f . runClown {-# INLINE bimap #-} instance Functor (Clown f a) where fmap _ = Clown . runClown {-# INLINE fmap #-} instance Applicative f => Biapplicative (Clown f) where bipure a _ = Clown (pure a) {-# INLINE bipure #-} Clown mf <<*>> Clown mx = Clown (mf <*> mx) {-# INLINE (<<*>>) #-} instance Apply f => Biapply (Clown f) where Clown fg <<.>> Clown xy = Clown (fg <.> xy) {-# INLINE (<<.>>) #-} instance Foldable f => Bifoldable (Clown f) where bifoldMap f _ = foldMap f . runClown {-# INLINE bifoldMap #-} instance Foldable (Clown f a) where foldMap _ = mempty {-# INLINE foldMap #-} instance Traversable f => Bitraversable (Clown f) where bitraverse f _ = fmap Clown . traverse f . runClown {-# INLINE bitraverse #-} instance Traversable (Clown f a) where traverse _ = pure . Clown . runClown {-# INLINE traverse #-} instance Foldable1 f => Bifoldable1 (Clown f) where bifoldMap1 f _ = foldMap1 f . runClown {-# INLINE bifoldMap1 #-} instance Traversable1 f => Bitraversable1 (Clown f) where bitraverse1 f _ = fmap Clown . traverse1 f . runClown {-# INLINE bitraverse1 #-} bifunctors-4.1.0.1/src/Data/Bifunctor/Flip.hs0000644000000000000000000000441212226627070017045 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Bifunctor.Flip -- Copyright : (C) 2008-2013 Edward Kmett, -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Bifunctor.Flip ( Flip(..) ) where import Control.Applicative import Data.Biapplicative import Data.Bifunctor.Apply import Data.Bifoldable import Data.Bitraversable import Data.Foldable import Data.Monoid import Data.Semigroup.Bifoldable import Data.Semigroup.Bitraversable import Data.Traversable -- | Make a 'Functor' over the first argument of a 'Bifunctor'. newtype Flip p a b = Flip { runFlip :: p b a } deriving (Eq,Ord,Show,Read) instance Bifunctor p => Bifunctor (Flip p) where first f = Flip . second f . runFlip {-# INLINE first #-} second f = Flip . first f . runFlip {-# INLINE second #-} bimap f g = Flip . bimap g f . runFlip {-# INLINE bimap #-} instance Bifunctor p => Functor (Flip p a) where fmap f = Flip . first f . runFlip {-# INLINE fmap #-} instance Biapplicative p => Biapplicative (Flip p) where bipure a b = Flip (bipure b a) {-# INLINE bipure #-} Flip fg <<*>> Flip xy = Flip (fg <<*>> xy) {-# INLINE (<<*>>) #-} instance Biapply p => Biapply (Flip p) where Flip fg <<.>> Flip xy = Flip (fg <<.>> xy) {-# INLINE (<<.>>) #-} instance Bifoldable p => Bifoldable (Flip p) where bifoldMap f g = bifoldMap g f . runFlip {-# INLINE bifoldMap #-} instance Bifoldable p => Foldable (Flip p a) where foldMap f = bifoldMap f (const mempty) . runFlip {-# INLINE foldMap #-} instance Bitraversable p => Bitraversable (Flip p) where bitraverse f g = fmap Flip . bitraverse g f . runFlip {-# INLINE bitraverse #-} instance Bitraversable p => Traversable (Flip p a) where traverse f = fmap Flip . bitraverse f pure . runFlip {-# INLINE traverse #-} instance Bifoldable1 p => Bifoldable1 (Flip p) where bifoldMap1 f g = bifoldMap1 g f . runFlip {-# INLINE bifoldMap1 #-} instance Bitraversable1 p => Bitraversable1 (Flip p) where bitraverse1 f g = fmap Flip . bitraverse1 g f . runFlip {-# INLINE bitraverse1 #-} bifunctors-4.1.0.1/src/Data/Bifunctor/Joker.hs0000644000000000000000000000524312226627070017230 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Bifunctor.Joker -- Copyright : (C) 2008-2013 Edward Kmett, -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- From the Functional Pearl \"Clowns to the Left of me, Jokers to the Right: Dissecting Data Structures\" -- by Conor McBride. ---------------------------------------------------------------------------- module Data.Bifunctor.Joker ( Joker(..) ) where import Control.Applicative import Data.Biapplicative import Data.Bifunctor.Apply import Data.Bifoldable import Data.Bitraversable import Data.Foldable import Data.Functor.Apply import Data.Semigroup.Bifoldable import Data.Semigroup.Bitraversable import Data.Semigroup.Foldable import Data.Semigroup.Traversable import Data.Traversable -- | Make a 'Functor' over the second argument of a 'Bifunctor'. newtype Joker g a b = Joker { runJoker :: g b } deriving (Eq,Ord,Show,Read) instance Functor g => Bifunctor (Joker g) where first _ = Joker . runJoker {-# INLINE first #-} second g = Joker . fmap g . runJoker {-# INLINE second #-} bimap _ g = Joker . fmap g . runJoker {-# INLINE bimap #-} instance Functor g => Functor (Joker g a) where fmap g = Joker . fmap g . runJoker {-# INLINE fmap #-} instance Applicative g => Biapplicative (Joker g) where bipure _ b = Joker (pure b) {-# INLINE bipure #-} Joker mf <<*>> Joker mx = Joker (mf <*> mx) {-# INLINE (<<*>>) #-} instance Apply g => Biapply (Joker g) where Joker fg <<.>> Joker xy = Joker (fg <.> xy) {-# INLINE (<<.>>) #-} instance Foldable g => Bifoldable (Joker g) where bifoldMap _ g = foldMap g . runJoker {-# INLINE bifoldMap #-} instance Foldable g => Foldable (Joker g a) where foldMap g = foldMap g . runJoker {-# INLINE foldMap #-} instance Traversable g => Bitraversable (Joker g) where bitraverse _ g = fmap Joker . traverse g . runJoker {-# INLINE bitraverse #-} instance Traversable g => Traversable (Joker g a) where traverse g = fmap Joker . traverse g . runJoker {-# INLINE traverse #-} instance Foldable1 g => Bifoldable1 (Joker g) where bifoldMap1 _ g = foldMap1 g . runJoker {-# INLINE bifoldMap1 #-} instance Foldable1 g => Foldable1 (Joker g a) where foldMap1 g = foldMap1 g . runJoker {-# INLINE foldMap1 #-} instance Traversable1 g => Bitraversable1 (Joker g) where bitraverse1 _ g = fmap Joker . traverse1 g . runJoker {-# INLINE bitraverse1 #-} instance Traversable1 g => Traversable1 (Joker g a) where traverse1 g = fmap Joker . traverse1 g . runJoker {-# INLINE traverse1 #-} bifunctors-4.1.0.1/src/Data/Bifunctor/Product.hs0000644000000000000000000000415412226627070017576 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Bifunctor.Product -- Copyright : (C) 2008-2013 Jesse Selover, -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- The product of two bifunctors. ---------------------------------------------------------------------------- module Data.Bifunctor.Product ( Product(..) ) where import Control.Applicative import Data.Biapplicative import Data.Functor.Apply import Data.Bifoldable import Data.Bitraversable import Data.Monoid hiding (Product, (<>)) import Data.Semigroup hiding (Product) import Data.Semigroup.Bifoldable import Data.Semigroup.Bitraversable -- | Form the product of two bifunctors data Product f g a b = Pair (f a b) (g a b) deriving (Eq,Ord,Show,Read) instance (Bifunctor f, Bifunctor g) => Bifunctor (Product f g) where first f (Pair x y) = Pair (first f x) (first f y) {-# INLINE first #-} second g (Pair x y) = Pair (second g x) (second g y) {-# INLINE second #-} bimap f g (Pair x y) = Pair (bimap f g x) (bimap f g y) {-# INLINE bimap #-} instance (Biapplicative f, Biapplicative g) => Biapplicative (Product f g) where bipure a b = Pair (bipure a b) (bipure a b) {-# INLINE bipure #-} Pair w x <<*>> Pair y z = Pair (w <<*>> y) (x <<*>> z) {-# INLINE (<<*>>) #-} instance (Bifoldable f, Bifoldable g) => Bifoldable (Product f g) where bifoldMap f g (Pair x y) = bifoldMap f g x `mappend` bifoldMap f g y {-# INLINE bifoldMap #-} instance (Bitraversable f, Bitraversable g) => Bitraversable (Product f g) where bitraverse f g (Pair x y) = Pair <$> bitraverse f g x <*> bitraverse f g y {-# INLINE bitraverse #-} instance (Bifoldable1 f, Bifoldable1 g) => Bifoldable1 (Product f g) where bifoldMap1 f g (Pair x y) = bifoldMap1 f g x <> bifoldMap1 f g y {-# INLINE bifoldMap1 #-} instance (Bitraversable1 f, Bitraversable1 g) => Bitraversable1 (Product f g) where bitraverse1 f g (Pair x y) = Pair <$> bitraverse1 f g x <.> bitraverse1 f g y {-# INLINE bitraverse1 #-} bifunctors-4.1.0.1/src/Data/Bifunctor/Wrapped.hs0000644000000000000000000000517012226627070017557 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Bifunctor -- Copyright : (C) 2008-2013 Edward Kmett, -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Bifunctor.Wrapped ( WrappedBifunctor(..) ) where import Control.Applicative import Data.Biapplicative import Data.Bifoldable import Data.Bifunctor.Apply import Data.Bitraversable import Data.Foldable import Data.Monoid import Data.Semigroup.Bifoldable import Data.Semigroup.Bitraversable import Data.Traversable -- | Make a 'Functor' over the second argument of a 'Bifunctor'. newtype WrappedBifunctor p a b = WrapBifunctor { unwrapBifunctor :: p a b } deriving (Eq,Ord,Show,Read) instance Bifunctor p => Bifunctor (WrappedBifunctor p) where first f = WrapBifunctor . first f . unwrapBifunctor {-# INLINE first #-} second f = WrapBifunctor . second f . unwrapBifunctor {-# INLINE second #-} bimap f g = WrapBifunctor . bimap f g . unwrapBifunctor {-# INLINE bimap #-} instance Bifunctor p => Functor (WrappedBifunctor p a) where fmap f = WrapBifunctor . second f . unwrapBifunctor {-# INLINE fmap #-} instance Biapply p => Biapply (WrappedBifunctor p) where WrapBifunctor fg <<.>> WrapBifunctor xy = WrapBifunctor (fg <<.>> xy) {-# INLINE (<<.>>) #-} instance Biapplicative p => Biapplicative (WrappedBifunctor p) where bipure a b = WrapBifunctor (bipure a b) {-# INLINE bipure #-} WrapBifunctor fg <<*>> WrapBifunctor xy = WrapBifunctor (fg <<*>> xy) {-# INLINE (<<*>>) #-} instance Bifoldable p => Foldable (WrappedBifunctor p a) where foldMap f = bifoldMap (const mempty) f . unwrapBifunctor {-# INLINE foldMap #-} instance Bifoldable p => Bifoldable (WrappedBifunctor p) where bifoldMap f g = bifoldMap f g . unwrapBifunctor {-# INLINE bifoldMap #-} instance Bitraversable p => Traversable (WrappedBifunctor p a) where traverse f = fmap WrapBifunctor . bitraverse pure f . unwrapBifunctor {-# INLINE traverse #-} instance Bitraversable p => Bitraversable (WrappedBifunctor p) where bitraverse f g = fmap WrapBifunctor . bitraverse f g . unwrapBifunctor {-# INLINE bitraverse #-} instance Bifoldable1 p => Bifoldable1 (WrappedBifunctor p) where bifoldMap1 f g = bifoldMap1 f g . unwrapBifunctor {-# INLINE bifoldMap1 #-} instance Bitraversable1 p => Bitraversable1 (WrappedBifunctor p) where bitraverse1 f g = fmap WrapBifunctor . bitraverse1 f g . unwrapBifunctor {-# INLINE bitraverse1 #-} bifunctors-4.1.0.1/src/Data/Semigroup/0000755000000000000000000000000012226627070015635 5ustar0000000000000000bifunctors-4.1.0.1/src/Data/Semigroup/Bifoldable.hs0000644000000000000000000000554712226627070020227 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Semigroup.Foldable -- Copyright : (C) 2011 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Semigroup.Bifoldable ( Bifoldable1(..) , bitraverse1_ , bifor1_ , bisequenceA1_ , bifoldMapDefault1 ) where import Control.Applicative import Data.Bifoldable import Data.Functor.Apply import Data.Semigroup import Data.Tagged import Prelude hiding (foldr) class Bifoldable t => Bifoldable1 t where bifold1 :: Semigroup m => t m m -> m bifold1 = bifoldMap1 id id {-# INLINE bifold1 #-} bifoldMap1 :: Semigroup m => (a -> m) -> (b -> m) -> t a b -> m bifoldMap1 f g = maybe (error "bifoldMap1") id . getOption . bifoldMap (Option . Just . f) (Option . Just . g) {-# INLINE bifoldMap1 #-} instance Bifoldable1 Either where bifoldMap1 f _ (Left a) = f a bifoldMap1 _ g (Right b) = g b {-# INLINE bifoldMap1 #-} instance Bifoldable1 (,) where bifoldMap1 f g (a, b) = f a <> g b {-# INLINE bifoldMap1 #-} instance Bifoldable1 ((,,) x) where bifoldMap1 f g (_,a,b) = f a <> g b {-# INLINE bifoldMap1 #-} instance Bifoldable1 ((,,,) x y) where bifoldMap1 f g (_,_,a,b) = f a <> g b {-# INLINE bifoldMap1 #-} instance Bifoldable1 ((,,,,) x y z) where bifoldMap1 f g (_,_,_,a,b) = f a <> g b {-# INLINE bifoldMap1 #-} instance Bifoldable1 Const where bifoldMap1 f _ (Const a) = f a {-# INLINE bifoldMap1 #-} instance Bifoldable1 Tagged where bifoldMap1 _ g (Tagged b) = g b {-# INLINE bifoldMap1 #-} newtype Act f a = Act { getAct :: f a } instance Apply f => Semigroup (Act f a) where Act a <> Act b = Act (a .> b) {-# INLINE (<>) #-} instance Functor f => Functor (Act f) where fmap f (Act a) = Act (f <$> a) {-# INLINE fmap #-} b <$ Act a = Act (b <$ a) {-# INLINE (<$) #-} bitraverse1_ :: (Bifoldable1 t, Apply f) => (a -> f b) -> (c -> f d) -> t a c -> f () bitraverse1_ f g t = getAct (bifoldMap1 (Act . ignore . f) (Act . ignore . g) t) {-# INLINE bitraverse1_ #-} bifor1_ :: (Bifoldable1 t, Apply f) => t a c -> (a -> f b) -> (c -> f d) -> f () bifor1_ t f g = bitraverse1_ f g t {-# INLINE bifor1_ #-} ignore :: Functor f => f a -> f () ignore = (() <$) {-# INLINE ignore #-} bisequenceA1_ :: (Bifoldable1 t, Apply f) => t (f a) (f b) -> f () bisequenceA1_ t = getAct (bifoldMap1 (Act . ignore) (Act . ignore) t) {-# INLINE bisequenceA1_ #-} -- | Usable default for foldMap, but only if you define bifoldMap1 yourself bifoldMapDefault1 :: (Bifoldable1 t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m bifoldMapDefault1 f g = unwrapMonoid . bifoldMap (WrapMonoid . f) (WrapMonoid . g) {-# INLINE bifoldMapDefault1 #-} bifunctors-4.1.0.1/src/Data/Semigroup/Bitraversable.hs0000644000000000000000000000405012226627070020755 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Data.Semigroup.Bitraversable -- Copyright : (C) 2011 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Semigroup.Bitraversable ( Bitraversable1(..) , bifoldMap1Default ) where import Control.Applicative import Data.Bitraversable import Data.Bifunctor import Data.Functor.Apply import Data.Semigroup import Data.Semigroup.Bifoldable import Data.Tagged class (Bifoldable1 t, Bitraversable t) => Bitraversable1 t where bitraverse1 :: Apply f => (a -> f b) -> (c -> f d) -> t a c -> f (t b d) bitraverse1 f g = bisequence1 . bimap f g {-# INLINE bitraverse1 #-} bisequence1 :: Apply f => t (f a) (f b) -> f (t a b) bisequence1 = bitraverse1 id id {-# INLINE bisequence1 #-} bifoldMap1Default :: (Bitraversable1 t, Semigroup m) => (a -> m) -> (b -> m) -> t a b -> m bifoldMap1Default f g = getConst . bitraverse1 (Const . f) (Const . g) {-# INLINE bifoldMap1Default #-} instance Bitraversable1 Either where bitraverse1 f _ (Left a) = Left <$> f a bitraverse1 _ g (Right b) = Right <$> g b {-# INLINE bitraverse1 #-} instance Bitraversable1 (,) where bitraverse1 f g (a, b) = (,) <$> f a <.> g b {-# INLINE bitraverse1 #-} instance Bitraversable1 ((,,) x) where bitraverse1 f g (x, a, b) = (,,) x <$> f a <.> g b {-# INLINE bitraverse1 #-} instance Bitraversable1 ((,,,) x y) where bitraverse1 f g (x, y, a, b) = (,,,) x y <$> f a <.> g b {-# INLINE bitraverse1 #-} instance Bitraversable1 ((,,,,) x y z) where bitraverse1 f g (x, y, z, a, b) = (,,,,) x y z <$> f a <.> g b {-# INLINE bitraverse1 #-} instance Bitraversable1 Const where bitraverse1 f _ (Const a) = Const <$> f a {-# INLINE bitraverse1 #-} instance Bitraversable1 Tagged where bitraverse1 _ g (Tagged b) = Tagged <$> g b {-# INLINE bitraverse1 #-}