contravariant-0.4.4/0000755000000000000000000000000012204675073012566 5ustar0000000000000000contravariant-0.4.4/.travis.yml0000644000000000000000000000002212204675073014671 0ustar0000000000000000language: haskell contravariant-0.4.4/CHANGELOG.markdown0000644000000000000000000000103112204675073015614 0ustar00000000000000000.4.4 ----- * Fixed compatibility with GHC 7.7 and tightened `Safe` Haskell support. 0.4.1 ----- * Added `Day` convolution under `Data.Functor.Contravariant.Day`. 0.3 --- * Added `Backwards` and `Reverse` instances for `transformers` 0.3 * Added `instance (Functor f, Contravariant g) => Contravariant (Compose f g)`. (This is non-canonical, but is necessary to support other packages.) * Added `Functor` instances to `ComposeFC` and `ComposeCF` for use when modeling phantom type parameters caused mixing `Functor` + `Contravariant`. contravariant-0.4.4/contravariant.cabal0000644000000000000000000000175212204675073016432 0ustar0000000000000000name: contravariant category: Control, Data version: 0.4.4 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/contravariant/ bug-reports: http://github.com/ekmett/contravariant/issues copyright: Copyright (C) 2007-2013 Edward A. Kmett synopsis: Contravariant functors description: Contravariant functors build-type: Simple extra-source-files: .travis.yml CHANGELOG.markdown source-repository head type: git location: git://github.com/ekmett/contravariant.git library build-depends: base < 5, tagged >= 0.4.4 && < 1, transformers >= 0.2 && < 0.4, transformers-compat >= 0.1 && < 1 exposed-modules: Data.Functor.Contravariant Data.Functor.Contravariant.Compose Data.Functor.Contravariant.Day ghc-options: -Wall contravariant-0.4.4/LICENSE0000644000000000000000000000266012204675073013577 0ustar0000000000000000Copyright 2007-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. contravariant-0.4.4/Setup.lhs0000644000000000000000000000016512204675073014400 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain contravariant-0.4.4/Data/0000755000000000000000000000000012204675073013437 5ustar0000000000000000contravariant-0.4.4/Data/Functor/0000755000000000000000000000000012204675073015057 5ustar0000000000000000contravariant-0.4.4/Data/Functor/Contravariant.hs0000644000000000000000000001113712204675073020231 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifdef __GLASGOW_HASKELL__ {-# LANGUAGE DeriveDataTypeable #-} #if __GLASGOW_HASKELL__ >= 702 #if MIN_VERSION_transformers(0,3,0) #if MIN_VERSION_tagged(0,6,1) {-# LANGUAGE Safe #-} #else {-# LANGUAGE Trustworthy #-} #endif #else {-# LANGUAGE Trustworthy #-} #endif #endif #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Contravariant -- Copyright : (C) 2007-2011 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- 'Contravariant' functors, sometimes referred to colloquially as @Cofunctor@, -- even though the dual of a 'Functor' is just a 'Functor'. As with 'Functor' -- the definition of 'Contravariant' for a given ADT is unambiguous. ---------------------------------------------------------------------------- module Data.Functor.Contravariant ( -- * Contravariant Functors Contravariant(..) -- * Operators , (>$<), (>$$<) -- * Predicates , Predicate(..) -- * Comparisons , Comparison(..) , defaultComparison -- * Equivalence Relations , Equivalence(..) , defaultEquivalence -- * Dual arrows , Op(..) ) where import Control.Applicative import Control.Applicative.Backwards import Control.Category import Data.Functor.Product import Data.Functor.Constant import Data.Functor.Compose import Data.Functor.Reverse import Data.Proxy import Prelude hiding ((.),id) #ifdef __GLASGOW_HASKELL__ import Data.Typeable #endif -- | Any instance should be subject to the following laws: -- -- > contramap id = id -- > contramap f . contramap g = contramap (g . f) -- -- Note, that the second law follows from the free theorem of the type of -- 'contramap' and the first law, so you need only check that the former -- condition holds. class Contravariant f where contramap :: (a -> b) -> f b -> f a infixl 4 >$<, >$$< (>$<) :: Contravariant f => (a -> b) -> f b -> f a (>$<) = contramap {-# INLINE (>$<) #-} (>$$<) :: Contravariant f => f b -> (a -> b) -> f a (>$$<) = flip contramap {-# INLINE (>$$<) #-} instance (Contravariant f, Contravariant g) => Contravariant (Product f g) where contramap f (Pair a b) = Pair (contramap f a) (contramap f b) instance Contravariant (Constant a) where contramap _ (Constant a) = Constant a instance Contravariant (Const a) where contramap _ (Const a) = Const a instance (Functor f, Contravariant g) => Contravariant (Compose f g) where contramap f (Compose fga) = Compose (fmap (contramap f) fga) {-# INLINE contramap #-} instance Contravariant f => Contravariant (Backwards f) where contramap f = Backwards . contramap f . forwards {-# INLINE contramap #-} instance Contravariant f => Contravariant (Reverse f) where contramap f = Reverse . contramap f . getReverse {-# INLINE contramap #-} instance Contravariant Proxy where contramap _ Proxy = Proxy newtype Predicate a = Predicate { getPredicate :: a -> Bool } #ifdef __GLASGOW_HASKELL__ deriving Typeable #endif -- | A 'Predicate' is a 'Contravariant' 'Functor', because 'contramap' can -- apply its function argument to the input of the predicate. instance Contravariant Predicate where contramap f g = Predicate $ getPredicate g . f -- | Defines a total ordering on a type as per 'compare' newtype Comparison a = Comparison { getComparison :: a -> a -> Ordering } #ifdef __GLASGOW_HASKELL__ deriving Typeable #endif -- | A 'Comparison' is a 'Contravariant' 'Functor', because 'contramap' can -- apply its function argument to each input to each input to the -- comparison function. instance Contravariant Comparison where contramap f g = Comparison $ \a b -> getComparison g (f a) (f b) -- | Compare using 'compare' defaultComparison :: Ord a => Comparison a defaultComparison = Comparison compare -- | Define an equivalence relation newtype Equivalence a = Equivalence { getEquivalence :: a -> a -> Bool } #ifdef __GLASGOW_HASKELL__ deriving Typeable #endif -- | Equivalence relations are 'Contravariant', because you can -- apply the contramapped function to each input to the equivalence -- relation. instance Contravariant Equivalence where contramap f g = Equivalence $ \a b -> getEquivalence g (f a) (f b) -- | Check for equivalence with '==' defaultEquivalence :: Eq a => Equivalence a defaultEquivalence = Equivalence (==) -- | Dual function arrows. newtype Op a b = Op { getOp :: b -> a } #ifdef __GLASGOW_HASKELL__ deriving Typeable #endif instance Category Op where id = Op id Op f . Op g = Op (g . f) instance Contravariant (Op a) where contramap f g = Op (getOp g . f) contravariant-0.4.4/Data/Functor/Contravariant/0000755000000000000000000000000012204675073017672 5ustar0000000000000000contravariant-0.4.4/Data/Functor/Contravariant/Compose.hs0000644000000000000000000000261112204675073021633 0ustar0000000000000000-- | -- Module : Data.Functor.Contravariant.Compose -- Copyright : (c) Edward Kmett 2010 -- License : BSD3 -- -- Maintainer : ekmett@gmail.com -- Stability : experimental -- Portability : portable -- -- Composition of contravariant functors. module Data.Functor.Contravariant.Compose ( Compose(..) , ComposeFC(..) , ComposeCF(..) ) where import Data.Functor.Contravariant -- | Composition of two contravariant functors newtype Compose f g a = Compose { getCompose :: f (g a) } instance (Contravariant f, Contravariant g) => Functor (Compose f g) where fmap f (Compose x) = Compose (contramap (contramap f) x) -- | Composition of covariant and contravariant functors newtype ComposeFC f g a = ComposeFC { getComposeFC :: f (g a) } instance (Functor f, Contravariant g) => Contravariant (ComposeFC f g) where contramap f (ComposeFC x) = ComposeFC (fmap (contramap f) x) instance (Functor f, Functor g) => Functor (ComposeFC f g) where fmap f (ComposeFC x) = ComposeFC (fmap (fmap f) x) -- | Composition of contravariant and covariant functors newtype ComposeCF f g a = ComposeCF { getComposeCF :: f (g a) } instance (Contravariant f, Functor g) => Contravariant (ComposeCF f g) where contramap f (ComposeCF x) = ComposeCF (contramap (fmap f) x) instance (Functor f, Functor g) => Functor (ComposeCF f g) where fmap f (ComposeCF x) = ComposeCF (fmap (fmap f) x) contravariant-0.4.4/Data/Functor/Contravariant/Day.hs0000644000000000000000000001312312204675073020743 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE Rank2Types #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable #-} #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ <= 707 {-# LANGUAGE KindSignatures #-} #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2013 Edward Kmett, Gershom Bazerman and Derek Elkins -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- The Day convolution of two contravariant functors is a contravariant -- functor. -- -- ---------------------------------------------------------------------------- module Data.Functor.Contravariant.Day ( Day(..) , day , runDay , assoc, disassoc , swapped , intro1, intro2 , day1, day2 , diag , trans1, trans2 ) where import Control.Applicative import Data.Functor.Contravariant import Data.Proxy import Data.Tuple (swap) #ifdef __GLASGOW_HASKELL__ import Data.Typeable #endif -- | The Day convolution of two contravariant functors. data Day f g a = forall b c. Day (f b) (g c) (a -> (b, c)) #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 707 deriving Typeable #endif -- | Construct the Day convolution -- -- @ -- 'day1' ('day' f g) = f -- 'day2' ('day' f g) = g -- @ day :: f a -> g b -> Day f g (a, b) day fa gb = Day fa gb id #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 707 instance (Typeable1 f, Typeable1 g) => Typeable1 (Day f g) where typeOf1 tfga = mkTyConApp dayTyCon [typeOf1 (fa tfga), typeOf1 (ga tfga)] where fa :: t f (g :: * -> *) a -> f a fa = undefined ga :: t (f :: * -> *) g a -> g a ga = undefined dayTyCon :: TyCon #if MIN_VERSION_base(4,4,0) dayTyCon = mkTyCon3 "contravariant" "Data.Functor.Contravariant.Day" "Day" #else dayTyCon = mkTyCon "Data.Functor.Contravariant.Day.Day" #endif #endif instance Contravariant (Day f g) where contramap f (Day fb gc abc) = Day fb gc (abc . f) -- | Break apart the Day convolution of two contravariant functors. runDay :: (Contravariant f, Contravariant g) => Day f g a -> (f a, g a) runDay (Day fb gc abc) = ( contramap (fst . abc) fb , contramap (snd . abc) gc ) -- | Day convolution provides a monoidal product. The associativity -- of this monoid is witnessed by 'assoc' and 'disassoc'. -- -- @ -- 'assoc' . 'disassoc' = 'id' -- 'disassoc' . 'assoc' = 'id' -- 'contramap' f '.' 'assoc' = 'assoc' '.' 'contramap' f -- @ assoc :: Day f (Day g h) a -> Day (Day f g) h a assoc (Day fb (Day gd he cde) abc) = Day (Day fb gd id) he $ \a -> case cde <$> abc a of (b, (d, e)) -> ((b, d), e) -- | Day convolution provides a monoidal product. The associativity -- of this monoid is witnessed by 'assoc' and 'disassoc'. -- -- @ -- 'assoc' . 'disassoc' = 'id' -- 'disassoc' . 'assoc' = 'id' -- 'contramap' f '.' 'disassoc' = 'disassoc' '.' 'contramap' f -- @ disassoc :: Day (Day f g) h a -> Day f (Day g h) a disassoc (Day (Day fd ge bde) hc abc) = Day fd (Day ge hc id) $ \a -> case abc a of (b, c) -> case bde b of (d, e) -> (d, (e, c)) -- | The monoid for Day convolution /in Haskell/ is symmetric. -- -- @ -- 'contramap' f '.' 'swapped' = 'swapped' '.' 'contramap' f -- @ swapped :: Day f g a -> Day g f a swapped (Day fb gc abc) = Day gc fb (swap . abc) -- | Proxy serves as the unit of Day convolution. -- -- @ -- 'day1' '.' 'intro1' = 'id' -- 'contramap' f '.' 'intro1' = 'intro1' '.' 'contramap' f -- @ intro1 :: f a -> Day Proxy f a intro1 fa = Day Proxy fa $ \a -> ((),a) -- | Proxy serves as the unit of Day convolution. -- -- @ -- 'day2' '.' 'intro2' = 'id' -- 'contramap' f '.' 'intro2' = 'intro2' '.' 'contramap' f -- @ intro2 :: f a -> Day f Proxy a intro2 fa = Day fa Proxy $ \a -> (a,()) -- | In Haskell we can do general purpose elimination, but in a more general setting -- it is only possible to eliminate the unit. -- -- @ -- 'day1' '.' 'intro1' = 'id' -- 'day1' = 'fst' '.' 'runDay' -- 'contramap' f '.' 'day1' = 'day1' '.' 'contramap' f -- @ day1 :: Contravariant f => Day f g a -> f a day1 (Day fb _ abc) = contramap (fst . abc) fb -- | In Haskell we can do general purpose elimination, but in a more general setting -- it is only possible to eliminate the unit. -- @ -- 'day2' '.' 'intro2' = 'id' -- 'day2' = 'snd' '.' 'runDay' -- 'contramap' f '.' 'day2' = 'day2' '.' 'contramap' f -- @ day2 :: Contravariant g => Day f g a -> g a day2 (Day _ gc abc) = contramap (snd . abc) gc -- | Diagonalize the Day convolution: -- -- @ -- 'day1' '.' 'diag' = 'id' -- 'day2' '.' 'diag' = 'id' -- 'runDay '.' 'diag' = \a -> (a,a) -- 'contramap' f . 'diag' = 'diag' . 'contramap' f -- @ diag :: f a -> Day f f a diag fa = Day fa fa $ \a -> (a,a) -- | Apply a natural transformation to the left-hand side of a Day convolution. -- -- This respects the naturality of the natural transformation you supplied: -- -- @ -- 'contramap' f '.' 'trans1' fg = 'trans1' fg '.' 'contramap' f -- @ trans1 :: (forall x. f x -> g x) -> Day f h a -> Day g h a trans1 fg (Day fb hc abc) = Day (fg fb) hc abc -- | Apply a natural transformation to the right-hand side of a Day convolution. -- -- This respects the naturality of the natural transformation you supplied: -- -- @ -- 'contramap' f '.' 'trans2' fg = 'trans2' fg '.' 'contramap' f -- @ trans2 :: (forall x. g x -> h x) -> Day f g a -> Day f h a trans2 gh (Day fb gc abc) = Day fb (gh gc) abc