Permalink
Browse files

repo initialized

  • Loading branch information...
0 parents commit 68036520577ce772d97435a1b7a670dc70775335 @ekmett committed Jan 21, 2011
Showing with 146 additions and 0 deletions.
  1. +49 −0 Control/Monad/Trans/Adjoint.hs
  2. +31 −0 Data/Functor/Adjunction.hs
  3. +30 −0 LICENSE
  4. +7 −0 Setup.lhs
  5. +29 −0 adjunctions.cabal
@@ -0,0 +1,49 @@
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : Control.Monad.Trans.Adjoint
+-- Copyright : (C) 2011 Edward Kmett
+-- License : BSD-style (see the file LICENSE)
+--
+-- Maintainer : Edward Kmett <ekmett@gmail.com>
+-- Stability : provisional
+-- Portability : MPTCs, fundeps
+--
+----------------------------------------------------------------------------
+
+module Control.Monad.Trans.Adjoint
+ ( Adjoint
+ , runAdjoint
+ , adjoint
+ , AdjointT(..)
+ ) where
+
+import Control.Applicative
+import Control.Monad (ap, liftM)
+import Control.Monad.Trans.Class
+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
+
+instance Adjunction f g => MonadTrans (AdjointT f g)
@@ -0,0 +1,31 @@
+{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, UndecidableInstances #-}
+module Data.Functor.Adjunction
+ ( Adjunction(..)
+ ) where
+
+import Control.Monad.Instances ()
+import Control.Monad.Trans.Identity
+import Data.Functor.Identity
+
+class (Functor f, Functor g) => Adjunction f g | f -> g, g -> f where
+ unit :: a -> g (f a)
+ counit :: f (g a) -> a
+ leftAdjunct :: (f a -> b) -> a -> g b
+ rightAdjunct :: (a -> g b) -> f a -> b
+
+ unit = leftAdjunct id
+ counit = rightAdjunct id
+ leftAdjunct f = fmap f . unit
+ rightAdjunct f = counit . fmap f
+
+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 . fmap IdentityT . unit
+ counit = counit . fmap runIdentityT . runIdentityT
@@ -0,0 +1,30 @@
+Copyright 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.
@@ -0,0 +1,7 @@
+#!/usr/bin/runhaskell
+> module Main (main) where
+
+> import Distribution.Simple
+
+> main :: IO ()
+> main = defaultMain
@@ -0,0 +1,29 @@
+name: adjunctions
+category: Data Structures, Adjunctions
+version: 0.6.1.2
+license: BSD3
+cabal-version: >= 1.6
+license-file: LICENSE
+author: Edward A. Kmett
+maintainer: Edward A. Kmett <ekmett@gmail.com>
+stability: provisional
+homepage: http://github.com/ekmett/adjunctions/
+copyright: Copyright (C) 2011 Edward A. Kmett
+synopsis: Adjunctions
+description: Adjunctions
+build-type: Simple
+
+source-repository head
+ type: git
+ location: git://github.com/ekmett/adjunctions.git
+
+library
+ build-depends:
+ base >= 4 && < 4.4,
+ transformers >= 0.2.0 && < 0.3
+
+ exposed-modules:
+ Control.Monad.Trans.Adjoint
+ Data.Functor.Adjunction
+
+ ghc-options: -Wall

0 comments on commit 6803652

Please sign in to comment.