bifunctors (empty) → 0.1

raw patch · 6 files changed

+316/−0 lines, 6 filesdep +basesetup-changed

Dependencies added: base

Files

Data/Bifoldable.hs +104/−0
Data/Bifunctor.hs +44/−0
Data/Bitraversable.hs +102/−0
LICENSE +30/−0
Setup.lhs +7/−0
bifunctors.cabal +29/−0

+ Data/Bifoldable.hs view

@@ -0,0 +1,104 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bifoldable+-- Copyright   :  (C) 2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Bifoldable +  ( Bifoldable(..)+  , bifoldr'+  , bifoldrM+  , bifoldl'+  , bifoldlM+  , bitraverse_+  , bifor_+  , bimapM_+  , bisequenceA_+  , bisequence_+  , biList+  , biconcat+  , biconcatMap+  , biany+  , biall+  ) where++import Control.Applicative+import Data.Monoid++class Bifoldable p where+  bifold :: Monoid m => p m m -> m+  bifold = bifoldMap id id++  bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> p a b -> m+  bifoldMap f g = bifoldr (mappend . f) (mappend . g) mempty++  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++  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++instance Bifoldable (,) where+  bifoldMap f g (a, b) = f a `mappend` g b++instance Bifoldable Either where+  bifoldMap f _ (Left a) = f a+  bifoldMap _ g (Right b) = g b++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++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++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++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+  +bitraverse_ :: (Bifoldable t, Applicative f) => (a -> f c) -> (b -> f d) -> t a b -> f ()+bitraverse_ f g = bifoldr ((*>) . f) ((*>) . g) (pure ())++bifor_ :: (Bifoldable t, Applicative f) => t a b -> (a -> f c) -> (b -> f d) -> f ()+bifor_ t f g = bitraverse_ f g t++bimapM_:: (Bifoldable t, Monad m) => (a -> m c) -> (b -> m d) -> t a b -> m ()+bimapM_ f g = bifoldr ((>>) . f) ((>>) . g) (return ())++biforM_ :: (Bifoldable t, Monad m) => t a b ->  (a -> m c) -> (b -> m d) -> m ()+biforM_ t f g = bimapM_ f g t++bisequenceA_ :: (Bifoldable t, Applicative f) => t (f a) (f b) -> f ()+bisequenceA_ = bifoldr (*>) (*>) (pure ())++bisequence_ :: (Bifoldable t, Monad m) => t (m a) (m b) -> m ()+bisequence_ = bifoldr (>>) (>>) (return ())++biList :: Bifoldable t => t a a -> [a]+biList = bifoldr (:) (:) []++biconcat :: Bifoldable t => t [a] [a] -> [a]+biconcat = bifold++biconcatMap :: Bifoldable t => (a -> [c]) -> (b -> [c]) -> t a b -> [c]+biconcatMap = bifoldMap ++biany :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool+biany p q = getAny . bifoldMap (Any . p) (Any . q)++biall :: Bifoldable t => (a -> Bool) -> (b -> Bool) -> t a b -> Bool+biall p q = getAll . bifoldMap (All . p) (All . q)

+ Data/Bifunctor.hs view

@@ -0,0 +1,44 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bifunctor+-- Copyright   :  (C) 2008-2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Bifunctor (Bifunctor(..)) where++import Control.Applicative++-- | Minimal definition either 'bimap' or 'first' and 'second'+class Bifunctor p where+  bimap :: (a -> b) -> (c -> d) -> p a c -> p b d+  bimap f g = first f . second g++  first :: (a -> b) -> p a c -> p b c+  first f = bimap f id++  second :: (b -> c) -> p a b -> p a c+  second = bimap id ++instance Bifunctor (,) where+  bimap f g (a, b) = (f a, g b)++instance Bifunctor ((,,) x) where+  bimap f g (x, a, b) = (x, f a, g b)++instance Bifunctor ((,,,) x y) where+  bimap f g (x, y, a, b) = (x, y, f a, g b)++instance Bifunctor ((,,,,) x y z) where+  bimap f g (x, y, z, a, b) = (x, y, z, f a, g b)++instance Bifunctor Either where+  bimap f _ (Left a) = Left (f a)+  bimap _ g (Right b) = Right (g b)++instance Bifunctor Const where+  bimap f _ (Const a) = Const (f a)

+ Data/Bitraversable.hs view

@@ -0,0 +1,102 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Bitraversable+-- Copyright   :  (C) 2011 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------+module Data.Bitraversable+  ( Bitraversable(..)+  , bifor+  , biforM+  , bimapAccumL+  , bimapAccumR+  , bimapDefault+  , bifoldMapDefault+  ) where++import Control.Applicative+import Data.Monoid+import Data.Bifunctor+import Data.Bifoldable++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++  bisequenceA :: Applicative f => t (f a) (f b) -> f (t a b)+  bisequenceA = bitraverse id id++  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)++  bisequence :: Monad m => t (m a) (m b) -> m (t a b)+  bisequence = bimapM id id++instance Bitraversable (,) where+  bitraverse f g (a, b) = (,) <$> f a <*> g b++instance Bitraversable Either where+  bitraverse f _ (Left a) = Left <$> f a+  bitraverse _ g (Right b) = Right <$> g b++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+++-- 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)++instance Applicative (StateL s) where+        pure x = StateL (\ s -> (s, x))+        StateL kf <*> StateL kv = StateL $ \ s ->+                let (s', f) = kf s+                    (s'', v) = kv s'+                in (s'', f v)++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++-- 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)++instance Applicative (StateR s) where+        pure x = StateR (\ s -> (s, x))+        StateR kf <*> StateR kv = StateR $ \ s ->+                let (s', v) = kv s+                    (s'', f) = kf s'+                in (s'', f v)++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++newtype Id a = Id { getId :: a }++instance Functor Id where+        fmap f (Id x) = Id (f x)++instance Applicative Id where+        pure = Id+        Id f <*> Id x = Id (f x)++bimapDefault :: Bitraversable t => (a -> b) -> (c -> d) -> t a c -> t b d+bimapDefault f g = getId . bitraverse (Id . f) (Id . g)++bifoldMapDefault :: (Bitraversable t, Monoid m) => (a -> m) -> (b -> m) -> t a b -> m +bifoldMapDefault f g = getConst . bitraverse (Const . f) (Const . g)

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright 2008-2011 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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++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.

+ Setup.lhs view

@@ -0,0 +1,7 @@+#!/usr/bin/runhaskell+> module Main (main) where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain

+ bifunctors.cabal view

@@ -0,0 +1,29 @@+name:          bifunctors+category:      Data, Functors+version:       0.1+license:       BSD3+cabal-version: >= 1.6+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     provisional+homepage:      http://github.com/ekmett/bifunctors/+copyright:     Copyright (C) 2008-2011 Edward A. Kmett+synopsis:      Haskell 98 bifunctors+description:   Haskell 98 bifunctors+build-type:    Simple++source-repository head+  type: git+  location: git://github.com/ekmett/bifunctors.git++library+  build-depends: +    base >= 4 && < 4.4++  exposed-modules:+    Data.Bifunctor+    Data.Bifoldable+    Data.Bitraversable++  ghc-options: -Wall