diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..7001208 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +_darcs +dist diff --git a/Data/Bifoldable.hs b/Data/Bifoldable.hs new file mode 100644 index 0000000..1aaa465 --- /dev/null +++ b/Data/Bifoldable.hs @@ -0,0 +1,104 @@ +----------------------------------------------------------------------------- +-- | +-- 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_ + , 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) diff --git a/Data/Bifunctor.hs b/Data/Bifunctor.hs new file mode 100644 index 0000000..1f74d21 --- /dev/null +++ b/Data/Bifunctor.hs @@ -0,0 +1,44 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Data.Bifunctor +-- Copyright : (C) 2008-2011 Edward Kmett, +-- License : BSD-style (see the file LICENSE) +-- +-- Maintainer : Edward Kmett +-- 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) diff --git a/Data/Bitraversable.hs b/Data/Bitraversable.hs new file mode 100644 index 0000000..b26467d --- /dev/null +++ b/Data/Bitraversable.hs @@ -0,0 +1,102 @@ +----------------------------------------------------------------------------- +-- | +-- 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.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) diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..3bb1c86 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 index 0000000..6cbd928 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,7 @@ +#!/usr/bin/runhaskell +> module Main (main) where + +> import Distribution.Simple + +> main :: IO () +> main = defaultMain diff --git a/bifunctors.cabal b/bifunctors.cabal new file mode 100644 index 0000000..c9e5e37 --- /dev/null +++ b/bifunctors.cabal @@ -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 +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