packages feed

semigroupoids 3.1 → 4.0

raw patch · 14 files changed

+514/−19 lines, 14 filesdep +distributivedep ~comonad

Dependencies added: distributive

Dependency ranges changed: comonad

Files

LICENSE view
@@ -1,4 +1,4 @@-Copyright 2011 Edward Kmett+Copyright 2011-2013 Edward Kmett  All rights reserved. @@ -12,10 +12,6 @@ 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
semigroupoids.cabal view
@@ -1,6 +1,6 @@ name:          semigroupoids category:      Control, Comonads-version:       3.1+version:       4.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -9,26 +9,27 @@ stability:     provisional homepage:      http://github.com/ekmett/semigroupoids bug-reports:   http://github.com/ekmett/semigroupoids/issues-copyright:     Copyright (C) 2011 Edward A. Kmett+copyright:     Copyright (C) 2011-2013 Edward A. Kmett build-type:    Simple-synopsis:      Haskell 98 semigroupoids: Category sans id+synopsis:      Semigroupoids: Category sans id extra-source-files:   .ghci   .travis.yml   .gitignore   .vim.custom description:-  Provides a wide array of semigroupoids and operations for working with semigroupds.+  Provides a wide array of (semi)groupoids and operations for working with them.   .-  A Semigroupoid is a Category without the requirement of identity arrows for every object in the category.+  A 'Semigroupoid' is a 'Category' without the requirement of identity arrows for every object in the category.   .+  A 'Category' is any 'Semigroupoid' for which the Yoneda lemma holds.+  .   When working with comonads you often have the @\<*\>@ portion of an @Applicative@, but   not the @pure@. This was captured in Uustalu and Vene's \"Essence of Dataflow Programming\"   in the form of the @ComonadZip@ class in the days before @Applicative@. Apply provides a weaker invariant, but for the comonads used for data flow programming (found in the streams package), this invariant is preserved. Applicative function composition forms a semigroupoid.   .   Similarly many structures are nearly a comonad, but not quite, for instance lists provide a reasonable 'extend' operation in the form of 'tails', but do not always contain a value.   .-  .   Ideally the following relationships would hold:   .   > Traversable <---- Foldable <--- Functor ------> Alt ---------> Plus           Semigroupoid@@ -56,11 +57,12 @@ library   build-depends:     base          >= 4       && < 5,-    transformers  >= 0.2     && < 0.4,     containers    >= 0.3     && < 0.6,     contravariant >= 0.2.0.1 && < 1,-    comonad       == 3.*     && < 4,-    semigroups    >= 0.8.3.1 && < 1+    comonad       >= 4       && < 5,+    distributive  >= 0.2.2   && < 1,+    semigroups    >= 0.8.3.1 && < 1,+    transformers  >= 0.2     && < 0.4    hs-source-dirs: src @@ -69,12 +71,20 @@     Data.Functor.Apply     Data.Functor.Bind     Data.Functor.Bind.Trans-    Data.Functor.Plus     Data.Functor.Extend+    Data.Functor.Plus+    Data.Groupoid+    Data.Isomorphism+    Data.Semifunctor+    Data.Semifunctor.Associative+    Data.Semifunctor.Braided     Data.Semigroup.Foldable     Data.Semigroup.Traversable     Data.Semigroupoid+    Data.Semigroupoid.Coproduct     Data.Semigroupoid.Dual+    Data.Semigroupoid.Ob+    Data.Semigroupoid.Product     Data.Semigroupoid.Static     Data.Traversable.Instances
src/Data/Functor/Bind.hs view
@@ -52,6 +52,9 @@ import Control.Arrow import Control.Category import Control.Comonad+import Control.Comonad.Trans.Env+import Control.Comonad.Trans.Store+import Control.Comonad.Trans.Traced import Control.Monad (ap) import Control.Monad.Instances import Control.Monad.Trans.Cont@@ -238,6 +241,15 @@  instance Apply (ContT r m) where   ContT f <.> ContT v = ContT $ \k -> f $ \g -> v (k . g)++instance (Semigroup e, Apply w) => Apply (EnvT e w) where+  EnvT ef wf <.> EnvT ea wa = EnvT (ef <> ea) (wf <.> wa)++instance (Apply w, Semigroup s) => Apply (StoreT s w) where+  StoreT ff m <.> StoreT fa n = StoreT ((<*>) <$> ff <.> fa) (m <> n)++instance Apply w => Apply (TracedT m w) where+  TracedT wf <.> TracedT wa = TracedT (ap <$> wf <.> wa)  -- | Wrap an 'Applicative' to be used as a member of 'Apply' newtype WrappedApplicative f a = WrapApplicative { unwrapApplicative :: f a }
src/Data/Functor/Extend.hs view
@@ -21,7 +21,11 @@  import Prelude hiding (id, (.)) import Control.Category+import Control.Comonad.Trans.Env+import Control.Comonad.Trans.Store+import Control.Comonad.Trans.Traced import Control.Monad.Trans.Identity+import Data.Functor.Coproduct import Data.Functor.Identity import Data.Semigroup import Data.List (tails)@@ -75,6 +79,21 @@  instance Extend Tree where   duplicated w@(Node _ as) = Node w (map duplicated as)++instance (Extend f, Extend g) => Extend (Coproduct f g) where+  extended f = Coproduct . coproduct+    (Left . extended (f . Coproduct . Left))+    (Right . extended (f . Coproduct . Right))++instance Extend w => Extend (EnvT e w) where+  duplicated (EnvT e wa) = EnvT e (extended (EnvT e) wa)++instance Extend w => Extend (StoreT s w) where+  duplicated (StoreT wf s) = StoreT (extended StoreT wf) s+  extended f (StoreT wf s) = StoreT (extended (\wf' s' -> f (StoreT wf' s')) wf) s++instance (Extend w, Semigroup m) => Extend (TracedT m w) where+  extended f = TracedT . extended (\wf m -> f (TracedT (fmap (. (<>) m) wf))) . runTracedT  -- I can't fix the world -- instance (Monoid m, Extend n) => Extend (ReaderT m n)
+ src/Data/Groupoid.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif++module Data.Groupoid+  ( Groupoid(..)+  ) where++import Data.Semigroupoid+import Data.Semigroupoid.Dual++-- | semigroupoid with inverses. This technically should be a category with inverses, except we need to use Ob to define the valid objects for the category+class Semigroupoid k => Groupoid k where+  inv :: k a b -> k b a++instance Groupoid k => Groupoid (Dual k) where+  inv (Dual k) = Dual (inv k)
+ src/Data/Isomorphism.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE CPP #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy #-}+#endif+module Data.Isomorphism+  ( Iso(..)+  ) where++import Data.Semigroupoid+import Data.Groupoid+import Control.Category+import Prelude ()++data Iso k a b = Iso { embed :: k a b, project :: k b a }++instance Semigroupoid k => Semigroupoid (Iso k) where+  Iso f g `o` Iso h i = Iso (f `o` h) (i `o` g)++instance Semigroupoid k => Groupoid (Iso k) where+  inv (Iso f g) = Iso g f++instance Category k => Category (Iso k) where+  Iso f g . Iso h i = Iso (f . h) (i . g)+  id = Iso id id
+ src/Data/Semifunctor.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE CPP #-}++#ifndef MIN_VERSION_comonad+#define MIN_VERSION_comonad(x,y,z) 1+#endif++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+#if MIN_VERSION_comonad(3,0,3)+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+#endif++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.Comonad+import Control.Monad (liftM)+import Data.Distributive+import Data.Functor.Bind+import Data.Functor.Extend+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)++-- | 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++instance (Distributive f, Extend w) => Semifunctor (WrappedFunctor f) (Cokleisli w) (Cokleisli w) where+  semimap (Cokleisli w) = Cokleisli $ WrapFunctor . cotraverse w . fmap unwrapFunctor++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)++fstP :: Bi (,) (a, b) -> a+fstP (Bi (a,_)) = a++sndP :: Bi (,) (a, b) -> b+sndP (Bi (_,b)) = b++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++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++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,89 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semifunctor.Associative+-- Copyright   :  (C) 2011-2012 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 Control.Comonad+import Data.Functor.Bind+import Data.Functor.Extend+import Data.Semifunctor+-- import Data.Isomorphism++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++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++-- 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++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++--  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,84 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-}+#ifndef MIN_VERSION_comonad+#define MIN_VERSION_comonad(x,y,z) 1+#endif++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702+#if MIN_VERSION_comonad(3,0,3)+{-# LANGUAGE Safe #-}+#else+{-# LANGUAGE Trustworthy #-}+#endif+#endif+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semifunctor.Braided+-- Copyright   :  (C) 2011-2012 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+  , cokleisliBraid+  , Symmetric+  , swap+  ) where++import Prelude hiding ((.), id)+import Control.Arrow+import Control.Comonad+import Data.Functor.Bind+import Data.Functor.Extend+import Data.Semifunctor+import Data.Semifunctor.Associative+-- import Data.Semigroupoid.Dual++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++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++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 (,))+instance (Extend w, Comonad w) => Symmetric (Cokleisli w) (Bi (,))+-- instance Comonad w => Symmetric (Cokleisli w) (Bi Either)++swap :: Symmetric k p => k (p(a,b)) (p(b,a))+swap = braid
src/Data/Semigroup/Foldable.hs view
@@ -23,6 +23,7 @@ import Data.Functor.Apply import Data.Functor.Product import Data.Functor.Compose+import Data.Functor.Coproduct import Data.Tree import Data.List.NonEmpty (NonEmpty(..)) import Data.Traversable.Instances ()@@ -51,6 +52,9 @@  instance (Foldable1 f, Foldable1 g) => Foldable1 (Product f g) where   foldMap1 f (Pair a b) = foldMap1 f a <> foldMap1 f b++instance (Foldable1 f, Foldable1 g) => Foldable1 (Coproduct f g) where+  foldMap1 f = coproduct (foldMap1 f) (foldMap1 f)  instance Foldable1 NonEmpty where   foldMap1 f (a :| []) = f a
src/Data/Semigroup/Traversable.hs view
@@ -16,16 +16,17 @@  import Control.Applicative import Control.Monad.Trans.Identity-import Data.Functor.Identity import Data.Functor.Apply-import Data.Functor.Product import Data.Functor.Compose+import Data.Functor.Coproduct+import Data.Functor.Identity+import Data.Functor.Product+import Data.List.NonEmpty (NonEmpty(..))+import Data.Semigroup hiding (Product) import Data.Semigroup.Foldable import Data.Traversable import Data.Traversable.Instances () import Data.Tree-import Data.List.NonEmpty (NonEmpty(..))-import Data.Semigroup hiding (Product)  class (Foldable1 t, Traversable t) => Traversable1 t where   traverse1 :: Apply f => (a -> f b) -> t a -> f (t b)@@ -48,6 +49,11 @@  instance (Traversable1 f, Traversable1 g) => Traversable1 (Product f g) where   traverse1 f (Pair a b) = Pair <$> traverse1 f a <.> traverse1 f b++instance (Traversable1 f, Traversable1 g) => Traversable1 (Coproduct f g) where+  traverse1 f = coproduct+    (fmap (Coproduct . Left) . traverse1 f)+    (fmap (Coproduct . Right) . traverse1 f)  instance Traversable1 Tree where   traverse1 f (Node a []) = (`Node`[]) <$> f a
+ src/Data/Semigroupoid/Coproduct.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE GADTs, EmptyDataDecls #-}+module Data.Semigroupoid.Coproduct +  ( L, R, Coproduct(..), distributeDualCoproduct, factorDualCoproduct) where++import Data.Semigroupoid+import Data.Semigroupoid.Dual+import Data.Groupoid++data L a+data R a++data Coproduct j k a b where+  L :: j a b -> Coproduct j k (L a) (L b)+  R :: k a b -> Coproduct j k (R a) (R 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)++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/Ob.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroup.Ob+-- Copyright   :  (C) 2011-2012 Edward Kmett,+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  non-portable (flexible MPTCs)+--+----------------------------------------------------------------------------+module Data.Semigroupoid.Ob where++import Data.Semigroupoid+import Data.Semigroupoid.Product+import Data.Semigroupoid.Coproduct+import Control.Comonad+import Data.Functor.Bind+import Data.Functor.Extend+import Control.Arrow++class Semigroupoid k => Ob k a where+  semiid :: k a a++instance (Ob l a, Ob r b) => Ob (Product l r) (a,b) where+  semiid = Pair semiid semiid++instance (Ob l a, Semigroupoid r)  => Ob (Coproduct l r) (L a) where+  semiid = L semiid++instance (Semigroupoid l, Ob r a) => Ob (Coproduct l r) (R a) where+  semiid = R semiid++instance (Bind m, Monad m) => Ob (Kleisli m) a where+  semiid = Kleisli return++instance (Extend w, Comonad w) => Ob (Cokleisli w) a where+  semiid = Cokleisli extract++instance Ob (->) a where+  semiid = id
+ src/Data/Semigroupoid/Product.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE GADTs #-}+module Data.Semigroupoid.Product +  ( Product(..)+  , distributeDualProduct+  , factorDualProduct+  ) where++import Data.Semigroupoid+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)+