profunctors 3.1 → 3.1.1

raw patch · 8 files changed

+377/−93 lines, 8 filesdep −semigroupoids

Dependencies removed: semigroupoids

Files

• .ghci +1/−0
• .travis.yml +27/−0
• .vim.custom +31/−0
• CHANGELOG.markdown +12/−0
• Data/Profunctor.hs +0/−81
• README.markdown +15/−0
• profunctors.cabal +10/−12
• src/Data/Profunctor.hs +281/−0

@@ -0,0 +1,1 @@+:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h

@@ -1,1 +1,28 @@ language: haskell+before_install:+  # Uncomment whenever hackage is down.+  # - mkdir -p ~/.cabal && cp config ~/.cabal/config && cabal update++  # Try installing some of the build-deps with apt-get for speed.+  - ./travis-cabal-apt-install --only-dependencies --force-reinstall $mode++  - sudo apt-get -q -y install hlint || cabal install hlint++install:+  - cabal configure $mode+  - cabal build++script:+  - $script+  - hlint src --cpp-define HLINT++notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313profunctors\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++env:+  - mode="--enable-tests" script="cabal test"

@@ -0,0 +1,31 @@+" Add the following to your .vimrc to automatically load this on startup++" if filereadable(".vim.custom")+"     so .vim.custom+" endif++function StripTrailingWhitespace()+  let myline=line(".")+  let mycolumn = col(".")+  silent %s/  *$//+  call cursor(myline, mycolumn)+endfunction++" enable syntax highlighting+syntax on++" search for the tags file anywhere between here and /+set tags=TAGS;/++" highlight tabs and trailing spaces+set listchars=tab:‗‗,trail:‗+set list++" f2 runs hasktags+map <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>++" strip trailing whitespace before saving+" au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace()++" rebuild hasktags after saving+au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src"

@@ -0,0 +1,12 @@+3.1.1+-----+* Added Documentation!+* Added `Lenticular` and `Prismatic` Profunctors++3.1+---+* instance Profunctor Tagged++3.0+---+* Updated version number to match the rest of my libraries

@@ -1,81 +0,0 @@-module Data.Profunctor-  ( Profunctor(..)-  , UpStar(..)-  , DownStar(..)-  , WrappedArrow(..)-  ) where--import Control.Arrow-import Control.Category-import Control.Comonad (Cokleisli(..))-import Control.Monad (liftM)-import Data.Tagged-import Prelude hiding (id,(.))--class Profunctor h where-  lmap :: (a -> b) -> h b c -> h a c-  rmap :: (b -> c) -> h a b -> h a c--instance Profunctor (->) where-  lmap = flip (.)-  rmap = (.)--instance Profunctor Tagged where-  lmap _ = retag-  rmap = fmap--newtype UpStar f d c = UpStar { runUpStar :: d -> f c } -instance Functor f => Profunctor (UpStar f) where-  lmap k (UpStar f) = UpStar (f . k)-  rmap k (UpStar f) = UpStar (fmap k . f)--instance Functor f => Functor (UpStar f a) where-  fmap = rmap --newtype DownStar f d c = DownStar { runDownStar :: f d -> c } -instance Functor f => Profunctor (DownStar f) where-  lmap k (DownStar f) = DownStar (f . fmap k)-  rmap k (DownStar f) = DownStar (k . f)--instance Functor (DownStar f a) where-  fmap k (DownStar f) = DownStar (k . f)--newtype WrappedArrow k a b = WrapArrow { unwrapArrow :: k a b } --instance Category k => Category (WrappedArrow k) where-  WrapArrow f . WrapArrow g = WrapArrow (f . g)-  id = WrapArrow id--instance Arrow k => Arrow (WrappedArrow k) where-  arr = WrapArrow . arr-  first = WrapArrow . first . unwrapArrow-  second = WrapArrow . second . unwrapArrow -  WrapArrow a *** WrapArrow b = WrapArrow (a *** b)-  WrapArrow a &&& WrapArrow b = WrapArrow (a &&& b)-  -instance ArrowZero k => ArrowZero (WrappedArrow k) where-  zeroArrow = WrapArrow zeroArrow--instance ArrowChoice k => ArrowChoice (WrappedArrow k) where-  left = WrapArrow . left . unwrapArrow-  right = WrapArrow . right . unwrapArrow-  WrapArrow a +++ WrapArrow b = WrapArrow (a +++ b)-  WrapArrow a ||| WrapArrow b = WrapArrow (a ||| b)-  -instance ArrowApply k => ArrowApply (WrappedArrow k) where-  app = WrapArrow $ app . arr (first unwrapArrow)--instance ArrowLoop k => ArrowLoop (WrappedArrow k) where-  loop = WrapArrow . loop . unwrapArrow --instance Arrow k => Profunctor (WrappedArrow k) where-  lmap = (^>>)-  rmap = (^<<)--instance Monad m => Profunctor (Kleisli m) where-  lmap k (Kleisli f) = Kleisli (f . k)-  rmap k (Kleisli f) = Kleisli (liftM k . f)--instance Functor w => Profunctor (Cokleisli w) where-  lmap k (Cokleisli f) = Cokleisli (f . fmap k)-  rmap k (Cokleisli f) = Cokleisli (k . f)

