comonad-5/0000755000000000000000000000000012646541110011026 5ustar0000000000000000comonad-5/.ghci0000644000000000000000000000012512646541110011737 0ustar0000000000000000:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h comonad-5/.gitignore0000644000000000000000000000010412646541110013011 0ustar0000000000000000dist docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# comonad-5/.travis.yml0000644000000000000000000000241012646541110013134 0ustar0000000000000000env: - GHCVER=7.0.1 CABALVER=1.16 - GHCVER=7.0.4 CABALVER=1.16 - GHCVER=7.2.2 CABALVER=1.16 - GHCVER=7.4.2 CABALVER=1.16 - GHCVER=7.6.3 CABALVER=1.16 - GHCVER=7.8.4 CABALVER=1.18 - GHCVER=7.10.2 CABALVER=1.22 - GHCVER=head CABALVER=1.22 matrix: allow_failures: - env: GHCVER=7.0.1 CABALVER=1.16 - env: GHCVER=7.0.4 CABALVER=1.16 - env: GHCVER=7.2.2 CABALVER=1.16 - env: GHCVER=head CABALVER=1.22 before_install: - travis_retry sudo add-apt-repository -y ppa:hvr/ghc - travis_retry sudo apt-get update - travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - cabal --version install: - travis_retry cabal update - cabal install --enable-tests --only-dependencies script: - cabal configure -v2 --enable-tests - cabal build - cabal sdist - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; cd dist/; if [ -f "$SRC_TGZ" ]; then cabal install "$SRC_TGZ"; else echo "expected '$SRC_TGZ' not found"; exit 1; fi notifications: irc: channels: - "irc.freenode.org#haskell-lens" skip_join: true template: - "\x0313comonad\x0f/\x0306%{branch}\x0f \x0314%{commit}\x0f %{message} \x0302\x1f%{build_url}\x0f" comonad-5/.vim.custom0000644000000000000000000000137712646541110013143 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-5/CHANGELOG.markdown0000644000000000000000000000271312646541110014064 0ustar00000000000000005 - * Removed module `Data.Functor.Coproduct` in favor of the `transformers` package's `Data.Functor.Sum`. n.b. Compatibility with older versions of `transformers` is possible using `transformers-compat`. * Add `Comonad` instance for `Data.Functor.Sum.Sum` * GHC 8 compatibility 4.2.7.2 ------- * Compiles warning-free on GHC 7.10 4.2.7.1 ------- * Use CPP 4.2.7 ----- * `Trustworthy` fixes for GHC 7.2 4.2.6 ----- * Re-export `(Data.Functor.$>)` rather than supply our own on GHC 7.8+ * Better SafeHaskell support. * `instance Monoid m => ComonadTraced m ((->) m)` 4.2.5 ------- * Added a `MINIMAL` pragma to `Comonad`. * Added `DefaultSignatures` support for `ComonadApply` on GHC 7.2+ 4.2.4 ----- * Added Kenneth Foner's fixed point as `kfix`. 4.2.3 ----- * Add `Comonad` and `ComonadEnv` instances for `Arg e` from `semigroups 0.16.3` which can be used to extract the argmin or argmax. 4.2.2 ----- * `contravariant` 1.0 support 4.2.1 ----- * Added flags that supply unsupported build modes that can be convenient for sandbox users. 4.2 --- * `transformers 0.4` compatibility 4.1 --- * Fixed the 'Typeable' instance for 'Cokleisli on GHC 7.8.1 4.0.1 ----- * Fixes to avoid warnings on GHC 7.8.1 4.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-5/comonad.cabal0000644000000000000000000000662612646541110013444 0ustar0000000000000000name: comonad category: Control, Comonads version: 5 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-2014 Edward A. Kmett, Copyright (C) 2004-2008 Dave Menendez synopsis: Comonads description: Comonads build-type: Custom tested-with: GHC==7.0.1, GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2 extra-source-files: .ghci .gitignore .travis.yml .vim.custom coq/Store.v README.markdown CHANGELOG.markdown examples/History.hs HLint.hs -- You can disable the doctests test suite with -f-test-doctests flag test-doctests default: True manual: True flag containers description: You can disable the use of the `containers` package using `-f-containers`. . Disabing this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. default: True manual: True flag contravariant description: You can disable the use of the `contravariant` package using `-f-contravariant`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. . If disabled we will not supply instances of `Contravariant` . default: True manual: True flag distributive description: You can disable the use of the `distributive` package using `-f-distributive`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. . If disabled we will not supply instances of `Distributive` . default: True manual: True source-repository head type: git location: git://github.com/ekmett/comonad.git library hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall build-depends: base >= 4 && < 5, semigroups >= 0.8.3.1 && < 1, tagged >= 0.1 && < 1, transformers >= 0.2 && < 0.6, transformers-compat >= 0.3 && < 1 if flag(containers) build-depends: containers >= 0.3 && < 0.6 if flag(contravariant) build-depends: contravariant >= 0.2.0.1 && < 2 if flag(distributive) build-depends: distributive >= 0.2.2 && < 1 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 other-extensions: CPP 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.10, filepath comonad-5/HLint.hs0000644000000000000000000000012312646541110012374 0ustar0000000000000000import "hint" HLint.HLint ignore "Eta reduce" ignore "Use import/export shortcut" comonad-5/LICENSE0000644000000000000000000000242612646541110012037 0ustar0000000000000000Copyright 2008-2014 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-5/README.markdown0000644000000000000000000000350312646541110013530 0ustar0000000000000000comonad ======= [![Hackage](https://img.shields.io/hackage/v/comonad.svg)](https://hackage.haskell.org/package/comonad) [![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-5/Setup.lhs0000644000000000000000000000464412646541110012646 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-5/coq/0000755000000000000000000000000012646541110011610 5ustar0000000000000000comonad-5/coq/Store.v0000644000000000000000000000452412646541110013100 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-5/examples/0000755000000000000000000000000012646541110012644 5ustar0000000000000000comonad-5/examples/History.hs0000644000000000000000000000311512646541110014641 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-5/src/0000755000000000000000000000000012646541110011615 5ustar0000000000000000comonad-5/src/Control/0000755000000000000000000000000012646541110013235 5ustar0000000000000000comonad-5/src/Control/Comonad.hs0000644000000000000000000002615212646541110015157 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, Safe, DefaultSignatures #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy, DefaultSignatures #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad -- Copyright : (C) 2008-2015 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 , kfix -- :: ComonadApply w => 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 Data.Functor 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 qualified Data.Functor.Sum as FSum import Data.List.NonEmpty hiding (map) import Data.Semigroup hiding (Product) import Data.Tagged import Prelude hiding (id, (.)) import Control.Monad.Fix import Data.Typeable #ifdef MIN_VERSION_containers import Data.Tree #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 #if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL extract, (duplicate | extend) #-} #endif instance Comonad ((,)e) where duplicate p = (fst p, p) {-# INLINE duplicate #-} extract = snd {-# INLINE extract #-} #if MIN_VERSION_semigroups(0,16,2) instance Comonad (Arg e) where duplicate w@(Arg a _) = Arg a w {-# INLINE duplicate #-} extend f w@(Arg a _) = Arg a (f w) {-# INLINE extend #-} extract (Arg _ b) = b {-# INLINE extract #-} #endif 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 #-} #ifdef MIN_VERSION_containers instance Comonad Tree where duplicate w@(Node _ as) = Node w (map duplicate as) extract (Node a _) = a {-# INLINE extract #-} #endif 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 #-} coproduct :: (f a -> b) -> (g a -> b) -> FSum.Sum f g a -> b coproduct f _ (FSum.InL x) = f x coproduct _ g (FSum.InR y) = g y {-# INLINE coproduct #-} instance (Comonad f, Comonad g) => Comonad (FSum.Sum f g) where extend f = coproduct (FSum.InL . extend (f . FSum.InL)) (FSum.InR . extend (f . FSum.InR)) extract = coproduct extract extract {-# 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 #if __GLASGOW_HASKELL__ >= 702 default (<@>) :: Applicative w => w (a -> b) -> w a -> w b (<@>) = (<*>) #endif (@>) :: 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) #ifdef MIN_VERSION_containers instance ComonadApply Tree where (<@>) = (<*>) (<@ ) = (<* ) ( @>) = ( *>) #endif -- | A suitable default definition for 'fmap' for a 'Comonad'. -- Promotes a function to a comonad. -- -- You can only safely use to define 'fmap' if your 'Comonad' -- defined 'extend', not just 'duplicate', since defining -- 'extend' in terms of duplicate uses 'fmap'! -- -- @ -- '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 David Menendez wfix :: Comonad w => w (w a -> a) -> a wfix w = extract w (extend wfix w) -- | Comonadic fixed point à la Dominic Orchard cfix :: Comonad w => (w a -> a) -> w a cfix f = fix (extend f) {-# INLINE cfix #-} -- | Comonadic fixed point à la Kenneth Foner: -- -- This is the @evaluate@ function from his talk. kfix :: ComonadApply w => w (w a -> a) -> w a kfix w = fix $ \u -> w <@> duplicate u {-# INLINE kfix #-} -- | '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 deriving Typeable #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 = pure Cokleisli k >>= f = Cokleisli $ \w -> runCokleisli (f (k w)) w #if !(MIN_VERSION_base(4,7,0)) infixl 4 $> -- | Replace the contents of a functor uniformly with a constant value. ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) #endif comonad-5/src/Control/Comonad/0000755000000000000000000000000012646541110014615 5ustar0000000000000000comonad-5/src/Control/Comonad/Env.hs0000644000000000000000000000241312646541110015701 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Env -- Copyright : (C) 2008-2014 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-5/src/Control/Comonad/Identity.hs0000644000000000000000000000145312646541110016745 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Identity -- Copyright : (C) 2008-2014 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-5/src/Control/Comonad/Store.hs0000644000000000000000000000206112646541110016244 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Store -- Copyright : (C) 2008-2014 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-5/src/Control/Comonad/Traced.hs0000644000000000000000000000216212646541110016354 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Traced -- Copyright : (C) 2008-2014 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-5/src/Control/Comonad/Env/0000755000000000000000000000000012646541110015345 5ustar0000000000000000comonad-5/src/Control/Comonad/Env/Class.hs0000644000000000000000000000335312646541110016752 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Env.Class -- Copyright : (C) 2008-2015 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 #if MIN_VERSION_semigroups(0,16,2) instance ComonadEnv e (Arg e) where ask (Arg e _) = e #endif 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-5/src/Control/Comonad/Hoist/0000755000000000000000000000000012646541110015703 5ustar0000000000000000comonad-5/src/Control/Comonad/Hoist/Class.hs0000644000000000000000000000160512646541110017306 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-5/src/Control/Comonad/Store/0000755000000000000000000000000012646541110015711 5ustar0000000000000000comonad-5/src/Control/Comonad/Store/Class.hs0000644000000000000000000000463212646541110017317 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} #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 #if __GLASGOW_HASKELL__ < 710 import Data.Semigroup #endif 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-5/src/Control/Comonad/Traced/0000755000000000000000000000000012646541110016017 5ustar0000000000000000comonad-5/src/Control/Comonad/Traced/Class.hs0000644000000000000000000000356412646541110017430 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Safe #-} #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 #if __GLASGOW_HASKELL__ < 710 import Data.Semigroup #endif 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 instance Monoid m => ComonadTraced m ((->) m) where trace m f = f m 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-5/src/Control/Comonad/Trans/0000755000000000000000000000000012646541110015704 5ustar0000000000000000comonad-5/src/Control/Comonad/Trans/Class.hs0000644000000000000000000000147212646541110017311 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Trans.Class -- Copyright : (C) 2008-2015 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-5/src/Control/Comonad/Trans/Env.hs0000644000000000000000000001174012646541110016773 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE StandaloneDeriving, DeriveDataTypeable, Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif #ifndef MIN_VERSION_base #define MIN_VERSION_base(x,y,z) 1 #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 #if !(MIN_VERSION_base(4,8,0)) import Control.Applicative #endif import Control.Comonad import Control.Comonad.Hoist.Class import Control.Comonad.Trans.Class #if __GLASGOW_HASKELL__ < 710 import Data.Foldable import Data.Traversable #endif 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 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 #-} #endif #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 instance (Monoid e, Applicative m) => Applicative (EnvT e m) where pure = EnvT mempty . pure EnvT ef wf <*> EnvT ea wa = EnvT (ef `mappend` ea) (wf <*> 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-5/src/Control/Comonad/Trans/Identity.hs0000644000000000000000000000123012646541110020025 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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-5/src/Control/Comonad/Trans/Store.hs0000644000000000000000000001300312646541110017331 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE StandaloneDeriving, DeriveDataTypeable, Safe #-} #elif __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@: -- -- >>> :{ -- let -- storeTuple :: Store (Int, Int) Int -- storeTuple = store fst (1, 5) -- :} -- -- Add something to the focus: -- -- >>> :{ -- let -- addToFocus :: Int -> Store (Int, Int) Int -> Int -- addToFocus x wa = x + extract wa -- :} -- -- >>> :{ -- let -- 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 #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif 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 -- $setup -- >>> import Data.Tuple (swap) #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-5/src/Control/Comonad/Trans/Traced.hs0000644000000000000000000000714312646541110017447 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE StandaloneDeriving, DeriveDataTypeable, Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Control.Comonad.Trans.Traced -- Copyright : (C) 2008-2014 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 #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif #if __GLASGOW_HASKELL__ < 707 import Control.Monad.Instances () #endif import Control.Monad (ap) import Control.Comonad import Control.Comonad.Hoist.Class import Control.Comonad.Trans.Class #ifdef MIN_VERSION_distributive import Data.Distributive #endif import Data.Functor.Identity #if __GLASGOW_HASKELL__ < 710 import Data.Semigroup #endif 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 ComonadHoist (TracedT m) where cohoist l = TracedT . l . runTracedT #ifdef MIN_VERSION_distributive instance Distributive w => Distributive (TracedT m w) where distribute = TracedT . fmap (\tma m -> fmap ($ m) tma) . collect runTracedT #endif 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-5/src/Data/0000755000000000000000000000000012646541110012466 5ustar0000000000000000comonad-5/src/Data/Functor/0000755000000000000000000000000012646541110014106 5ustar0000000000000000comonad-5/src/Data/Functor/Composition.hs0000644000000000000000000000070512646541110016747 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-5/tests/0000755000000000000000000000000012646541110012170 5ustar0000000000000000comonad-5/tests/doctests.hsc0000644000000000000000000000456712646541110014533 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) #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif 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