adjunctions-3.2.1.1/0000755000000000000000000000000012226533325012366 5ustar0000000000000000adjunctions-3.2.1.1/.ghci0000644000000000000000000000012512226533325013277 0ustar0000000000000000:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h adjunctions-3.2.1.1/.gitignore0000644000000000000000000000010412226533325014351 0ustar0000000000000000dist docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# adjunctions-3.2.1.1/.travis.yml0000644000000000000000000000122012226533325014472 0ustar0000000000000000language: haskell before_install: # Uncomment whenever hackage is down. # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update - cabal update # Try installing some of the build-deps with apt-get for speed. - travis/cabal-apt-install $mode 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: - "\x0313adjunctions\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" env: - mode="--enable-tests" script="cabal test --show-details=always" adjunctions-3.2.1.1/.vim.custom0000644000000000000000000000137712226533325014503 0ustar0000000000000000" 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 :exec ":!hasktags -x -c --ignore src" " 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" adjunctions-3.2.1.1/adjunctions.cabal0000644000000000000000000000350112226533325015672 0ustar0000000000000000name: adjunctions category: Data Structures, Adjunctions version: 3.2.1.1 license: BSD3 cabal-version: >= 1.6 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/adjunctions/ bug-reports: http://github.com/ekmett/adjunctions/issues copyright: Copyright (C) 2011-2013 Edward A. Kmett synopsis: Adjunctions description: Adjunctions build-type: Simple extra-source-files: .ghci .gitignore .travis.yml .vim.custom travis/cabal-apt-install travis/config HLint.hs CHANGELOG.markdown README.markdown source-repository head type: git location: git://github.com/ekmett/adjunctions.git library hs-source-dirs: src other-extensions: CPP FunctionalDependencies FlexibleContexts MultiParamTypeClasses Rank2Types UndecidableInstances build-depends: array >= 0.3.0.2 && < 0.6, base >= 4 && < 5, transformers >= 0.2 && < 0.4, mtl >= 2.0.1 && < 2.2, containers >= 0.3 && < 0.6, comonad >= 3 && < 4, contravariant >= 0.2.0.1 && < 1, distributive >= 0.2.2 && < 1, semigroupoids >= 3 && < 4, void >= 0.5.5.1 && < 1, keys >= 3 && < 4, comonad-transformers >= 3 && < 4, representable-functors >= 3.1 && < 4, free >= 3 && < 4 exposed-modules: Data.Functor.Adjunction Data.Functor.Contravariant.Adjunction Control.Comonad.Trans.Adjoint Control.Monad.Trans.Adjoint Control.Monad.Trans.Conts Control.Monad.Trans.Contravariant.Adjoint ghc-options: -Wall adjunctions-3.2.1.1/CHANGELOG.markdown0000644000000000000000000000034012226533325015416 0ustar00000000000000003.2.1.1 ------- * Updated the `array` dependency 3.2.1 ----- * Marked modules appropriately `Trustworthy`. 3.2 --- * Updated to `representable-functors` 3.1, which changed the API for contravariant representable functors. adjunctions-3.2.1.1/HLint.hs0000644000000000000000000000007512226533325013742 0ustar0000000000000000import "hint" HLint.Default ignore "Warning: Avoid lambda" adjunctions-3.2.1.1/LICENSE0000644000000000000000000000266012226533325013377 0ustar0000000000000000Copyright 2011-2013 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. adjunctions-3.2.1.1/README.markdown0000644000000000000000000000061512226533325015071 0ustar0000000000000000adjunctions ========== [![Build Status](https://secure.travis-ci.org/ekmett/adjunctions.png?branch=master)](http://travis-ci.org/ekmett/adjunctions) This package provides adjunctions for Haskell. 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 adjunctions-3.2.1.1/Setup.lhs0000644000000000000000000000016512226533325014200 0ustar0000000000000000#!/usr/bin/runhaskell > module Main (main) where > import Distribution.Simple > main :: IO () > main = defaultMain adjunctions-3.2.1.1/src/0000755000000000000000000000000012226533325013155 5ustar0000000000000000adjunctions-3.2.1.1/src/Control/0000755000000000000000000000000012226533325014575 5ustar0000000000000000adjunctions-3.2.1.1/src/Control/Comonad/0000755000000000000000000000000012226533325016155 5ustar0000000000000000adjunctions-3.2.1.1/src/Control/Comonad/Trans/0000755000000000000000000000000012226533325017244 5ustar0000000000000000adjunctions-3.2.1.1/src/Control/Comonad/Trans/Adjoint.hs0000644000000000000000000000366212226533325021177 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2011-2013 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : MPTCs, fundeps -- ---------------------------------------------------------------------------- module Control.Comonad.Trans.Adjoint ( Adjoint , runAdjoint , adjoint , AdjointT(..) ) where import Prelude hiding (sequence) import Control.Applicative import Control.Comonad import Control.Comonad.Trans.Class import Data.Functor.Adjunction import Data.Functor.Extend import Data.Functor.Identity import Data.Distributive type Adjoint f g = AdjointT f g Identity newtype AdjointT f g w a = AdjointT { runAdjointT :: f (w (g a)) } adjoint :: Functor f => f (g a) -> Adjoint f g a adjoint = AdjointT . fmap Identity runAdjoint :: Functor f => Adjoint f g a -> f (g a) runAdjoint = fmap runIdentity . runAdjointT instance (Adjunction f g, Functor w) => Functor (AdjointT f g w) where fmap f (AdjointT g) = AdjointT $ fmap (fmap (fmap f)) g b <$ (AdjointT g) = AdjointT $ fmap (fmap (b <$)) g instance (Adjunction f g, Extend w) => Extend (AdjointT f g w) where extended f (AdjointT m) = AdjointT $ fmap (extended $ leftAdjunct (f . AdjointT)) m instance (Adjunction f g, Comonad w) => Comonad (AdjointT f g w) where extend f (AdjointT m) = AdjointT $ fmap (extend $ leftAdjunct (f . AdjointT)) m extract = rightAdjunct extract . runAdjointT {- instance (Adjunction f g, Monad m) => Applicative (AdjointT f g m) where pure = AdjointT . leftAdjunct return (<*>) = ap -} instance (Adjunction f g, Distributive g) => ComonadTrans (AdjointT f g) where lower = counit . fmap distribute . runAdjointT adjunctions-3.2.1.1/src/Control/Monad/0000755000000000000000000000000012226533325015633 5ustar0000000000000000adjunctions-3.2.1.1/src/Control/Monad/Trans/0000755000000000000000000000000012226533325016722 5ustar0000000000000000adjunctions-3.2.1.1/src/Control/Monad/Trans/Adjoint.hs0000644000000000000000000000350412226533325020650 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2011-2013 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : MPTCs, fundeps -- ---------------------------------------------------------------------------- module Control.Monad.Trans.Adjoint ( Adjoint , runAdjoint , adjoint , AdjointT(..) ) where import Prelude hiding (sequence) import Control.Applicative import Control.Monad (ap, liftM) import Control.Monad.Trans.Class import Data.Traversable import Data.Functor.Adjunction import Data.Functor.Identity type Adjoint f g = AdjointT f g Identity newtype AdjointT f g m a = AdjointT { runAdjointT :: g (m (f a)) } adjoint :: Functor g => g (f a) -> Adjoint f g a adjoint = AdjointT . fmap Identity runAdjoint :: Functor g => Adjoint f g a -> g (f a) runAdjoint = fmap runIdentity . runAdjointT instance (Adjunction f g, Monad m) => Functor (AdjointT f g m) where fmap f (AdjointT g) = AdjointT $ fmap (liftM (fmap f)) g b <$ AdjointT g = AdjointT $ fmap (liftM (b <$)) g instance (Adjunction f g, Monad m) => Applicative (AdjointT f g m) where pure = AdjointT . leftAdjunct return (<*>) = ap instance (Adjunction f g, Monad m) => Monad (AdjointT f g m) where return = AdjointT . leftAdjunct return AdjointT m >>= f = AdjointT $ fmap (>>= rightAdjunct (runAdjointT . f)) m -- | Exploiting this instance requires that we have the missing Traversables for Identity, (,)e and IdentityT instance (Adjunction f g, Traversable f) => MonadTrans (AdjointT f g) where lift = AdjointT . fmap sequence . unit adjunctions-3.2.1.1/src/Control/Monad/Trans/Conts.hs0000644000000000000000000000474412226533325020355 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2011-2013 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : MPTCs, fundeps -- -- > Cont r ~ Contravariant.Adjoint (Op r) (Op r) -- > Conts r ~ Contravariant.AdjointT (Op r) (Op r) -- > ContsT r w m ~ Contravariant.AdjointT (Op (m r)) (Op (m r)) w ---------------------------------------------------------------------------- module Control.Monad.Trans.Conts ( -- * Continuation passing style Cont , cont , runCont -- * Multiple-continuation passing style , Conts , runConts , conts -- * Multiple-continuation passing style transformer , ContsT(..) , callCC ) where import Prelude hiding (sequence) import Control.Applicative import Control.Comonad import Control.Monad.Trans.Class import Control.Monad (ap) import Data.Functor.Apply import Data.Functor.Identity type Cont r = ContsT r Identity Identity cont :: ((a -> r) -> r) -> Cont r a cont f = ContsT $ \ (Identity k) -> Identity $ f $ runIdentity . k runCont :: Cont r a -> (a -> r) -> r runCont (ContsT k) f = runIdentity $ k $ Identity (Identity . f) type Conts r w = ContsT r w Identity conts :: Functor w => (w (a -> r) -> r) -> Conts r w a conts k = ContsT $ Identity . k . fmap (runIdentity .) runConts :: Functor w => Conts r w a -> w (a -> r) -> r runConts (ContsT k) = runIdentity . k . fmap (Identity .) newtype ContsT r w m a = ContsT { runContsT :: w (a -> m r) -> m r } instance Functor w => Functor (ContsT r w m) where fmap f (ContsT k) = ContsT $ k . fmap (. f) instance Comonad w => Apply (ContsT r w m) where (<.>) = ap instance Comonad w => Applicative (ContsT r w m) where pure x = ContsT $ \f -> extract f x (<*>) = ap instance Comonad w => Monad (ContsT r w m) where return = pure ContsT k >>= f = ContsT $ k . extend (\wa a -> runContsT (f a) wa) callCC :: Comonad w => ((a -> ContsT r w m b) -> ContsT r w m a) -> ContsT r w m a callCC f = ContsT $ \wamr -> runContsT (f (\a -> ContsT $ \_ -> extract wamr a)) wamr {- callCCs :: Comonad w => (w (a -> ContsT r w m b) -> ContsT r w m a) -> ContsT r w m a callCCs f = -} instance Comonad w => MonadTrans (ContsT r w) where lift m = ContsT $ extract . fmap (m >>=) adjunctions-3.2.1.1/src/Control/Monad/Trans/Contravariant/0000755000000000000000000000000012226533325021535 5ustar0000000000000000adjunctions-3.2.1.1/src/Control/Monad/Trans/Contravariant/Adjoint.hs0000644000000000000000000000376312226533325023472 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Monad.Trans.Contravariant.Adjoint -- Copyright : (C) 2011 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : MPTCs, fundeps -- -- Uses a contravariant adjunction: -- -- f -| g : Hask^op -> Hask -- -- to build a 'Comonad' to 'Monad' transformer. Sadly, the dual construction, -- which builds a 'Comonad' out of a 'Monad', is uninhabited, because any -- 'Adjunction' of the form -- -- > f -| g : Hask -> Hask^op -- -- would trivially admit unsafePerformIO. -- ---------------------------------------------------------------------------- module Control.Monad.Trans.Contravariant.Adjoint ( Adjoint , runAdjoint , adjoint , AdjointT(..) ) where import Prelude hiding (sequence) import Control.Applicative import Control.Comonad import Control.Monad (ap) import Data.Functor.Identity import Data.Functor.Contravariant import Data.Functor.Contravariant.Adjunction type Adjoint f g = AdjointT f g Identity newtype AdjointT f g w a = AdjointT { runAdjointT :: g (w (f a)) } adjoint :: Contravariant g => g (f a) -> Adjoint f g a adjoint = AdjointT . contramap runIdentity runAdjoint :: Contravariant g => Adjoint f g a -> g (f a) runAdjoint = contramap Identity . runAdjointT instance (Adjunction f g, Functor w) => Functor (AdjointT f g w) where fmap f (AdjointT g) = AdjointT $ contramap (fmap (contramap f)) g instance (Adjunction f g, Comonad w) => Applicative (AdjointT f g w) where pure = AdjointT . leftAdjunct extract (<*>) = ap instance (Adjunction f g, Comonad w) => Monad (AdjointT f g w) where return = AdjointT . leftAdjunct extract AdjointT m >>= f = AdjointT $ contramap (extend (rightAdjunct (runAdjointT . f))) m adjunctions-3.2.1.1/src/Data/0000755000000000000000000000000012226533325014026 5ustar0000000000000000adjunctions-3.2.1.1/src/Data/Functor/0000755000000000000000000000000012226533325015446 5ustar0000000000000000adjunctions-3.2.1.1/src/Data/Functor/Adjunction.hs0000644000000000000000000001352712226533325020110 0ustar0000000000000000{-# LANGUAGE Rank2Types , MultiParamTypeClasses , FunctionalDependencies , UndecidableInstances #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ------------------------------------------------------------------------------------------- -- | -- Copyright : 2008-2013 Edward Kmett -- License : BSD -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : rank 2 types, MPTCs, fundeps -- ------------------------------------------------------------------------------------------- module Data.Functor.Adjunction ( Adjunction(..) , tabulateAdjunction , indexAdjunction , zapWithAdjunction , zipR, unzipR , unabsurdL, absurdL , cozipL, uncozipL , extractL, duplicateL , splitL, unsplitL ) where import Control.Applicative import Control.Arrow ((&&&), (|||)) import Control.Monad.Free import Control.Monad.Instances () import Control.Monad.Trans.Identity import Control.Monad.Trans.Reader import Control.Monad.Trans.Writer import Control.Comonad import Control.Comonad.Cofree import Control.Comonad.Trans.Env import Control.Comonad.Trans.Traced import Data.Functor.Identity import Data.Functor.Coproduct import Data.Functor.Compose import Data.Functor.Product import Data.Functor.Representable import Data.Void -- | An adjunction between Hask and Hask. -- -- Minimal definition: both 'unit' and 'counit' or both 'leftAdjunct' -- and 'rightAdjunct', subject to the constraints imposed by the -- default definitions that the following laws should hold. -- -- > unit = leftAdjunct id -- > counit = rightAdjunct id -- > leftAdjunct f = fmap f . unit -- > rightAdjunct f = counit . fmap f -- -- Any implementation is required to ensure that 'leftAdjunct' and -- 'rightAdjunct' witness an isomorphism from @Nat (f a, b)@ to -- @Nat (a, g b)@ -- -- > rightAdjunct unit = id -- > leftAdjunct counit = id class (Functor f, Representable u) => Adjunction f u | f -> u, u -> f where unit :: a -> u (f a) counit :: f (u a) -> a leftAdjunct :: (f a -> b) -> a -> u b rightAdjunct :: (a -> u b) -> f a -> b unit = leftAdjunct id counit = rightAdjunct id leftAdjunct f = fmap f . unit rightAdjunct f = counit . fmap f -- | Every right adjoint is representable by its left adjoint -- applied to a unit element -- -- Use this definition and the primitives in -- Data.Functor.Representable to meet the requirements of the -- superclasses of Representable. tabulateAdjunction :: Adjunction f u => (f () -> b) -> u b tabulateAdjunction f = leftAdjunct f () -- | This definition admits a default definition for the -- 'index' method of 'Index", one of the superclasses of -- Representable. indexAdjunction :: Adjunction f u => u b -> f a -> b indexAdjunction = rightAdjunct . const zapWithAdjunction :: Adjunction f u => (a -> b -> c) -> u a -> f b -> c zapWithAdjunction f ua = rightAdjunct (\b -> fmap (flip f b) ua) splitL :: Adjunction f u => f a -> (a, f ()) splitL = rightAdjunct (flip leftAdjunct () . (,)) unsplitL :: Functor f => a -> f () -> f a unsplitL = (<$) extractL :: Adjunction f u => f a -> a extractL = fst . splitL duplicateL :: Adjunction f u => f a -> f (f a) duplicateL as = as <$ as -- | A right adjoint functor admits an intrinsic -- notion of zipping zipR :: Adjunction f u => (u a, u b) -> u (a, b) zipR = leftAdjunct (rightAdjunct fst &&& rightAdjunct snd) -- | Every functor in Haskell permits unzipping unzipR :: Functor u => u (a, b) -> (u a, u b) unzipR = fmap fst &&& fmap snd absurdL :: Void -> f Void absurdL = absurd -- | A left adjoint must be inhabited, or we can derive bottom. unabsurdL :: Adjunction f u => f Void -> Void unabsurdL = rightAdjunct absurd -- | And a left adjoint must be inhabited by exactly one element cozipL :: Adjunction f u => f (Either a b) -> Either (f a) (f b) cozipL = rightAdjunct (leftAdjunct Left ||| leftAdjunct Right) -- | Every functor in Haskell permits 'uncozipping' uncozipL :: Functor f => Either (f a) (f b) -> f (Either a b) uncozipL = fmap Left ||| fmap Right -- Requires deprecated Impredicative types -- limitR :: Adjunction f u => (forall a. u a) -> u (forall a. a) -- limitR = leftAdjunct (rightAdjunct (\(x :: forall a. a) -> x)) instance Adjunction ((,) e) ((->) e) where leftAdjunct f a e = f (e, a) rightAdjunct f ~(e, a) = f a e instance Adjunction Identity Identity where leftAdjunct f = Identity . f . Identity rightAdjunct f = runIdentity . f . runIdentity instance Adjunction f g => Adjunction (IdentityT f) (IdentityT g) where unit = IdentityT . leftAdjunct IdentityT counit = rightAdjunct runIdentityT . runIdentityT instance Adjunction w m => Adjunction (EnvT e w) (ReaderT e m) where unit = ReaderT . flip fmap EnvT . flip leftAdjunct counit (EnvT e w) = rightAdjunct (flip runReaderT e) w instance Adjunction m w => Adjunction (WriterT s m) (TracedT s w) where unit = TracedT . leftAdjunct (\ma s -> WriterT (fmap (\a -> (a, s)) ma)) counit = rightAdjunct (\(t, s) -> ($s) <$> runTracedT t) . runWriterT instance (Adjunction f g, Adjunction f' g') => Adjunction (Compose f' f) (Compose g g') where unit = Compose . leftAdjunct (leftAdjunct Compose) counit = rightAdjunct (rightAdjunct getCompose) . getCompose instance (Adjunction f g, Adjunction f' g') => Adjunction (Coproduct f f') (Product g g') where unit a = Pair (leftAdjunct left a) (leftAdjunct right a) counit = coproduct (rightAdjunct fstP) (rightAdjunct sndP) where fstP (Pair x _) = x sndP (Pair _ x) = x instance Adjunction f u => Adjunction (Free f) (Cofree u) where unit a = return a :< tabulateAdjunction (\k -> leftAdjunct (wrap . flip unsplitL k) a) counit (Pure a) = extract a counit (Free k) = rightAdjunct (flip indexAdjunction k . unwrap) (extractL k) adjunctions-3.2.1.1/src/Data/Functor/Contravariant/0000755000000000000000000000000012226533325020261 5ustar0000000000000000adjunctions-3.2.1.1/src/Data/Functor/Contravariant/Adjunction.hs0000644000000000000000000000400512226533325022712 0ustar0000000000000000{-# LANGUAGE Rank2Types, MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2011-2013 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : MPTCs -- ---------------------------------------------------------------------------- module Data.Functor.Contravariant.Adjunction ( Adjunction(..) , contrarepAdjunction , coindexAdjunction ) where import Control.Monad.Instances () import Data.Functor.Contravariant import Data.Functor.Contravariant.Representable -- | An adjunction from @Hask^op@ to @Hask@ -- -- @'Op' (f a) b ~ 'Hask' a (g b)@ -- -- @ -- 'rightAdjunct' 'unit' = 'id' -- 'leftAdjunct' 'counit' = 'id' -- @ -- -- Any adjunction from @Hask@ to @Hask^op@ would indirectly -- permit @unsafePerformIO@, and therefore does not exist. class (Contravariant f, Representable g) => Adjunction f g | f -> g, g -> f where unit :: a -> g (f a) -- monad in Hask counit :: a -> f (g a) -- comonad in Hask^op leftAdjunct :: (b -> f a) -> a -> g b rightAdjunct :: (a -> g b) -> b -> f a unit = leftAdjunct id counit = rightAdjunct id leftAdjunct f = contramap f . unit rightAdjunct f = contramap f . counit -- | This 'Adjunction' gives rise to the @Cont@ 'Monad' instance Adjunction (Op r) (Op r) where unit a = Op (\k -> getOp k a) counit = unit -- | This gives rise to the @Cont Bool@ 'Monad' instance Adjunction Predicate Predicate where unit a = Predicate (\k -> getPredicate k a) counit = unit -- | Represent a 'Contravariant' functor that has a left adjoint contrarepAdjunction :: Adjunction f g => (a -> f ()) -> g a contrarepAdjunction = flip leftAdjunct () coindexAdjunction :: Adjunction f g => g a -> a -> f () coindexAdjunction = rightAdjunct . const adjunctions-3.2.1.1/travis/0000755000000000000000000000000012226533325013676 5ustar0000000000000000adjunctions-3.2.1.1/travis/cabal-apt-install0000755000000000000000000000127212226533325017116 0ustar0000000000000000#! /bin/bash set -eu APT="sudo apt-get -q -y" CABAL_INSTALL_DEPS="cabal install --only-dependencies --force-reinstall" $APT update $APT install dctrl-tools # Find potential system packages to satisfy cabal dependencies deps() { local M='^\([^ ]\+\)-[0-9.]\+ (.*$' local G=' -o ( -FPackage -X libghc-\L\1\E-dev )' local E="$($CABAL_INSTALL_DEPS "$@" --dry-run -v 2> /dev/null \ | sed -ne "s/$M/$G/p" | sort -u)" grep-aptavail -n -sPackage \( -FNone -X None \) $E | sort -u } $APT install $(deps "$@") libghc-quickcheck2-dev # QuickCheck is special $CABAL_INSTALL_DEPS "$@" # Install the rest via Hackage if ! $APT install hlint ; then $APT install $(deps hlint) cabal install hlint fi adjunctions-3.2.1.1/travis/config0000644000000000000000000000120612226533325015065 0ustar0000000000000000-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix -- -- This is particularly useful for travis-ci to get it to stop complaining -- about a broken build when everything is still correct on our end. -- -- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead -- -- To enable this, uncomment the before_script in .travis.yml remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive remote-repo-cache: ~/.cabal/packages world-file: ~/.cabal/world build-summary: ~/.cabal/logs/build.log remote-build-reporting: anonymous install-dirs user install-dirs global