@@ -0,0 +1,15 @@+Profunctors+===========++[![Build Status](https://secure.travis-ci.org/ekmett/profunctors.png)](http://travis-ci.org/ekmett/profunctors)++Haskell 98 Profunctors++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.++-Edward Kmett

@@ -1,6 +1,6 @@ name:          profunctors category:      Control, Categories-version:       3.1+version:       3.1.1 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -13,7 +13,12 @@ synopsis:      Haskell 98 Profunctors description:   Haskell 98 Profunctors build-type:    Simple-extra-source-files: .travis.yml+extra-source-files:+  .travis.yml+  .ghci+  .vim.custom+  README.markdown+  CHANGELOG.markdown  source-repository head   type: git@@ -22,16 +27,9 @@ library   build-depends:     base          == 4.*,-    semigroupoids == 3.0.*,     comonad       == 3.0.*,     tagged        >= 0.4.4 && < 0.5 -  if impl(ghc)-    cpp-options: -DGHC_TYPEABLE--  extensions: CPP--  exposed-modules:-    Data.Profunctor--  ghc-options:      -Wall+  hs-source-dirs:  src+  exposed-modules: Data.Profunctor+  ghc-options:     -Wall

@@ -0,0 +1,281 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Profunctor+-- Copyright   :  (C) 2011-2012 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- For a good explanation of profunctors in Haskell see Dan Piponi's article:+--+-- <http://blog.sigfpe.com/2011/07/profunctors-in-haskell.html>+--+-- For more information on strength and costrength, see:+--+-- <http://comonad.com/reader/2008/deriving-strength-from-laziness/>+----------------------------------------------------------------------------+module Data.Profunctor+  (+  -- * Profunctors+    Profunctor(..)+  -- ** Profunctorial Strength+  , Lenticular(..)+  , Prismatic(..)+  -- ** Common Profunctors+  , UpStar(..)+  , DownStar(..)+  , WrappedArrow(..)+  ) where++import Control.Applicative hiding (WrappedArrow(..))+import Control.Arrow+import Control.Category+import Control.Comonad (Cokleisli(..))+import Control.Monad (liftM)+import Data.Tagged+import Data.Traversable+import Prelude hiding (id,(.),sequence)+----------------------------------------------------------------------------+-- Profunctors+----------------------------------------------------------------------------++-- | Formally, 'Profunctor' represents a 'profunctor' from @Hask@ -> @Hask@+--+-- Intuitively it is a bifunctor where the first argument is contravariant+-- and the second argument is covariant.+--+-- You can define a profunctor by either defining 'dimap' or by defining both+-- 'lmap' and 'rmap'.+--+-- If you supply 'dimap', you should ensure that:+--+-- @'dimap' 'id' 'id' ≡ 'id'@+--+-- If you supply 'lmap' and 'rmap', ensure:+--+-- @+-- 'lmap' 'id' ≡ 'id'+-- 'rmap' 'id' ≡ 'id'+-- @+--+-- If you supply both, you should also ensure:+--+-- @'dimap' f g ≡ 'lmap' f . 'rmap' g@+--+-- These ensure by parametricity:+--+-- @+-- 'dimap' (f '.' g) (h '.' i) ≡ 'dimap' g h '.' 'dimap' f i+-- 'lmap' (f '.' g) ≡ 'lmap' g '.' 'lmap' f+-- 'rmap' (f '.' g) ≡ 'rmap' f '.' 'rmap' g+-- @+class Profunctor p where+  -- | Map over both arguments at the same time.+  --+  -- @'dimap' f g ≡ 'lmap' f '.' 'rmap' g@+  dimap :: (a -> b) -> (c -> d) -> p b c -> p a d+  dimap f g = lmap f . rmap g+  {-# INLINE dimap #-}++  -- | Map the first argument contravariantly+  --+  -- @'lmap' f ≡ 'dimap' f 'id'@+  lmap :: (a -> b) -> p b c -> p a c+  lmap f = dimap f id+  {-# INLINE lmap #-}++  -- | Map the second argument covariantly+  --+  -- @'rmap' ≡ 'dimap' 'id'@+  rmap :: (b -> c) -> p a b -> p a c+  rmap = dimap id+  {-# INLINE rmap #-}++instance Profunctor (->) where+  dimap ab cd bc = cd . bc . ab+  {-# INLINE dimap #-}+  lmap = flip (.)+  {-# INLINE lmap #-}+  rmap = (.)+  {-# INLINE rmap #-}++instance Profunctor Tagged where+  dimap _ f (Tagged s) = Tagged (f s)+  {-# INLINE dimap #-}+  lmap _ = retag+  {-# INLINE lmap #-}+  rmap = fmap+  {-# INLINE rmap #-}++instance Monad m => Profunctor (Kleisli m) where+  dimap f g (Kleisli h) = Kleisli (liftM g . h . f)+  {-# INLINE dimap #-}+  lmap k (Kleisli f) = Kleisli (f . k)+  {-# INLINE lmap #-}+  rmap k (Kleisli f) = Kleisli (liftM k . f)+  {-# INLINE rmap #-}++instance Functor w => Profunctor (Cokleisli w) where+  dimap f g (Cokleisli h) = Cokleisli (g . h . fmap f)+  {-# INLINE dimap #-}+  lmap k (Cokleisli f) = Cokleisli (f . fmap k)+  {-# INLINE lmap #-}+  rmap k (Cokleisli f) = Cokleisli (k . f)+  {-# INLINE rmap #-}++------------------------------------------------------------------------------+-- UpStar+------------------------------------------------------------------------------++-- | Lift a 'Functor' into a 'Profunctor' (forwards)+newtype UpStar f d c = UpStar { runUpStar :: d -> f c }++instance Functor f => Profunctor (UpStar f) where+  dimap ab cd (UpStar bfc) = UpStar (fmap cd . bfc . ab)+  {-# INLINE dimap #-}+  lmap k (UpStar f) = UpStar (f . k)+  {-# INLINE lmap #-}+  rmap k (UpStar f) = UpStar (fmap k . f)+  {-# INLINE rmap #-}++instance Functor f => Functor (UpStar f a) where+  fmap = rmap+  {-# INLINE fmap #-}++------------------------------------------------------------------------------+-- DownStar+------------------------------------------------------------------------------++-- | Lift a 'Functor' into a 'Profunctor' (backwards)+newtype DownStar f d c = DownStar { runDownStar :: f d -> c }++instance Functor f => Profunctor (DownStar f) where+  dimap ab cd (DownStar fbc) = DownStar (cd . fbc . fmap ab)+  {-# INLINE dimap #-}+  lmap k (DownStar f) = DownStar (f . fmap k)+  {-# INLINE lmap #-}+  rmap k (DownStar f) = DownStar (k . f)+  {-# INLINE rmap #-}++instance Functor (DownStar f a) where+  fmap k (DownStar f) = DownStar (k . f)+  {-# INLINE fmap #-}++------------------------------------------------------------------------------+-- Wrapped Profunctors+------------------------------------------------------------------------------++-- | Wrap an arrow for use as a 'Profunctor'+newtype WrappedArrow p a b = WrapArrow { unwrapArrow :: p a b }++instance Category p => Category (WrappedArrow p) where+  WrapArrow f . WrapArrow g = WrapArrow (f . g)+  {-# INLINE (.) #-}+  id = WrapArrow id+  {-# INLINE id #-}++instance Arrow p => Arrow (WrappedArrow p) where+  arr = WrapArrow . arr+  {-# INLINE arr #-}+  first = WrapArrow . first . unwrapArrow+  {-# INLINE first #-}+  second = WrapArrow . second . unwrapArrow+  {-# INLINE second #-}+  WrapArrow a *** WrapArrow b = WrapArrow (a *** b)+  {-# INLINE (***) #-}+  WrapArrow a &&& WrapArrow b = WrapArrow (a &&& b)+  {-# INLINE (&&&) #-}++instance ArrowZero p => ArrowZero (WrappedArrow p) where+  zeroArrow = WrapArrow zeroArrow+  {-# INLINE zeroArrow #-}++instance ArrowChoice p => ArrowChoice (WrappedArrow p) where+  left = WrapArrow . left . unwrapArrow+  {-# INLINE left #-}+  right = WrapArrow . right . unwrapArrow+  {-# INLINE right #-}+  WrapArrow a +++ WrapArrow b = WrapArrow (a +++ b)+  {-# INLINE (+++) #-}+  WrapArrow a ||| WrapArrow b = WrapArrow (a ||| b)+  {-# INLINE (|||) #-}++instance ArrowApply p => ArrowApply (WrappedArrow p) where+  app = WrapArrow $ app . arr (first unwrapArrow)+  {-# INLINE app #-}++instance ArrowLoop p => ArrowLoop (WrappedArrow p) where+  loop = WrapArrow . loop . unwrapArrow+  {-# INLINE loop #-}++instance Arrow p => Profunctor (WrappedArrow p) where+  lmap = (^>>)+  {-# INLINE lmap #-}+  rmap = (^<<)+  {-# INLINE rmap #-}++------------------------------------------------------------------------------+-- Lenticular+------------------------------------------------------------------------------++-- | Generalizing upstar of a strong 'Functor'+--+-- /Note:/ Every 'Functor' in Haskell is strong.+class Profunctor p => Lenticular p where+  lenticular :: p a b -> p a (a, b)++instance Lenticular (->) where+  lenticular f a = (a, f a)+  {-# INLINE lenticular #-}++instance Monad m => Lenticular (Kleisli m) where+  lenticular (Kleisli f) = Kleisli $ \ a -> do+     b <- f a+     return (a, b)+  {-# INLINE lenticular #-}++instance Functor m => Lenticular (UpStar m) where+  lenticular (UpStar f) = UpStar $ \ a -> (,) a <$> f a+  {-# INLINE lenticular #-}++instance Arrow p => Lenticular (WrappedArrow p) where+  lenticular (WrapArrow k) = WrapArrow (id &&& k)+  {-# INLINE lenticular #-}++------------------------------------------------------------------------------+-- Prismatic+------------------------------------------------------------------------------++-- | The generalization of 'DownStar' of a \"Costrong\" 'Functor'+--+-- /Note:/ Here we use 'Traversable' as an approximate costrength.+class Profunctor p => Prismatic p where+  prismatic :: p a b -> p (Either b a) b++instance Prismatic (->) where+  prismatic = either id+  {-# INLINE prismatic #-}++instance Monad m => Prismatic (Kleisli m) where+  prismatic (Kleisli pab) = Kleisli (either return pab)+  {-# INLINE prismatic #-}++-- | 'sequence' approximates 'costrength'+instance Traversable w => Prismatic (Cokleisli w) where+  prismatic (Cokleisli wab) = Cokleisli (either id wab . sequence)+  {-# INLINE prismatic #-}++-- | 'sequence' approximates 'costrength'+instance Traversable w => Prismatic (DownStar w) where+  prismatic (DownStar wab) = DownStar (either id wab . sequence)+  {-# INLINE prismatic #-}++instance Prismatic Tagged where+  prismatic = retag+  {-# INLINE prismatic #-}++instance ArrowChoice p => Prismatic (WrappedArrow p) where+  prismatic (WrapArrow k) = WrapArrow (id ||| k)+  {-# INLINE prismatic #-}