semigroupoids 1.0.0 → 1.1.0

raw patch · 5 files changed

+137/−79 lines, 5 files

Files

Control/Arrow/Static.hs +0/−73
Data/Semigroupoid.hs +27/−1
Data/Semigroupoid/Dual.hs +27/−0
Data/Semigroupoid/Static.hs +75/−0
semigroupoids.cabal +8/−5

− Control/Arrow/Static.hs

@@ -1,73 +0,0 @@-{-# LANGUAGE CPP #-}-module Control.Arrow.Static where--import Control.Arrow-import Control.Applicative-import Control.Category-import Control.Comonad-import Control.Monad.Instances-import Control.Monad (ap)-import Data.Functor.Apply-import Data.Functor.Plus-import Data.Monoid-import Data.Semigroup-import Data.Semigroupoid-import Prelude hiding ((.), id)--#ifdef LANGUAGE_DeriveDataTypeable -import Data.Typeable-#endif--newtype Static f a b = Static { runStatic :: f (a -> b) } -#ifdef LANGUAGE_DeriveDataTypeable-  deriving (Typeable)-#endif--instance Functor f => Functor (Static f a) where-  fmap f = Static . fmap (f .) . runStatic--instance Apply f => Apply (Static f a) where-  Static f <.> Static g = Static (ap <$> f <.> g)--instance Alt f => Alt (Static f a) where-  Static f <!> Static g = Static (f <!> g)--instance Plus f => Plus (Static f a) where-  zero = Static zero--instance Applicative f => Applicative (Static f a) where-  pure = Static . pure . const -  Static f <*> Static g = Static (ap <$> f <*> g)--instance (Extend f, Semigroup a) => Extend (Static f a) where-  extend f = Static . extend (\wf m -> f (Static (fmap (. (<>) m) wf))) . runStatic--instance (Comonad f, Semigroup a, Monoid a) => Comonad (Static f a) where-  extract (Static g) = extract g mempty--instance Apply f => Semigroupoid (Static f) where-  Static f `o` Static g = Static ((.) <$> f <.> g)--instance Applicative f => Category (Static f) where-  id = Static (pure id)-  Static f . Static g = Static ((.) <$> f <*> g)--instance Applicative f => Arrow (Static f) where-  arr = Static . pure -  first (Static g) = Static (first <$> g) -  second (Static g) = Static (second <$> g) -  Static g *** Static h = Static ((***) <$> g <*> h)-  Static g &&& Static h = Static ((&&&) <$> g <*> h)--instance Alternative f => ArrowZero (Static f) where-  zeroArrow = Static empty-  -instance Alternative f => ArrowPlus (Static f) where-  Static f <+> Static g = Static (f <|> g)--instance Applicative f => ArrowChoice (Static f) where-  left (Static g) = Static (left <$> g)-  right (Static g) = Static (right <$> g)-  Static g +++ Static h = Static ((+++) <$> g <*> h)-  Static g ||| Static h = Static ((|||) <$> g <*> h)-

Data/Semigroupoid.hs view

@@ -11,12 +11,20 @@ -- A semigroupoid satisfies all of the requirements to be a Category except  -- for the existence of identity arrows. -----------------------------------------------------------------------------module Data.Semigroupoid (Semigroupoid(..)) where+module Data.Semigroupoid +  ( Semigroupoid(..)+  , WrappedCategory(..)+  , Semi(..)+  ) where  import Control.Arrow import Data.Functor.Bind import Control.Comonad import Data.Functor.Contravariant+import Data.Semigroup+import Data.Monoid+import Control.Category+import Prelude hiding (id, (.))  -- | 'Control.Category.Category' sans 'Control.Category.id' class Semigroupoid c where@@ -33,3 +41,21 @@  instance Semigroupoid Op where   Op f `o` Op g = Op (g `o` f)++newtype WrappedCategory k a b = WrapCategory { unwrapCategory :: k a b } ++instance Category k => Semigroupoid (WrappedCategory k) where+  WrapCategory f `o` WrapCategory g = WrapCategory (f . g)++instance Category k => Category (WrappedCategory k) where+  id = WrapCategory id+  WrapCategory f . WrapCategory g = WrapCategory (f . g)++newtype Semi m a b = Semi { getSemi :: m }++instance Semigroup m => Semigroupoid (Semi m) where+  Semi m `o` Semi n = Semi (m <> n)++instance Monoid m => Category (Semi m) where+  id = Semi mempty+  Semi m . Semi n = Semi (m `mappend` n)

+ Data/Semigroupoid/Dual.hs view

@@ -0,0 +1,27 @@+-----------------------------------------------------------------------------+-- |+-- Module      :  Data.Semigroupoid.Dual+-- Copyright   :  (C) 2007-2011 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- A semigroupoid satisfies all of the requirements to be a Category except +-- for the existence of identity arrows.+----------------------------------------------------------------------------+module Data.Semigroupoid.Dual (Dual(..)) where++import Data.Semigroupoid+import Control.Category+import Prelude ()++newtype Dual k a b = Dual { getDual :: k b a } ++instance Semigroupoid k => Semigroupoid (Dual k) where+  Dual f `o` Dual g = Dual (g `o` f)++instance Category k => Category (Dual k) where+  id = Dual id+  Dual f . Dual g = Dual (g . f)

+ Data/Semigroupoid/Static.hs view

@@ -0,0 +1,75 @@+{-# LANGUAGE CPP #-}+module Data.Semigroupoid.Static +  ( Static(..)+  ) where++import Control.Arrow+import Control.Applicative+import Control.Category+import Control.Comonad+import Control.Monad.Instances+import Control.Monad (ap)+import Data.Functor.Apply+import Data.Functor.Plus+import Data.Monoid+import Data.Semigroup+import Data.Semigroupoid+import Prelude hiding ((.), id)++#ifdef LANGUAGE_DeriveDataTypeable +import Data.Typeable+#endif++newtype Static f a b = Static { runStatic :: f (a -> b) } +#ifdef LANGUAGE_DeriveDataTypeable+  deriving (Typeable)+#endif++instance Functor f => Functor (Static f a) where+  fmap f = Static . fmap (f .) . runStatic++instance Apply f => Apply (Static f a) where+  Static f <.> Static g = Static (ap <$> f <.> g)++instance Alt f => Alt (Static f a) where+  Static f <!> Static g = Static (f <!> g)++instance Plus f => Plus (Static f a) where+  zero = Static zero++instance Applicative f => Applicative (Static f a) where+  pure = Static . pure . const +  Static f <*> Static g = Static (ap <$> f <*> g)++instance (Extend f, Semigroup a) => Extend (Static f a) where+  extend f = Static . extend (\wf m -> f (Static (fmap (. (<>) m) wf))) . runStatic++instance (Comonad f, Semigroup a, Monoid a) => Comonad (Static f a) where+  extract (Static g) = extract g mempty++instance Apply f => Semigroupoid (Static f) where+  Static f `o` Static g = Static ((.) <$> f <.> g)++instance Applicative f => Category (Static f) where+  id = Static (pure id)+  Static f . Static g = Static ((.) <$> f <*> g)++instance Applicative f => Arrow (Static f) where+  arr = Static . pure +  first (Static g) = Static (first <$> g) +  second (Static g) = Static (second <$> g) +  Static g *** Static h = Static ((***) <$> g <*> h)+  Static g &&& Static h = Static ((&&&) <$> g <*> h)++instance Alternative f => ArrowZero (Static f) where+  zeroArrow = Static empty+  +instance Alternative f => ArrowPlus (Static f) where+  Static f <+> Static g = Static (f <|> g)++instance Applicative f => ArrowChoice (Static f) where+  left (Static g) = Static (left <$> g)+  right (Static g) = Static (right <$> g)+  Static g +++ Static h = Static ((+++) <$> g <*> h)+  Static g ||| Static h = Static ((|||) <$> g <*> h)+

semigroupoids.cabal view

@@ -1,6 +1,6 @@ name:          semigroupoids category:      Control, Comonads-version:       1.0.0+version:       1.1.0 license:       BSD3 cabal-version: >= 1.6 license-file:  LICENSE@@ -10,7 +10,7 @@ homepage:      http://github.com/ekmett/semigroupoids copyright:     Copyright (C) 2011 Edward A. Kmett build-type:    Simple-synopsis:      Haskell 98: Semigroupoids: Categories sans id, Applicative sans pure, Monad sans return, Alternative sans empty+synopsis:      Haskell 98 semigroupoids: Category sans id description:      Provides a wide array of semigroupoids and operations for working with semigroupds.   .@@ -35,14 +35,16 @@   >                            >                             >-  > Bitraversable <-- Bifoldable <- Bifunctor                      Semigroupoid+  > Bitraversable <-- Bifoldable <- Bifunctor                   Semigroupoid   >     |                  |          |                              |   >     v                  v          v                              v-  > Bitraversable1 <- Bifoldable1   Biapply                        Category+  > Bitraversable1 <- Bifoldable1   Biapply                       Category   >                                                                  |   >                                                                  v   >                                                                Arrow   . +  Apply, Bind, and Extract give rise the Static, Kleisli and Cokleisli semigroupoids respectively.+  .   This lets us remove many of the restrictions from various monad transformers   as in many cases the binding operation or @\<*\>@ operation does not require them.   .@@ -65,7 +67,6 @@     bifunctors >= 0.1 && < 0.2    exposed-modules:-    Control.Arrow.Static     Data.Bifunctor.Apply,     Data.Functor.Alt,     Data.Functor.Apply,@@ -77,5 +78,7 @@     Data.Semigroup.Foldable,     Data.Semigroup.Traversable     Data.Semigroupoid+    Data.Semigroupoid.Dual+    Data.Semigroupoid.Static    ghc-options: -Wall