packages feed

semigroupoid-extras 4.0 → 5

raw patch · 8 files changed

+549/−7 lines, 8 filesdep +profunctorsdep ~basedep ~semigroupoids

Dependencies added: profunctors

Dependency ranges changed: base, semigroupoids

Files

.travis.yml view
@@ -1,8 +1,51 @@-language: haskell+env:+ - GHCVER=7.6.3 CABALVER=1.16+ - GHCVER=7.8.4 CABALVER=1.18+ - GHCVER=7.10.1 CABALVER=1.22+ - GHCVER=head CABALVER=1.22++matrix:+  allow_failures:+   - env: GHCVER=head CABALVER=1.22++before_install:+ - git clone https://github.com/ekmett/bifunctors.git+ - git clone https://github.com/ekmett/profunctors.git+ - git clone https://github.com/ekmett/semigroupoids.git+ - travis_retry sudo add-apt-repository -y ppa:hvr/ghc+ - travis_retry sudo apt-get update+ - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH+ - cabal --version++install:+ - travis_retry cabal update+ - cd bifunctors+ - cabal install+ - cd ../profunctors+ - cabal install+ - cd ../semigroupoids+ - cabal install+ - cd ..+ - cabal install --enable-tests --only-dependencies++script:+ - cabal configure -v2 --enable-tests+ - cabal build+ - cabal sdist+ - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ;+   cd dist/;+   if [ -f "$SRC_TGZ" ]; then+      cabal install "$SRC_TGZ";+   else+      echo "expected '$SRC_TGZ' not found";+      exit 1;+   fi+ notifications:   irc:     channels:       - "irc.freenode.org#haskell-lens"     skip_join: true     template:-      - "\x0313semigroupoid-extras\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"+      - "\x0313semigroupoid-extras\x0f/\x0306%{branch}\x0f \x0314%{commit}\x0f %{message} \x0302\x1f%{build_url}\x0f"
semigroupoid-extras.cabal view
@@ -1,6 +1,6 @@ name:          semigroupoid-extras category:      Control-version:       4.0+version:       5 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -9,10 +9,10 @@ stability:     provisional homepage:      http://github.com/ekmett/semigroupoid-extras bug-reports:   http://github.com/ekmett/semigroupoid-extras/issues-copyright:     Copyright (C) 2011-2013 Edward A. Kmett+copyright:     Copyright (C) 2011-2015 Edward A. Kmett build-type:    Simple-synopsis:      This package has been absorbed into semigroupoids 4.0-description:   This package has been absorbed into semigroupoids 4.0+synopsis:      Semigroupoids that depend on PolyKinds+description:   Semigroupoids that depend on PolyKinds  extra-source-files:   .ghci@@ -24,5 +24,25 @@   type: git   location: git://github.com/ekmett/semigroupoid-extras.git +flag profunctors+  default: True+  manual: True+ library-  build-depends: base >= 4 && < 5, semigroupoids >= 4.0+  hs-source-dirs: src+  ghc-options: -Wall++  exposed-modules:+    Data.Semifunctor+    Data.Semifunctor.Associative+    Data.Semifunctor.Braided+    Data.Semigroupoid.Product+    Data.Semigroupoid.Coproduct++  build-depends:+    base          >= 4.6 && < 5,+    semigroupoids >= 5 && < 6++  if flag(profunctors)+    build-depends: profunctors   >= 5 && < 6+    exposed-modules: Data.Profunctor.Collage
+ src/Data/Profunctor/Collage.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE GADTs #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708+{-# LANGUAGE Trustworthy #-}+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Profunctor.Collage+-- Copyright   :  (C) 2011-2015 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  MPTCs+--+----------------------------------------------------------------------------+module Data.Profunctor.Collage+  ( Collage(..)+  ) where++import Data.Semigroupoid+import Data.Semigroupoid.Ob+import Data.Profunctor++-- | The cograph of a 'Profunctor'.+data Collage k b a where+  L :: (b -> b') -> Collage k (Left b) (Left b')+  R :: (a -> a') -> Collage k (Right a) (Right a')+  C :: k b a     -> Collage k (Left b) (Right a)++instance Profunctor k => Semigroupoid (Collage k) where+  L f `o` L g = L (f . g)+  R f `o` R g = R (f . g)+  R f `o` C g = C (rmap f g)+  C f `o` L g = C (lmap g f)++instance Profunctor k => Ob (Collage k) (Left a) where+  semiid = L semiid++instance Profunctor k => Ob (Collage k) (Right a) where+  semiid = R semiid
+ src/Data/Semifunctor.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE CPP #-}++#ifdef MIN_VERSION_comonad+#if MIN_VERSION_comonad(3,0,3)+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+#else+{-# LANGUAGE Trustworthy #-}+#endif++-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  polykinds+--+----------------------------------------------------------------------------++module Data.Semifunctor+  ( Semifunctor(..)+  , Bi(..)+  , (#)+  , semibimap+  , semifirst+  , semisecond+  , first+  , second+  , WrappedFunctor(..)+  , WrappedTraversable1(..)+  , module Control.Category+  , module Data.Semigroupoid+  , module Data.Semigroupoid.Ob+  , module Data.Semigroupoid.Product+  ) where++import Control.Arrow hiding (first, second, left, right)+import Control.Category+import Control.Monad (liftM)+import Data.Functor.Bind+import Data.Traversable+import Data.Semigroup.Traversable+import Data.Semigroupoid+import Data.Semigroupoid.Dual+import Data.Semigroupoid.Ob+import Data.Semigroupoid.Product+import Prelude hiding ((.),id, mapM)++#ifdef MIN_VERSION_comonad+import Control.Comonad+import Data.Functor.Extend+#ifdef MIN_VERSION_distributive+import Data.Distributive+#endif+#endif++-- | Semifunctors map objects to objects, and arrows to arrows preserving connectivity+-- as normal functors, but do not purport to preserve identity arrows. We apply them+-- to semigroupoids, because those don't even claim to offer identity arrows!+class (Semigroupoid c, Semigroupoid d) => Semifunctor f c d | f c -> d, f d -> c where+  semimap :: c a b -> d (f a) (f b)++data WrappedFunctor f a = WrapFunctor { unwrapFunctor :: f a }++instance Functor f => Semifunctor (WrappedFunctor f) (->) (->) where+  semimap f = WrapFunctor . fmap f . unwrapFunctor++instance (Traversable f, Bind m, Monad m) => Semifunctor (WrappedFunctor f) (Kleisli m) (Kleisli m) where+  semimap (Kleisli f) = Kleisli $ liftM WrapFunctor . mapM f . unwrapFunctor++#if defined(MIN_VERSION_distributive) && defined(MIN_VERSION_comonad)+instance (Distributive f, Extend w) => Semifunctor (WrappedFunctor f) (Cokleisli w) (Cokleisli w) where+  semimap (Cokleisli w) = Cokleisli $ WrapFunctor . cotraverse w . fmap unwrapFunctor+#endif++data WrappedTraversable1 f a = WrapTraversable1 { unwrapTraversable1 :: f a }++instance (Traversable1 f, Bind m) => Semifunctor (WrappedTraversable1 f) (Kleisli m) (Kleisli m) where+  semimap (Kleisli f) = Kleisli $ fmap WrapTraversable1 . traverse1 f . unwrapTraversable1++-- | Used to map a more traditional bifunctor into a semifunctor+data Bi p a where+  Bi :: p a b -> Bi p '(a,b)++instance Semifunctor f c d => Semifunctor f (Dual c) (Dual d) where+  semimap (Dual f) = Dual (semimap f)++(#) :: a -> b -> Bi (,) '(a,b)+a # b = Bi (a,b)++#ifdef MIN_VERSION_comonad+fstP :: Bi (,) '(a, b) -> a+fstP (Bi (a,_)) = a++sndP :: Bi (,) '(a, b) -> b+sndP (Bi (_,b)) = b+#endif++left :: a -> Bi Either '(a,b)+left = Bi . Left++right :: b -> Bi Either '(a,b)+right = Bi . Right++instance Semifunctor (Bi (,)) (Product (->) (->)) (->) where+  semimap (Pair l r) (Bi (a,b)) = l a # r b++instance Semifunctor (Bi Either) (Product (->) (->)) (->) where+  semimap (Pair l _) (Bi (Left a)) = Bi (Left (l a))+  semimap (Pair _ r) (Bi (Right b)) = Bi (Right (r b))++instance Bind m => Semifunctor (Bi (,)) (Product (Kleisli m) (Kleisli m)) (Kleisli m) where+  semimap (Pair l r) = Kleisli (\ (Bi (a, b)) -> (#) <$> runKleisli l a <.> runKleisli r b)++instance Bind m => Semifunctor (Bi Either) (Product (Kleisli m) (Kleisli m)) (Kleisli m) where+  semimap (Pair (Kleisli l0) (Kleisli r0)) = Kleisli (lr l0 r0) where+    lr :: Functor m => (a -> m c) -> (b -> m d) -> Bi Either '(a,b) -> m (Bi Either '(c,d))+    lr l _ (Bi (Left a))  = left <$> l a+    lr _ r (Bi (Right b)) = right <$> r b++#ifdef MIN_VERSION_comonad+instance Extend w => Semifunctor (Bi (,)) (Product (Cokleisli w) (Cokleisli w)) (Cokleisli w) where+  semimap (Pair l r) = Cokleisli $ \p -> runCokleisli l (fstP <$> p) # runCokleisli r (sndP <$> p)++-- instance Extend w => Semifunctor (Bi Either)) (Product (Cokleisli w) (Cokleisli w)) (Cokleisli w) where+#endif++semibimap :: Semifunctor p (Product l r) cod => l a b -> r c d -> cod (p '(a,c)) (p '(b,d))+semibimap f g = semimap (Pair f g)++semifirst :: (Semifunctor p (Product l r) cod, Ob r c) => l a b -> cod (p '(a,c)) (p '(b,c))+semifirst f = semimap (Pair f semiid)++semisecond :: (Semifunctor p (Product l r) cod, Ob l a) => r b c -> cod (p '(a,b)) (p '(a,c))+semisecond f = semimap (Pair semiid f)++first :: (Semifunctor p (Product l r) cod, Category r) => l a b -> cod (p '(a,c)) (p '(b,c))+first f = semimap (Pair f id)++second :: (Semifunctor p (Product l r) cod, Category l) => r b c -> cod (p '(a,b)) (p '(a,c))+second f = semimap (Pair id f)
+ src/Data/Semifunctor/Associative.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE CPP #-}+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  MPTCs, GADTs+--+----------------------------------------------------------------------------+module Data.Semifunctor.Associative where++import Prelude hiding ((.), id)+import Control.Arrow+import Data.Functor.Bind+import Data.Semifunctor+-- import Data.Isomorphism++#ifdef MIN_VERSION_comonad+import Data.Functor.Extend+import Control.Comonad+#endif++class Semifunctor p (Product k k) k => Associative k p where+  associate :: k (p '(p '(a,b) ,c)) (p '(a, p '(b,c)))++instance Associative (->) (Bi Either) where+  associate (Bi (Left (Bi (Left a)))) = Bi (Left a)+  associate (Bi (Left (Bi (Right b)))) = Bi (Right (Bi (Left b)))+  associate (Bi (Right c)) = Bi (Right (Bi (Right c)))++instance Associative (->) (Bi (,)) where+  associate (Bi (Bi (a,b),c)) = Bi(a, Bi(b, c))++kleisliAssociate :: (Monad m, Semifunctor p (Product (Kleisli m) (Kleisli m)) (Kleisli m), Associative (->) p) => Kleisli m (p '(p '(a,b),c)) (p '(a,p '(b,c)))+kleisliAssociate = Kleisli (return . associate)++instance (Bind m, Monad m) => Associative (Kleisli m) (Bi Either) where+  associate = kleisliAssociate++instance (Bind m, Monad m) => Associative (Kleisli m) (Bi (,)) where+  associate = kleisliAssociate++#ifdef MIN_VERSION_comonad+cokleisliAssociate :: (Comonad m, Semifunctor p (Product (Cokleisli m) (Cokleisli m)) (Cokleisli m), Associative (->) p) => Cokleisli m (p '(p '(a,b),c)) (p '(a,p '(b,c)))+cokleisliAssociate = Cokleisli (associate . extract)++instance (Extend m, Comonad m) => Associative (Cokleisli m) (Bi (,)) where+  associate = cokleisliAssociate++-- instance Comonad m => Associative (Cokleisli m) (Bi Either) where associate = cokleisliAssociate+#endif++-- instance Disassociative k p => Associative (Dual k) p+-- instance (Monad m, Semifunctor p (Product (Kleisli m) (Kleisli m) (Kleisli m), Associative (->) p) => Associative (Kleisli m) p) where associate = kleisliAssociate++class Semifunctor p (Product k k) k => Disassociative k p where+  disassociate :: k (p '(a,p '(b,c))) (p '(p '(a,b),c))++instance Disassociative (->) (Bi Either) where+  disassociate (Bi (Left a)) = Bi (Left (Bi (Left a)))+  disassociate (Bi (Right (Bi (Left b)))) = Bi (Left (Bi (Right b)))+  disassociate (Bi (Right (Bi (Right b)))) = Bi (Right b)++instance Disassociative (->) (Bi (,)) where+  disassociate (Bi(a, Bi(b, c))) = Bi (Bi (a,b),c)++kleisliDisassociate :: (Monad m, Semifunctor p (Product (Kleisli m) (Kleisli m)) (Kleisli m), Disassociative (->) p) => Kleisli m (p '(a,p '(b,c))) (p '(p '(a,b),c))+kleisliDisassociate = Kleisli (return . disassociate)++instance (Bind m, Monad m) => Disassociative (Kleisli m) (Bi Either) where+  disassociate = kleisliDisassociate++instance (Bind m, Monad m) => Disassociative (Kleisli m) (Bi (,)) where+  disassociate = kleisliDisassociate++#ifdef MIN_VERSION_comonad+cokleisliDisassociate :: (Comonad m, Semifunctor p (Product (Cokleisli m) (Cokleisli m)) (Cokleisli m), Disassociative (->) p) => Cokleisli m (p '(a,p '(b,c))) (p '(p '(a,b),c))+cokleisliDisassociate = Cokleisli (disassociate . extract)++instance (Extend m, Comonad m) => Disassociative (Cokleisli m) (Bi (,)) where+  disassociate = cokleisliDisassociate+#endif++--  instance Associative k p => Disassociative (Dual k) p++-- instance (Associative k p, Disassociative k p) => Associative (Iso k) p where+--  associate = Iso associate disassociate++--instance (Associative k p, Disassociative k p) => Disassociative (Iso k) p where+--  disassociate = Iso disassociate associate
+ src/Data/Semifunctor/Braided.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE DataKinds #-}++#ifdef MIN_VERSION_comonad+#if MIN_VERSION_comonad(3,0,3)+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+#else+{-# LANGUAGE Trustworthy #-}+#endif++-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  MPTCs, GADTs+--+----------------------------------------------------------------------------+module Data.Semifunctor.Braided+  ( Braided(..)+  , kleisliBraid+#ifdef MIN_VERSION_comonad+  , cokleisliBraid+#endif+  , Symmetric+  , swap+  ) where++import Prelude hiding ((.), id)+import Control.Arrow+import Data.Functor.Bind+import Data.Semifunctor+import Data.Semifunctor.Associative+-- import Data.Semigroupoid.Dual++#ifdef MIN_VERSION_comonad+import Control.Comonad+import Data.Functor.Extend+#endif++class Associative k p => Braided k p where+  braid :: k (p '(a,b)) (p '(b,a))++-- instance Braided k p => Braided (Dual k) p where braid = Dual braid++instance Braided (->) (Bi Either) where+  braid (Bi (Left a)) = Bi (Right a)+  braid (Bi (Right a)) = Bi (Left a)++instance Braided (->) (Bi (,)) where+  braid (Bi (a,b)) = Bi (b,a)++kleisliBraid :: (Monad m, Semifunctor p (Product (Kleisli m) (Kleisli m)) (Kleisli m), Braided (->) p) => Kleisli m (p '(a,b)) (p '(b,a))+kleisliBraid = Kleisli (return . braid)++instance (Bind m, Monad m) => Braided (Kleisli m) (Bi Either) where+  braid = kleisliBraid++instance (Bind m, Monad m) => Braided (Kleisli m) (Bi (,)) where+  braid = kleisliBraid++#ifdef MIN_VERSION_comonad+cokleisliBraid :: (Extend w, Comonad w, Semifunctor p (Product (Cokleisli w) (Cokleisli w)) (Cokleisli w), Braided (->) p) =>+                  Cokleisli w (p '(a,b)) (p '(b,a))+cokleisliBraid = Cokleisli (braid . extract)++instance (Extend w, Comonad w) => Braided (Cokleisli w) (Bi (,)) where+  braid = cokleisliBraid++-- instance Comonad w => Braided (Cokleisli w) (Bi Either) where braid = cokleisliBraid+#endif++class Braided k p => Symmetric k p+instance Symmetric (->) (Bi Either)+instance Symmetric (->) (Bi (,))+instance (Bind m, Monad m) => Symmetric (Kleisli m) (Bi Either)+instance (Bind m, Monad m) => Symmetric (Kleisli m) (Bi (,))+#ifdef MIN_VERSION_comonad+instance (Extend w, Comonad w) => Symmetric (Cokleisli w) (Bi (,))+-- instance Comonad w => Symmetric (Cokleisli w) (Bi Either)+#endif++swap :: Symmetric k p => k (p '(a,b)) (p '(b,a))+swap = braid
+ src/Data/Semigroupoid/Coproduct.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE CPP, GADTs, EmptyDataDecls, PolyKinds, DataKinds, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+----------------------------------------------------------------------------++module Data.Semigroupoid.Coproduct+  ( Coproduct(..), distributeDualCoproduct, factorDualCoproduct) where++import Data.Semigroupoid+import Data.Semigroupoid.Dual+import Data.Semigroupoid.Ob+import Data.Groupoid++data Coproduct j k a b where+  L :: j a b -> Coproduct j k (Left a) (Left b)+  R :: k a b -> Coproduct j k (Right a) (Right b)++instance (Semigroupoid j, Semigroupoid k) => Semigroupoid (Coproduct j k) where+  L f `o` L g = L (f `o` g)+  R f `o` R g = R (f `o` g)+  _ `o` _ = error "GADT fail"++instance (Groupoid j, Groupoid k) => Groupoid (Coproduct j k) where+  inv (L f) = L (inv f)+  inv (R f) = R (inv f)++instance (Ob l a, Semigroupoid r)  => Ob (Coproduct l r) (Left a) where+  semiid = L semiid++instance (Semigroupoid l, Ob r a) => Ob (Coproduct l r) (Right a) where+  semiid = R semiid++distributeDualCoproduct :: Dual (Coproduct j k) a b -> Coproduct (Dual j) (Dual k) a b+distributeDualCoproduct (Dual (L l)) = L (Dual l)+distributeDualCoproduct (Dual (R r)) = R (Dual r)++factorDualCoproduct :: Coproduct (Dual j) (Dual k) a b -> Dual (Coproduct j k) a b+factorDualCoproduct (L (Dual l)) = Dual (L l)+factorDualCoproduct (R (Dual r)) = Dual (R r)
+ src/Data/Semigroupoid/Product.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE GADTs, PolyKinds, DataKinds, MultiParamTypeClasses #-}+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2011-2015 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  polykinds+--+----------------------------------------------------------------------------++module Data.Semigroupoid.Product+  ( Product(..)+  , distributeDualProduct+  , factorDualProduct+  ) where++import Data.Semigroupoid+import Data.Semigroupoid.Ob+import Data.Semigroupoid.Dual+import Data.Groupoid++data Product j k a b where+  Pair :: j a b -> k a' b' -> Product j k '(a,a') '(b,b')++instance (Semigroupoid j, Semigroupoid k) => Semigroupoid (Product j k) where+  Pair w x `o` Pair y z = Pair (w `o` y) (x `o` z)++instance (Groupoid j, Groupoid k) => Groupoid (Product j k) where+  inv (Pair w x) = Pair (inv w) (inv x)++distributeDualProduct :: Dual (Product j k) a b -> Product (Dual j) (Dual k) a b+distributeDualProduct (Dual (Pair l r)) = Pair (Dual l) (Dual r)++factorDualProduct :: Product (Dual j) (Dual k) a b -> Dual (Product j k) a b+factorDualProduct (Pair (Dual l) (Dual r)) = Dual (Pair l r)++instance (Ob l a, Ob r b) => Ob (Product l r) '(a,b) where+  semiid = Pair semiid semiid