bifunctors 4.1.0.1 → 4.1.1

raw patch · 2 files changed

+81/−2 lines, 2 files

Files

• bifunctors.cabal +3/−2
• src/Data/Bifunctor/Join.hs +78/−0

@@ -1,6 +1,6 @@ name:          bifunctors category:      Data, Functors-version:       4.1.0.1+version:       4.1.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -22,7 +22,7 @@ library   hs-source-dirs: src   build-depends:-    base          == 4.*,+    base          >= 4.5 && < 5,     semigroups    >= 0.8.3.1,     semigroupoids == 4.*,     tagged        >= 0.4.4 && < 1@@ -33,6 +33,7 @@     Data.Bifunctor.Apply     Data.Bifunctor.Clown     Data.Bifunctor.Flip+    Data.Bifunctor.Join     Data.Bifunctor.Joker     Data.Bifunctor.Product     Data.Bifunctor.Wrapped

@@ -0,0 +1,78 @@+{-# LANGUAGE StandaloneDeriving, FlexibleContexts, UndecidableInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bifunctor.Join+-- Copyright   :  (C) 2008-2013 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  non-portable+--+----------------------------------------------------------------------------+module Data.Bifunctor.Join+  ( Join(..)+  ) where++import Control.Applicative+import Data.Biapplicative+import Data.Bifoldable+import Data.Bifunctor.Apply+import Data.Bitraversable+import Data.Foldable+import Data.Functor.Bind+import Data.Semigroup.Bifoldable+import Data.Semigroup.Bitraversable+import Data.Semigroup.Foldable+import Data.Semigroup.Traversable+import Data.Traversable++-- | Make a 'Functor' over both arguments of a 'Bifunctor'.+newtype Join p a = Join { runJoin :: p a a }++deriving instance Eq   (p a a) => Eq   (Join p a)+deriving instance Ord  (p a a) => Ord  (Join p a)+deriving instance Show (p a a) => Show (Join p a)+deriving instance Read (p a a) => Read (Join p a)++instance Bifunctor p => Functor (Join p) where+  fmap f (Join a) = Join (bimap f f a)+  {-# INLINE fmap #-}++instance Biapplicative p => Applicative (Join p) where+  pure a = Join (bipure a a)+  {-# INLINE pure #-}+  Join f <*> Join a = Join (f <<*>> a)+  {-# INLINE (<*>) #-}+  Join a *> Join b = Join (a *>> b)+  {-# INLINE (*>) #-}+  Join a <* Join b = Join (a <<* b)+  {-# INLINE (<*) #-}++instance Biapply p => Apply (Join p) where+  Join f <.> Join a = Join (f <<.>> a)+  {-# INLINE (<.>) #-}+  Join a .> Join b = Join (a .>> b)+  {-# INLINE (.>) #-}+  Join a <. Join b = Join (a <<. b)+  {-# INLINE (<.) #-}++instance Bifoldable p => Foldable (Join p) where+  foldMap f (Join a) = bifoldMap f f a+  {-# INLINE foldMap #-}++instance Bitraversable p => Traversable (Join p) where+  traverse f (Join a) = fmap Join (bitraverse f f a)+  {-# INLINE traverse #-}+  sequenceA (Join a) = fmap Join (bisequenceA a)+  {-# INLINE sequenceA #-}++instance Bifoldable1 p => Foldable1 (Join p) where+  foldMap1 f (Join a) = bifoldMap1 f f a+  {-# INLINE foldMap1 #-}++instance Bitraversable1 p => Traversable1 (Join p) where+  traverse1 f (Join a) = fmap Join (bitraverse1 f f a)+  {-# INLINE traverse1 #-}+  sequence1 (Join a) = fmap Join (bisequence1 a)+  {-# INLINE sequence1 #-}