comonad-4.0/0000755000000000000000000000000012226603333011163 5ustar0000000000000000comonad-4.0/.ghci0000644000000000000000000000012512226603333012074 0ustar0000000000000000:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h comonad-4.0/.gitignore0000644000000000000000000000010412226603333013146 0ustar0000000000000000dist docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# comonad-4.0/.travis.yml0000644000000000000000000000123012226603333013270 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 -flib-Werror $mode - cabal build script: - $script && hlint src --cpp-define HLINT notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313comonad\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" env: - mode="--enable-tests" script="cabal test --show-details=always" comonad-4.0/.vim.custom0000644000000000000000000000137712226603333013300 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" comonad-4.0/CHANGELOG.markdown0000644000000000000000000000041412226603333014215 0ustar00000000000000004.0 --- * Merged the contents of `comonad-transformers` and `comonads-fd` into this package. 3.1 --- * Added `instance Comonad (Tagged s)`. 3.0.3 ----- * Trustworthy or Safe depending on GHC version 3.0.2 ------- * GHC 7.7 HEAD compatibility * Updated build system comonad-4.0/comonad.cabal0000644000000000000000000000444612226603333013577 0ustar0000000000000000name: comonad category: Control, Comonads version: 4.0 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/comonad/ bug-reports: http://github.com/ekmett/comonad/issues copyright: Copyright (C) 2008-2013 Edward A. Kmett, Copyright (C) 2004-2008 Dave Menendez synopsis: Comonads description: Comonads build-type: Custom extra-source-files: .ghci .gitignore .travis.yml .vim.custom coq/Store.v README.markdown CHANGELOG.markdown examples/History.hs -- You can disable the doctests test suite with -f-test-doctests flag test-doctests default: True manual: True source-repository head type: git location: git://github.com/ekmett/comonad.git library hs-source-dirs: src default-language: Haskell2010 other-extensions: CPP ghc-options: -Wall build-depends: base >= 4 && < 5, containers >= 0.3 && < 0.6, contravariant >= 0.2.0.1 && < 1, distributive >= 0.2.2 && < 1, mtl >= 2.0 && < 2.2, semigroups >= 0.8.3.1 && < 1, tagged >= 0.1 && < 1, transformers >= 0.2 && < 0.4 exposed-modules: Control.Comonad Control.Comonad.Env Control.Comonad.Env.Class Control.Comonad.Hoist.Class Control.Comonad.Identity Control.Comonad.Store Control.Comonad.Store.Class Control.Comonad.Traced Control.Comonad.Traced.Class Control.Comonad.Trans.Class Control.Comonad.Trans.Env Control.Comonad.Trans.Identity Control.Comonad.Trans.Store Control.Comonad.Trans.Traced Data.Functor.Composition Data.Functor.Coproduct default-extensions: CPP other-extensions: RankNTypes MultiParamTypeClasses FunctionalDependencies FlexibleInstances UndecidableInstances test-suite doctests type: exitcode-stdio-1.0 default-language: Haskell2010 main-is: doctests.hs ghc-options: -Wall -threaded hs-source-dirs: tests if !flag(test-doctests) buildable: False else build-depends: base, directory >= 1.0, doctest >= 0.9.1, filepath if impl(ghc<7.6.1) ghc-options: -Werror comonad-4.0/LICENSE0000644000000000000000000000242612226603333012174 0ustar0000000000000000Copyright 2008-2013 Edward Kmett Copyright 2004-2008 Dave Menendez 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. 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. comonad-4.0/README.markdown0000644000000000000000000000333312226603333013666 0ustar0000000000000000comonad ======= [![Build Status](https://secure.travis-ci.org/ekmett/comonad.png?branch=master)](http://travis-ci.org/ekmett/comonad) This package provides comonads, the categorical dual of monads. class Functor w => Comonad w where extract :: w a -> a duplicate :: w a -> w (w a) extend :: (w a -> b) -> w a -> w b There are two ways to define a comonad: I. Provide definitions for 'extract' and 'extend' satisfying these laws: extend extract = id extract . extend f = f extend f . extend g = extend (f . extend g) In this case, you may simply set 'fmap' = 'liftW'. These laws are directly analogous to the laws for monads and perhaps can be made clearer by viewing them as laws stating that Cokleisli composition must be associative, and has extract for a unit: f =>= extract = f extract =>= f = f (f =>= g) =>= h = f =>= (g =>= h) II. Alternately, you may choose to provide definitions for 'fmap', 'extract', and 'duplicate' satisfying these laws: extract . duplicate = id fmap extract . duplicate = id duplicate . duplicate = fmap duplicate . duplicate In this case you may not rely on the ability to define 'fmap' in terms of 'liftW'. You may of course, choose to define both 'duplicate' /and/ 'extend'. In that case you must also satisfy these laws: extend f = fmap f . duplicate duplicate = extend id fmap f = extend (f . extract) These are the default definitions of 'extend' and'duplicate' and the definition of 'liftW' respectively. 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 comonad-4.0/Setup.lhs0000644000000000000000000000464412226603333013003 0ustar0000000000000000#!/usr/bin/runhaskell \begin{code} {-# OPTIONS_GHC -Wall #-} module Main (main) where import Data.List ( nub ) import Data.Version ( showVersion ) import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName ) import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) ) import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles ) import Distribution.Simple.BuildPaths ( autogenModulesDir ) import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref)) import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) ) import Distribution.Text ( display ) import Distribution.Verbosity ( Verbosity, normal ) import System.FilePath ( () ) main :: IO () main = defaultMainWithHooks simpleUserHooks { buildHook = \pkg lbi hooks flags -> do generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi buildHook simpleUserHooks pkg lbi hooks flags , postHaddock = \args flags pkg lbi -> do copyFiles normal (haddockOutputDir flags pkg) [] postHaddock simpleUserHooks args flags pkg lbi } haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath haddockOutputDir flags pkg = destDir where baseDir = case haddockDistPref flags of NoFlag -> "." Flag x -> x destDir = baseDir "doc" "html" display (packageName pkg) generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO () generateBuildModule verbosity pkg lbi = do let dir = autogenModulesDir lbi createDirectoryIfMissingVerbose verbosity True dir withLibLBI pkg lbi $ \_ libcfg -> do withTestLBI pkg lbi $ \suite suitecfg -> do rewriteFile (dir "Build_" ++ testName suite ++ ".hs") $ unlines [ "module Build_" ++ testName suite ++ " where" , "deps :: [String]" , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg)) ] where formatdeps = map (formatone . snd) formatone p = case packageName p of PackageName n -> n ++ "-" ++ showVersion (packageVersion p) testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys \end{code} comonad-4.0/coq/0000755000000000000000000000000012226603333011745 5ustar0000000000000000comonad-4.0/coq/Store.v0000644000000000000000000000452412226603333013235 0ustar0000000000000000(* Proof StoreT forms a comonad -- Russell O'Connor *) Set Implict Arguments. Unset Strict Implicit. Require Import FunctionalExtensionality. Record Comonad (w : Type -> Type) : Type := { extract : forall a, w a -> a ; extend : forall a b, (w a -> b) -> w a -> w b ; law1 : forall a x, extend _ _ (extract a) x = x ; law2 : forall a b f x, extract b (extend a _ f x) = f x ; law3 : forall a b c f g x, extend b c f (extend a b g x) = extend a c (fun y => f (extend a b g y)) x }. Section StoreT. Variables (s : Type) (w:Type -> Type). Hypothesis wH : Comonad w. Definition map a b f x := extend _ wH a b (fun y => f (extract _ wH _ y)) x. Lemma map_extend : forall a b c f g x, map b c f (extend _ wH a b g x) = extend _ wH _ _ (fun y => f (g y)) x. Proof. intros a b c f g x. unfold map. rewrite law3. apply equal_f. apply f_equal. extensionality y. rewrite law2. reflexivity. Qed. Record StoreT (a:Type): Type := mkStoreT {store : w (s -> a) ;loc : s}. Definition extractST a (x:StoreT a) : a := extract _ wH _ (store _ x) (loc _ x). Definition mapST a b (f:a -> b) (x:StoreT a) : StoreT b := mkStoreT _ (map _ _ (fun g x => f (g x)) (store _ x)) (loc _ x). Definition duplicateST a (x:StoreT a) : StoreT (StoreT a) := mkStoreT _ (extend _ wH _ _ (mkStoreT _) (store _ x)) (loc _ x). Let extendST := fun a b f x => mapST _ b f (duplicateST a x). Lemma law1ST : forall a x, extendST _ _ (extractST a) x = x. Proof. intros a [v b]. unfold extractST, extendST, duplicateST, mapST. simpl. rewrite map_extend. simpl. replace (fun (y : w (s -> a)) (x : s) => extract w wH (s -> a) y x) with (extract w wH (s -> a)). rewrite law1. reflexivity. extensionality y. extensionality x. reflexivity. Qed. Lemma law2ST : forall a b f x, extractST b (extendST a _ f x) = f x. Proof. intros a b f [v c]. unfold extendST, mapST, extractST. simpl. rewrite map_extend. rewrite law2. reflexivity. Qed. Lemma law3ST : forall a b c f g x, extendST b c f (extendST a b g x) = extendST a c (fun y => f (extendST a b g y)) x. Proof. intros a b c f g [v d]. unfold extendST, mapST, extractST. simpl. repeat rewrite map_extend. rewrite law3. repeat (apply equal_f||apply f_equal). extensionality y. extensionality x. rewrite map_extend. reflexivity. Qed. Definition StoreTComonad : Comonad StoreT := Build_Comonad _ _ _ law1ST law2ST law3ST. End StoreT. Check StoreTComonad. comonad-4.0/examples/0000755000000000000000000000000012226603333013001 5ustar0000000000000000comonad-4.0/examples/History.hs0000644000000000000000000000311512226603333014776 0ustar0000000000000000{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} {-# OPTIONS_GHC -Wall #-} -- http://www.mail-archive.com/haskell@haskell.org/msg17244.html import Prelude hiding (id,(.),sum) import Control.Category import Control.Comonad import Data.Foldable hiding (sum) import Data.Traversable infixl 4 :> data History a = First a | History a :> a deriving (Functor, Foldable, Traversable, Show) runHistory :: (History a -> b) -> [a] -> [b] runHistory _ [] = [] runHistory f (a0:as0) = run (First a0) as0 where run az [] = [f az] run az (a:as) = f az : run (az :> a) as instance Comonad History where extend f w@First{} = First (f w) extend f w@(as :> _) = extend f as :> f w extract (First a) = a extract (_ :> a) = a instance ComonadApply History where First f <@> First a = First (f a) (_ :> f) <@> First a = First (f a) First f <@> (_ :> a) = First (f a) (fs :> f) <@> (as :> a) = (fs <@> as) :> f a fby :: a -> History a -> a a `fby` First _ = a _ `fby` (First b :> _) = b _ `fby` ((_ :> b) :> _) = b pos :: History a -> Int pos dx = wfix $ dx $> fby 0 . fmap (+1) sum :: Num a => History a -> a sum dx = extract dx + (0 `fby` extend sum dx) diff :: Num a => History a -> a diff dx = extract dx - fby 0 dx ini :: History a -> a ini dx = extract dx `fby` extend ini dx fibo :: Num b => History a -> b fibo d = wfix $ d $> fby 0 . extend (\dfibo -> extract dfibo + fby 1 dfibo) fibo' :: Num b => History a -> b fibo' d = fst $ wfix $ d $> fby (0, 1) . fmap (\(x, x') -> (x',x+x')) plus :: Num a => History a -> History a -> History a plus = liftW2 (+) comonad-4.0/src/0000755000000000000000000000000012226603333011752 5ustar0000000000000000comonad-4.0/src/Control/0000755000000000000000000000000012226603333013372 5ustar0000000000000000comonad-4.0/src/Control/Comonad.hs0000644000000000000000000002266512226603333015321 0ustar0000000000000000{-# LANGUAGE CPP #-} #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad -- Copyright : (C) 2008-2012 Edward Kmett, -- (C) 2004 Dave Menendez -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Control.Comonad ( -- * Comonads Comonad(..) , liftW -- :: Comonad w => (a -> b) -> w a -> w b , wfix -- :: Comonad w => w (w a -> a) -> a , cfix -- :: Comonad w => (w a -> a) -> w a , (=>=) , (=<=) , (<<=) , (=>>) -- * Combining Comonads , ComonadApply(..) , (<@@>) -- :: ComonadApply w => w a -> w (a -> b) -> w b , liftW2 -- :: ComonadApply w => (a -> b -> c) -> w a -> w b -> w c , liftW3 -- :: ComonadApply w => (a -> b -> c -> d) -> w a -> w b -> w c -> w d -- * Cokleisli Arrows , Cokleisli(..) -- * Functors , Functor(..) , (<$>) -- :: Functor f => (a -> b) -> f a -> f b , ($>) -- :: Functor f => f a -> b -> f b ) where -- import _everything_ import Control.Applicative import Control.Arrow import Control.Category import Control.Monad (ap) #if MIN_VERSION_base(4,7,0) -- Control.Monad.Instances is empty #else import Control.Monad.Instances #endif import Control.Monad.Trans.Identity import Data.Functor.Identity import Data.List.NonEmpty hiding (map) import Data.Semigroup hiding (Product) import Data.Tagged import Data.Tree import Prelude hiding (id, (.)) import Control.Monad.Fix #if __GLASGOW_HASKELL__ >= 707 -- Data.Typeable is redundant #else import Data.Typeable #endif infixl 4 <@, @>, <@@>, <@>, $> infixl 1 =>> infixr 1 <<=, =<=, =>= {- | There are two ways to define a comonad: I. Provide definitions for 'extract' and 'extend' satisfying these laws: > extend extract = id > extract . extend f = f > extend f . extend g = extend (f . extend g) In this case, you may simply set 'fmap' = 'liftW'. These laws are directly analogous to the laws for monads and perhaps can be made clearer by viewing them as laws stating that Cokleisli composition must be associative, and has extract for a unit: > f =>= extract = f > extract =>= f = f > (f =>= g) =>= h = f =>= (g =>= h) II. Alternately, you may choose to provide definitions for 'fmap', 'extract', and 'duplicate' satisfying these laws: > extract . duplicate = id > fmap extract . duplicate = id > duplicate . duplicate = fmap duplicate . duplicate In this case you may not rely on the ability to define 'fmap' in terms of 'liftW'. You may of course, choose to define both 'duplicate' /and/ 'extend'. In that case you must also satisfy these laws: > extend f = fmap f . duplicate > duplicate = extend id > fmap f = extend (f . extract) These are the default definitions of 'extend' and 'duplicate' and the definition of 'liftW' respectively. -} class Functor w => Comonad w where -- | -- > extract . fmap f = f . extract extract :: w a -> a -- | -- > duplicate = extend id -- > fmap (fmap f) . duplicate = duplicate . fmap f duplicate :: w a -> w (w a) duplicate = extend id -- | -- > extend f = fmap f . duplicate extend :: (w a -> b) -> w a -> w b extend f = fmap f . duplicate instance Comonad ((,)e) where duplicate p = (fst p, p) {-# INLINE duplicate #-} extract = snd {-# INLINE extract #-} instance Monoid m => Comonad ((->)m) where duplicate f m = f . mappend m {-# INLINE duplicate #-} extract f = f mempty {-# INLINE extract #-} instance Comonad Identity where duplicate = Identity {-# INLINE duplicate #-} extract = runIdentity {-# INLINE extract #-} instance Comonad (Tagged s) where duplicate = Tagged {-# INLINE duplicate #-} extract = unTagged {-# INLINE extract #-} instance Comonad w => Comonad (IdentityT w) where extend f (IdentityT m) = IdentityT (extend (f . IdentityT) m) extract = extract . runIdentityT {-# INLINE extract #-} instance Comonad Tree where duplicate w@(Node _ as) = Node w (map duplicate as) extract (Node a _) = a {-# INLINE extract #-} instance Comonad NonEmpty where extend f w@ ~(_ :| aas) = f w :| case aas of [] -> [] (a:as) -> toList (extend f (a :| as)) extract ~(a :| _) = a {-# INLINE extract #-} -- | @ComonadApply@ is to @Comonad@ like @Applicative@ is to @Monad@. -- -- Mathematically, it is a strong lax symmetric semi-monoidal comonad on the -- category @Hask@ of Haskell types. That it to say that @w@ is a strong lax -- symmetric semi-monoidal functor on Hask, where both extract and duplicate are -- symmetric monoidal natural transformations. -- -- Laws: -- -- > (.) <$> u <@> v <@> w = u <@> (v <@> w) -- > extract (p <@> q) = extract p (extract q) -- > duplicate (p <@> q) = (<@>) <$> duplicate p <@> duplicate q -- -- If our type is both a ComonadApply and Applicative we further require -- -- > (<*>) = (<@>) -- -- Finally, if you choose to define ('<@') and ('@>'), the results of your -- definitions should match the following laws: -- -- > a @> b = const id <$> a <@> b -- > a <@ b = const <$> a <@> b class Comonad w => ComonadApply w where (<@>) :: w (a -> b) -> w a -> w b (@>) :: w a -> w b -> w b a @> b = const id <$> a <@> b (<@) :: w a -> w b -> w a a <@ b = const <$> a <@> b instance Semigroup m => ComonadApply ((,)m) where (m, f) <@> (n, a) = (m <> n, f a) (m, a) <@ (n, _) = (m <> n, a) (m, _) @> (n, b) = (m <> n, b) instance ComonadApply NonEmpty where (<@>) = ap instance Monoid m => ComonadApply ((->)m) where (<@>) = (<*>) (<@ ) = (<* ) ( @>) = ( *>) instance ComonadApply Identity where (<@>) = (<*>) (<@ ) = (<* ) ( @>) = ( *>) instance ComonadApply w => ComonadApply (IdentityT w) where IdentityT wa <@> IdentityT wb = IdentityT (wa <@> wb) instance ComonadApply Tree where (<@>) = (<*>) (<@ ) = (<* ) ( @>) = ( *>) -- | A suitable default definition for 'fmap' for a 'Comonad'. -- Promotes a function to a comonad. -- -- > fmap f = liftW f = extend (f . extract) liftW :: Comonad w => (a -> b) -> w a -> w b liftW f = extend (f . extract) {-# INLINE liftW #-} -- | Comonadic fixed point à la Menendez wfix :: Comonad w => w (w a -> a) -> a wfix w = extract w (extend wfix w) -- | Comonadic fixed point à la Orchard cfix :: Comonad w => (w a -> a) -> w a cfix f = fix (extend f) {-# INLINE cfix #-} -- | 'extend' with the arguments swapped. Dual to '>>=' for a 'Monad'. (=>>) :: Comonad w => w a -> (w a -> b) -> w b (=>>) = flip extend {-# INLINE (=>>) #-} -- | 'extend' in operator form (<<=) :: Comonad w => (w a -> b) -> w a -> w b (<<=) = extend {-# INLINE (<<=) #-} -- | Right-to-left Cokleisli composition (=<=) :: Comonad w => (w b -> c) -> (w a -> b) -> w a -> c f =<= g = f . extend g {-# INLINE (=<=) #-} -- | Left-to-right Cokleisli composition (=>=) :: Comonad w => (w a -> b) -> (w b -> c) -> w a -> c f =>= g = g . extend f {-# INLINE (=>=) #-} -- | A variant of '<@>' with the arguments reversed. (<@@>) :: ComonadApply w => w a -> w (a -> b) -> w b (<@@>) = liftW2 (flip id) {-# INLINE (<@@>) #-} -- | Lift a binary function into a comonad with zipping liftW2 :: ComonadApply w => (a -> b -> c) -> w a -> w b -> w c liftW2 f a b = f <$> a <@> b {-# INLINE liftW2 #-} -- | Lift a ternary function into a comonad with zipping liftW3 :: ComonadApply w => (a -> b -> c -> d) -> w a -> w b -> w c -> w d liftW3 f a b c = f <$> a <@> b <@> c {-# INLINE liftW3 #-} -- | The 'Cokleisli' 'Arrow's of a given 'Comonad' newtype Cokleisli w a b = Cokleisli { runCokleisli :: w a -> b } #if __GLASGOW_HASKELL__ >= 707 -- instance Typeable (Cokleisli w) derived automatically #else #ifdef __GLASGOW_HASKELL__ instance Typeable1 w => Typeable2 (Cokleisli w) where typeOf2 twab = mkTyConApp cokleisliTyCon [typeOf1 (wa twab)] where wa :: Cokleisli w a b -> w a wa = undefined #endif cokleisliTyCon :: TyCon #if MIN_VERSION_base(4,4,0) cokleisliTyCon = mkTyCon3 "comonad" "Control.Comonad" "Cokleisli" #else cokleisliTyCon = mkTyCon "Control.Comonad.Cokleisli" #endif {-# NOINLINE cokleisliTyCon #-} #endif instance Comonad w => Category (Cokleisli w) where id = Cokleisli extract Cokleisli f . Cokleisli g = Cokleisli (f =<= g) instance Comonad w => Arrow (Cokleisli w) where arr f = Cokleisli (f . extract) first f = f *** id second f = id *** f Cokleisli f *** Cokleisli g = Cokleisli (f . fmap fst &&& g . fmap snd) Cokleisli f &&& Cokleisli g = Cokleisli (f &&& g) instance Comonad w => ArrowApply (Cokleisli w) where app = Cokleisli $ \w -> runCokleisli (fst (extract w)) (snd <$> w) instance Comonad w => ArrowChoice (Cokleisli w) where left = leftApp instance ComonadApply w => ArrowLoop (Cokleisli w) where loop (Cokleisli f) = Cokleisli (fst . wfix . extend f') where f' wa wb = f ((,) <$> wa <@> (snd <$> wb)) instance Functor (Cokleisli w a) where fmap f (Cokleisli g) = Cokleisli (f . g) instance Applicative (Cokleisli w a) where pure = Cokleisli . const Cokleisli f <*> Cokleisli a = Cokleisli (\w -> f w (a w)) instance Monad (Cokleisli w a) where return = Cokleisli . const Cokleisli k >>= f = Cokleisli $ \w -> runCokleisli (f (k w)) w -- | Replace the contents of a functor uniformly with a constant value. ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) comonad-4.0/src/Control/Comonad/0000755000000000000000000000000012226603333014752 5ustar0000000000000000comonad-4.0/src/Control/Comonad/Env.hs0000644000000000000000000000236412226603333016043 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Env -- Copyright : (C) 2008-2011 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable (fundeps, MPTCs) -- -- The Env comonad (aka the Coreader, Environment, or Product comonad) -- -- A co-Kleisli arrow in the Env comonad is isomorphic to a Kleisli arrow -- in the reader monad. -- -- (a -> e -> m) ~ (a, e) -> m ~ Env e a -> m ---------------------------------------------------------------------------- module Control.Comonad.Env ( -- * ComonadEnv class ComonadEnv(..) , asks , local -- * The Env comonad , Env , env , runEnv -- * The EnvT comonad transformer , EnvT(..) , runEnvT -- * Re-exported modules , module Control.Comonad , module Control.Comonad.Trans.Class ) where import Control.Comonad import Control.Comonad.Env.Class (ComonadEnv(..), asks) import Control.Comonad.Trans.Class import Control.Comonad.Trans.Env (Env, env, runEnv, EnvT(..), runEnvT, local) comonad-4.0/src/Control/Comonad/Identity.hs0000644000000000000000000000142412226603333017100 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Identity -- Copyright : (C) 2008-2012 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable (fundeps, MPTCs) ---------------------------------------------------------------------------- module Control.Comonad.Identity ( module Control.Comonad , module Data.Functor.Identity , module Control.Comonad.Trans.Identity ) where import Control.Comonad import Data.Functor.Identity import Control.Comonad.Trans.Identity comonad-4.0/src/Control/Comonad/Store.hs0000644000000000000000000000203212226603333016377 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Store -- Copyright : (C) 2008-2011 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable (fundeps, MPTCs) ---------------------------------------------------------------------------- module Control.Comonad.Store ( -- * ComonadStore class ComonadStore(..) -- * The Store comonad , Store , store , runStore -- * The StoreT comonad transformer , StoreT(..) , runStoreT -- * Re-exported modules , module Control.Comonad , module Control.Comonad.Trans.Class ) where import Control.Comonad import Control.Comonad.Store.Class (ComonadStore(..)) import Control.Comonad.Trans.Class import Control.Comonad.Trans.Store (Store, store, runStore, StoreT(..), runStoreT) comonad-4.0/src/Control/Comonad/Traced.hs0000644000000000000000000000213312226603333016507 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Traced -- Copyright : (C) 2008-2011 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable (fundeps, MPTCs) ---------------------------------------------------------------------------- module Control.Comonad.Traced ( -- * ComonadTraced class ComonadTraced(..) , traces -- * The Traced comonad , Traced , traced , runTraced -- * The TracedT comonad transformer , TracedT(..) -- * Re-exported modules , module Control.Comonad , module Control.Comonad.Trans.Class , module Data.Monoid ) where import Control.Comonad import Control.Comonad.Traced.Class (ComonadTraced(..), traces) import Control.Comonad.Trans.Class import Control.Comonad.Trans.Traced (Traced, traced, runTraced, TracedT(..), runTracedT) import Data.Monoid comonad-4.0/src/Control/Comonad/Env/0000755000000000000000000000000012226603333015502 5ustar0000000000000000comonad-4.0/src/Control/Comonad/Env/Class.hs0000644000000000000000000000316112226603333017104 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Env.Class -- Copyright : (C) 2008-2012 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable (fundeps, MPTCs) ---------------------------------------------------------------------------- module Control.Comonad.Env.Class ( ComonadEnv(..) , asks ) where import Control.Comonad import Control.Comonad.Trans.Class import qualified Control.Comonad.Trans.Env as Env import Control.Comonad.Trans.Store import Control.Comonad.Trans.Traced import Control.Comonad.Trans.Identity import Data.Semigroup class Comonad w => ComonadEnv e w | w -> e where ask :: w a -> e asks :: ComonadEnv e w => (e -> e') -> w a -> e' asks f wa = f (ask wa) {-# INLINE asks #-} instance Comonad w => ComonadEnv e (Env.EnvT e w) where ask = Env.ask instance ComonadEnv e ((,)e) where ask = fst lowerAsk :: (ComonadEnv e w, ComonadTrans t) => t w a -> e lowerAsk = ask . lower {-# INLINE lowerAsk #-} instance ComonadEnv e w => ComonadEnv e (StoreT t w) where ask = lowerAsk instance ComonadEnv e w => ComonadEnv e (IdentityT w) where ask = lowerAsk instance (ComonadEnv e w, Monoid m) => ComonadEnv e (TracedT m w) where ask = lowerAsk comonad-4.0/src/Control/Comonad/Hoist/0000755000000000000000000000000012226603333016040 5ustar0000000000000000comonad-4.0/src/Control/Comonad/Hoist/Class.hs0000644000000000000000000000160512226603333017443 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Hoist.Class -- Copyright : (C) 2008-2013 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable ---------------------------------------------------------------------------- module Control.Comonad.Hoist.Class ( ComonadHoist(cohoist) ) where import Control.Comonad import Control.Monad.Trans.Identity class ComonadHoist t where -- | Given any comonad-homomorphism from @w@ to @v@ this yields a comonad -- homomorphism from @t w@ to @t v@. cohoist :: (Comonad w, Comonad v) => (forall x. w x -> v x) -> t w a -> t v a instance ComonadHoist IdentityT where cohoist l = IdentityT . l . runIdentityT {-# INLINE cohoist #-} comonad-4.0/src/Control/Comonad/Store/0000755000000000000000000000000012226603333016046 5ustar0000000000000000comonad-4.0/src/Control/Comonad/Store/Class.hs0000644000000000000000000000457412226603333017461 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Store.Class -- Copyright : (C) 2008-2012 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable (fundeps, MPTCs) ---------------------------------------------------------------------------- module Control.Comonad.Store.Class ( ComonadStore(..) , lowerPos , lowerPeek ) where import Control.Comonad import Control.Comonad.Trans.Class import Control.Comonad.Trans.Env import qualified Control.Comonad.Trans.Store as Store import Control.Comonad.Trans.Traced import Control.Comonad.Trans.Identity import Data.Semigroup class Comonad w => ComonadStore s w | w -> s where pos :: w a -> s peek :: s -> w a -> a peeks :: (s -> s) -> w a -> a peeks f w = peek (f (pos w)) w seek :: s -> w a -> w a seek s = peek s . duplicate seeks :: (s -> s) -> w a -> w a seeks f = peeks f . duplicate experiment :: Functor f => (s -> f s) -> w a -> f a experiment f w = fmap (`peek` w) (f (pos w)) instance Comonad w => ComonadStore s (Store.StoreT s w) where pos = Store.pos peek = Store.peek peeks = Store.peeks seek = Store.seek seeks = Store.seeks experiment = Store.experiment lowerPos :: (ComonadTrans t, ComonadStore s w) => t w a -> s lowerPos = pos . lower {-# INLINE lowerPos #-} lowerPeek :: (ComonadTrans t, ComonadStore s w) => s -> t w a -> a lowerPeek s = peek s . lower {-# INLINE lowerPeek #-} lowerExperiment :: (ComonadTrans t, ComonadStore s w, Functor f) => (s -> f s) -> t w a -> f a lowerExperiment f = experiment f . lower {-# INLINE lowerExperiment #-} instance ComonadStore s w => ComonadStore s (IdentityT w) where pos = lowerPos peek = lowerPeek experiment = lowerExperiment instance ComonadStore s w => ComonadStore s (EnvT e w) where pos = lowerPos peek = lowerPeek experiment = lowerExperiment instance (ComonadStore s w, Monoid m) => ComonadStore s (TracedT m w) where pos = lowerPos peek = lowerPeek experiment = lowerExperiment comonad-4.0/src/Control/Comonad/Traced/0000755000000000000000000000000012226603333016154 5ustar0000000000000000comonad-4.0/src/Control/Comonad/Traced/Class.hs0000644000000000000000000000341712226603333017562 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Traced.Class -- Copyright : (C) 2008-2012 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : experimental -- Portability : non-portable (fundeps, MPTCs) ---------------------------------------------------------------------------- module Control.Comonad.Traced.Class ( ComonadTraced(..) , traces ) where import Control.Comonad import Control.Comonad.Trans.Class import Control.Comonad.Trans.Env import Control.Comonad.Trans.Store import qualified Control.Comonad.Trans.Traced as Traced import Control.Comonad.Trans.Identity import Data.Semigroup class Comonad w => ComonadTraced m w | w -> m where trace :: m -> w a -> a traces :: ComonadTraced m w => (a -> m) -> w a -> a traces f wa = trace (f (extract wa)) wa {-# INLINE traces #-} instance (Comonad w, Monoid m) => ComonadTraced m (Traced.TracedT m w) where trace = Traced.trace lowerTrace :: (ComonadTrans t, ComonadTraced m w) => m -> t w a -> a lowerTrace m = trace m . lower {-# INLINE lowerTrace #-} -- All of these require UndecidableInstances because they do not satisfy the coverage condition instance ComonadTraced m w => ComonadTraced m (IdentityT w) where trace = lowerTrace instance ComonadTraced m w => ComonadTraced m (EnvT e w) where trace = lowerTrace instance ComonadTraced m w => ComonadTraced m (StoreT s w) where trace = lowerTrace comonad-4.0/src/Control/Comonad/Trans/0000755000000000000000000000000012226603333016041 5ustar0000000000000000comonad-4.0/src/Control/Comonad/Trans/Class.hs0000644000000000000000000000144312226603333017444 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Trans.Class -- Copyright : (C) 2008-2011 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable ---------------------------------------------------------------------------- module Control.Comonad.Trans.Class ( ComonadTrans(..) ) where import Control.Comonad import Control.Monad.Trans.Identity class ComonadTrans t where lower :: Comonad w => t w a -> w a -- avoiding orphans instance ComonadTrans IdentityT where lower = runIdentityT comonad-4.0/src/Control/Comonad/Trans/Env.hs0000644000000000000000000001126512226603333017132 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Trans.Env -- Copyright : (C) 2008-2013 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- The environment comonad holds a value along with some retrievable context. -- -- This module specifies the environment comonad transformer (aka coreader), -- which is left adjoint to the reader comonad. -- -- The following sets up an experiment that retains its initial value in the -- background: -- -- >>> let initial = env 0 0 -- -- Extract simply retrieves the value: -- -- >>> extract initial -- 0 -- -- Play around with the value, in our case producing a negative value: -- -- >>> let experiment = fmap (+ 10) initial -- >>> extract experiment -- 10 -- -- Oh noes, something went wrong, 10 isn't very negative! Better restore the -- initial value using the default: -- -- >>> let initialRestored = experiment =>> ask -- >>> extract initialRestored -- 0 ---------------------------------------------------------------------------- module Control.Comonad.Trans.Env ( -- * The strict environment comonad Env , env , runEnv -- * The strict environment comonad transformer , EnvT(..) , runEnvT , lowerEnvT -- * Combinators , ask , asks , local ) where import Control.Comonad import Control.Comonad.Hoist.Class import Control.Comonad.Trans.Class import Data.Foldable import Data.Traversable import Data.Functor.Identity import Data.Semigroup #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__ >= 707 #define Typeable1 Typeable #endif import Data.Data #if __GLASGOW_HASKELL__ >= 707 deriving instance Typeable EnvT #else instance (Typeable s, Typeable1 w) => Typeable1 (EnvT s w) where typeOf1 dswa = mkTyConApp envTTyCon [typeOf (s dswa), typeOf1 (w dswa)] where s :: EnvT s w a -> s s = undefined w :: EnvT s w a -> w a w = undefined #endif envTTyCon :: TyCon #if __GLASGOW_HASKELL__ < 704 envTTyCon = mkTyCon "Control.Comonad.Trans.Env.EnvT" #else envTTyCon = mkTyCon3 "comonad-transformers" "Control.Comonad.Trans.Env" "EnvT" #endif {-# NOINLINE envTTyCon #-} #if __GLASGOW_HASKELL__ < 707 instance (Typeable s, Typeable1 w, Typeable a) => Typeable (EnvT s w a) where typeOf = typeOfDefault #endif instance ( Data e , Typeable1 w, Data (w a) , Data a ) => Data (EnvT e w a) where gfoldl f z (EnvT e wa) = z EnvT `f` e `f` wa toConstr _ = envTConstr gunfold k z c = case constrIndex c of 1 -> k (k (z EnvT)) _ -> error "gunfold" dataTypeOf _ = envTDataType dataCast1 f = gcast1 f envTConstr :: Constr envTConstr = mkConstr envTDataType "EnvT" [] Prefix {-# NOINLINE envTConstr #-} envTDataType :: DataType envTDataType = mkDataType "Control.Comonad.Trans.Env.EnvT" [envTConstr] {-# NOINLINE envTDataType #-} #endif type Env e = EnvT e Identity data EnvT e w a = EnvT e (w a) -- | Create an Env using an environment and a value env :: e -> a -> Env e a env e a = EnvT e (Identity a) runEnv :: Env e a -> (e, a) runEnv (EnvT e (Identity a)) = (e, a) runEnvT :: EnvT e w a -> (e, w a) runEnvT (EnvT e wa) = (e, wa) instance Functor w => Functor (EnvT e w) where fmap g (EnvT e wa) = EnvT e (fmap g wa) instance Comonad w => Comonad (EnvT e w) where duplicate (EnvT e wa) = EnvT e (extend (EnvT e) wa) extract (EnvT _ wa) = extract wa instance ComonadTrans (EnvT e) where lower (EnvT _ wa) = wa -- | Gets rid of the environment. This differs from 'extract' in that it will -- not continue extracting the value from the contained comonad. lowerEnvT :: EnvT e w a -> w a lowerEnvT (EnvT _ wa) = wa instance ComonadHoist (EnvT e) where cohoist l (EnvT e wa) = EnvT e (l wa) instance (Semigroup e, ComonadApply w) => ComonadApply (EnvT e w) where EnvT ef wf <@> EnvT ea wa = EnvT (ef <> ea) (wf <@> wa) instance Foldable w => Foldable (EnvT e w) where foldMap f (EnvT _ w) = foldMap f w instance Traversable w => Traversable (EnvT e w) where traverse f (EnvT e w) = EnvT e <$> traverse f w -- | Retrieves the environment. ask :: EnvT e w a -> e ask (EnvT e _) = e -- | Like 'ask', but modifies the resulting value with a function. -- -- > asks = f . ask asks :: (e -> f) -> EnvT e w a -> f asks f (EnvT e _) = f e -- | Modifies the environment using the specified function. local :: (e -> e') -> EnvT e w a -> EnvT e' w a local f (EnvT e wa) = EnvT (f e) wa comonad-4.0/src/Control/Comonad/Trans/Identity.hs0000644000000000000000000000101112226603333020157 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Trans.Identity -- Copyright : (C) 2008-2011 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Control.Comonad.Trans.Identity ( IdentityT(..) ) where import Control.Monad.Trans.Identity comonad-4.0/src/Control/Comonad/Trans/Store.hs0000644000000000000000000001257612226603333017504 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Trans.Store -- Copyright : (C) 2008-2013 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- -- The store comonad holds a constant value along with a modifiable /accessor/ -- function, which maps the /stored value/ to the /focus/. -- -- This module defines the strict store (aka state-in-context/costate) comonad -- transformer. -- -- @stored value = (1, 5)@, @accessor = fst@, @resulting focus = 1@: -- -- > storeTuple :: Store (Int, Int) Int -- > storeTuple = store fst (1, 5) -- -- Add something to the focus: -- -- > addToFocus :: Int -> Store (Int, Int) Int -> Int -- > addToFocus x wa = x + extract wa -- > -- > added3 :: Store (Int, Int) Int -- > added3 = extend (addToFocus 3) storeTuple -- -- The focus of added3 is now @1 + 3 = 4@. However, this action changed only -- the accessor function and therefore the focus but not the stored value: -- -- > pos added3 -- (1, 5) -- -- > extract added3 -- 4 -- -- The strict store (state-in-context/costate) comonad transformer is subject -- to the laws: -- -- > x = seek (pos x) x -- > y = pos (seek y x) -- > seek y x = seek y (seek z x) -- -- Thanks go to Russell O'Connor and Daniel Peebles for their help formulating -- and proving the laws for this comonad transformer. ---------------------------------------------------------------------------- module Control.Comonad.Trans.Store ( -- * The Store comonad Store, store, runStore -- * The Store comonad transformer , StoreT(..), runStoreT -- * Operations , pos , seek, seeks , peek, peeks , experiment ) where import Control.Applicative import Control.Comonad import Control.Comonad.Hoist.Class import Control.Comonad.Trans.Class import Data.Functor.Identity import Data.Semigroup #ifdef __GLASGOW_HASKELL__ import Data.Typeable #if __GLASGOW_HASKELL__ >= 707 deriving instance Typeable StoreT #else instance (Typeable s, Typeable1 w) => Typeable1 (StoreT s w) where typeOf1 dswa = mkTyConApp storeTTyCon [typeOf (s dswa), typeOf1 (w dswa)] where s :: StoreT s w a -> s s = undefined w :: StoreT s w a -> w a w = undefined instance (Typeable s, Typeable1 w, Typeable a) => Typeable (StoreT s w a) where typeOf = typeOfDefault storeTTyCon :: TyCon #if __GLASGOW_HASKELL__ < 704 storeTTyCon = mkTyCon "Control.Comonad.Trans.Store.StoreT" #else storeTTyCon = mkTyCon3 "comonad-transformers" "Control.Comonad.Trans.Store" "StoreT" #endif {-# NOINLINE storeTTyCon #-} #endif #endif type Store s = StoreT s Identity -- | Create a Store using an accessor function and a stored value store :: (s -> a) -> s -> Store s a store f s = StoreT (Identity f) s runStore :: Store s a -> (s -> a, s) runStore (StoreT (Identity f) s) = (f, s) data StoreT s w a = StoreT (w (s -> a)) s runStoreT :: StoreT s w a -> (w (s -> a), s) runStoreT (StoreT wf s) = (wf, s) instance Functor w => Functor (StoreT s w) where fmap f (StoreT wf s) = StoreT (fmap (f .) wf) s instance (ComonadApply w, Semigroup s) => ComonadApply (StoreT s w) where StoreT ff m <@> StoreT fa n = StoreT ((<*>) <$> ff <@> fa) (m <> n) instance (Applicative w, Monoid s) => Applicative (StoreT s w) where pure a = StoreT (pure (const a)) mempty StoreT ff m <*> StoreT fa n = StoreT ((<*>) <$> ff <*> fa) (mappend m n) instance Comonad w => Comonad (StoreT s w) where duplicate (StoreT wf s) = StoreT (extend StoreT wf) s extend f (StoreT wf s) = StoreT (extend (\wf' s' -> f (StoreT wf' s')) wf) s extract (StoreT wf s) = extract wf s instance ComonadTrans (StoreT s) where lower (StoreT f s) = fmap ($ s) f instance ComonadHoist (StoreT s) where cohoist l (StoreT f s) = StoreT (l f) s -- | Read the stored value -- -- >>> pos $ store fst (1,5) -- (1,5) -- pos :: StoreT s w a -> s pos (StoreT _ s) = s -- | Set the stored value -- -- > pos . seek (3,7) $ store fst (1,5) -- > (3,7) -- -- Seek satisfies the law -- -- > seek s = peek s . duplicate seek :: s -> StoreT s w a -> StoreT s w a seek s ~(StoreT f _) = StoreT f s -- | Modify the stored value -- -- > pos . seeks swap $ store fst (1,5) -- (5,1) -- -- Seeks satisfies the law -- -- > seeks f = peeks f . duplicate seeks :: (s -> s) -> StoreT s w a -> StoreT s w a seeks f ~(StoreT g s) = StoreT g (f s) -- | Peek at what the current focus would be for a different stored value -- -- Peek satisfies the law -- -- > peek x . extend (peek y) = peek y peek :: Comonad w => s -> StoreT s w a -> a peek s (StoreT g _) = extract g s -- | Peek at what the current focus would be if the stored value was -- modified by some function peeks :: Comonad w => (s -> s) -> StoreT s w a -> a peeks f ~(StoreT g s) = extract g (f s) -- | Applies a functor-valued function to the stored value, and then uses the -- new accessor to read the resulting focus. -- -- >>> let f x = if x > 0 then Just (x^2) else Nothing -- >>> experiment f $ store (+1) 2 -- Just 5 -- >>> experiment f $ store (+1) (-2) -- Nothing experiment :: (Comonad w, Functor f) => (s -> f s) -> StoreT s w a -> f a experiment f (StoreT wf s) = extract wf <$> f s comonad-4.0/src/Control/Comonad/Trans/Traced.hs0000644000000000000000000000671212226603333017605 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE StandaloneDeriving, DeriveDataTypeable #-} #endif #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Trans.Traced -- Copyright : (C) 2008-2013 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- The trace comonad builds up a result by prepending monoidal values to each -- other. -- -- This module specifies the traced comonad transformer (aka the cowriter or -- exponential comonad transformer). -- ---------------------------------------------------------------------------- module Control.Comonad.Trans.Traced ( -- * Traced comonad Traced , traced , runTraced -- * Traced comonad transformer , TracedT(..) -- * Operations , trace , listen , listens , censor ) where import Control.Applicative import Control.Monad.Instances () import Control.Monad (ap) import Control.Comonad import Control.Comonad.Hoist.Class import Control.Comonad.Trans.Class import Data.Distributive import Data.Functor.Identity import Data.Semigroup import Data.Typeable type Traced m = TracedT m Identity traced :: (m -> a) -> Traced m a traced f = TracedT (Identity f) runTraced :: Traced m a -> m -> a runTraced (TracedT (Identity f)) = f newtype TracedT m w a = TracedT { runTracedT :: w (m -> a) } instance Functor w => Functor (TracedT m w) where fmap g = TracedT . fmap (g .) . runTracedT instance (ComonadApply w, Monoid m) => ComonadApply (TracedT m w) where TracedT wf <@> TracedT wa = TracedT (ap <$> wf <@> wa) instance Applicative w => Applicative (TracedT m w) where pure = TracedT . pure . const TracedT wf <*> TracedT wa = TracedT (ap <$> wf <*> wa) instance (Comonad w, Monoid m) => Comonad (TracedT m w) where extend f = TracedT . extend (\wf m -> f (TracedT (fmap (. mappend m) wf))) . runTracedT extract (TracedT wf) = extract wf mempty instance Monoid m => ComonadTrans (TracedT m) where lower = fmap ($ mempty) . runTracedT instance Monoid m => ComonadHoist (TracedT m) where cohoist l = TracedT . l . runTracedT instance Distributive w => Distributive (TracedT m w) where distribute = TracedT . fmap (\tma m -> fmap ($ m) tma) . collect runTracedT trace :: Comonad w => m -> TracedT m w a -> a trace m (TracedT wf) = extract wf m listen :: Functor w => TracedT m w a -> TracedT m w (a, m) listen = TracedT . fmap (\f m -> (f m, m)) . runTracedT listens :: Functor w => (m -> b) -> TracedT m w a -> TracedT m w (a, b) listens g = TracedT . fmap (\f m -> (f m, g m)) . runTracedT censor :: Functor w => (m -> m) -> TracedT m w a -> TracedT m w a censor g = TracedT . fmap (. g) . runTracedT #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__ >= 707 deriving instance Typeable TracedT #else instance (Typeable s, Typeable1 w) => Typeable1 (TracedT s w) where typeOf1 dswa = mkTyConApp tracedTTyCon [typeOf (s dswa), typeOf1 (w dswa)] where s :: TracedT s w a -> s s = undefined w :: TracedT s w a -> w a w = undefined tracedTTyCon :: TyCon #if __GLASGOW_HASKELL__ < 704 tracedTTyCon = mkTyCon "Control.Comonad.Trans.Traced.TracedT" #else tracedTTyCon = mkTyCon3 "comonad-transformers" "Control.Comonad.Trans.Traced" "TracedT" #endif {-# NOINLINE tracedTTyCon #-} #endif #endif comonad-4.0/src/Data/0000755000000000000000000000000012226603333012623 5ustar0000000000000000comonad-4.0/src/Data/Functor/0000755000000000000000000000000012226603333014243 5ustar0000000000000000comonad-4.0/src/Data/Functor/Composition.hs0000644000000000000000000000070512226603333017104 0ustar0000000000000000module Data.Functor.Composition ( Composition(..) ) where import Data.Functor.Compose -- | We often need to distinguish between various forms of Functor-like composition in Haskell in order to please the type system. -- This lets us work with these representations uniformly. class Composition o where decompose :: o f g x -> f (g x) compose :: f (g x) -> o f g x instance Composition Compose where decompose = getCompose compose = Compose comonad-4.0/src/Data/Functor/Coproduct.hs0000644000000000000000000000353112226603333016543 0ustar0000000000000000{-# LANGUAGE CPP #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Functor.Coproduct -- Copyright : (C) 2008-2011 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable ---------------------------------------------------------------------------- module Data.Functor.Coproduct ( Coproduct(..) , left , right , coproduct ) where import Control.Comonad import Data.Functor.Contravariant import Data.Foldable import Data.Traversable newtype Coproduct f g a = Coproduct { getCoproduct :: Either (f a) (g a) } deriving (Eq, Ord, Read, Show) left :: f a -> Coproduct f g a left = Coproduct . Left right :: g a -> Coproduct f g a right = Coproduct . Right coproduct :: (f a -> b) -> (g a -> b) -> Coproduct f g a -> b coproduct f g = either f g . getCoproduct instance (Functor f, Functor g) => Functor (Coproduct f g) where fmap f = Coproduct . coproduct (Left . fmap f) (Right . fmap f) instance (Foldable f, Foldable g) => Foldable (Coproduct f g) where foldMap f = coproduct (foldMap f) (foldMap f) instance (Traversable f, Traversable g) => Traversable (Coproduct f g) where traverse f = coproduct (fmap (Coproduct . Left) . traverse f) (fmap (Coproduct . Right) . traverse f) instance (Comonad f, Comonad g) => Comonad (Coproduct f g) where extend f = Coproduct . coproduct (Left . extend (f . Coproduct . Left)) (Right . extend (f . Coproduct . Right)) extract = coproduct extract extract instance (Contravariant f, Contravariant g) => Contravariant (Coproduct f g) where contramap f = Coproduct . coproduct (Left . contramap f) (Right . contramap f) comonad-4.0/tests/0000755000000000000000000000000012226603333012325 5ustar0000000000000000comonad-4.0/tests/doctests.hsc0000644000000000000000000000452212226603333014657 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- | -- Module : Main (doctests) -- Copyright : (C) 2012-13 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- This module provides doctests for a project based on the actual versions -- of the packages it was built with. It requires a corresponding Setup.lhs -- to be added to the project ----------------------------------------------------------------------------- module Main where import Build_doctests (deps) import Control.Applicative import Control.Monad import Data.List import System.Directory import System.FilePath import Test.DocTest ##if defined(mingw32_HOST_OS) ##if defined(i386_HOST_ARCH) ##define USE_CP import Control.Applicative import Control.Exception import Foreign.C.Types foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt ##elif defined(x86_64_HOST_ARCH) ##define USE_CP import Control.Applicative import Control.Exception import Foreign.C.Types foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt ##endif ##endif -- | Run in a modified codepage where we can print UTF-8 values on Windows. withUnicode :: IO a -> IO a ##ifdef USE_CP withUnicode m = do cp <- c_GetConsoleCP (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp ##else withUnicode m = m ##endif main :: IO () main = withUnicode $ getSources >>= \sources -> doctest $ "-isrc" : "-idist/build/autogen" : "-optP-include" : "-optPdist/build/autogen/cabal_macros.h" : "-hide-all-packages" : "-Iincludes" : map ("-package="++) deps ++ sources getSources :: IO [FilePath] getSources = filter (isSuffixOf ".hs") <$> go "src" where go dir = do (dirs, files) <- getFilesAndDirectories dir (files ++) . concat <$> mapM go dirs getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) getFilesAndDirectories dir = do c <- map (dir ) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c