comonad-5.0.8/0000755000000000000000000000000007346545000011335 5ustar0000000000000000comonad-5.0.8/.gitignore0000755000000000000000000000043007346545000013325 0ustar0000000000000000dist dist-newstyle docs wiki TAGS tags wip .DS_Store .*.swp .*.swo *.o *.hi *~ *# .stack-work/ cabal-dev *.chi *.chs.h *.dyn_o *.dyn_hi .hpc .hsenv .cabal-sandbox/ cabal.sandbox.config *.prof *.aux *.hp *.eventlog cabal.project.local cabal.project.local~ .HTF/ .ghc.environment.* comonad-5.0.8/.hlint.yaml0000755000000000000000000000017107346545000013417 0ustar0000000000000000- arguments: [--cpp-define=HLINT, --cpp-ansi] - ignore: {name: Eta reduce} - ignore: {name: Use import/export shortcut} comonad-5.0.8/.vim.custom0000755000000000000000000000137707346545000013455 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.0.8/CHANGELOG.markdown0000755000000000000000000000565007346545000014401 0ustar00000000000000005.0.8 [2020.12.30] ------------------ * Explicitly mark modules as Safe or Trustworthy. * The build-type has been changed from `Custom` to `Simple`. To achieve this, the `doctests` test suite has been removed in favor of using [`cabal-docspec`](https://github.com/phadej/cabal-extras/tree/master/cabal-docspec) to run the doctests. 5.0.7 [2020.12.15] ------------------ * Move `FunctorWithIndex (TracedT m w)` instance from `lens`. This instance depends on the `indexed-traversable` package. This can be disabled using the flag of the same name. 5.0.6 [2019.11.26] ------------------ * Achieve forward compatibility with [GHC proposal 229](https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0229-whitespace-bang-patterns.rst). 5.0.5 [2019.05.02] ------------------ * Raised the minimum `semigroups` version to 0.16.2. In addition, the package will only be required at all for GHCs before 8.0. * Drop the `contravariant` flag from `comonad.cabal`, as `comonad` no longer depends on the `contravariant` library. 5.0.4 [2018.07.01] ------------------ * Add `Comonad` instances for `Tagged s` with `s` of any kind. Before the change, `s` had to be of kind `*`. * Allow `containers-0.6`. 5.0.3 [2018.02.06] ------------------ * Don't enable `Safe` on GHC 7.2. 5.0.2 ----- * Support `doctest-0.12` 5.0.1 ----- * Revamp `Setup.hs` to use `cabal-doctest`. This makes it build with `Cabal-1.25`, and makes the `doctest`s work with `cabal new-build` and sandboxes. 5 - * 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.0.8/LICENSE0000644000000000000000000000242607346545000012346 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.0.8/README.markdown0000755000000000000000000000363007346545000014043 0ustar0000000000000000comonad ======= [![Build Status](https://github.com/ekmett/comonad/workflows/Haskell-CI/badge.svg)](https://github.com/ekmett/comonad/actions?query=workflow%3AHaskell-CI) This package provides comonads, the categorical dual of monads. The typeclass provides three methods: `extract`, `duplicate`, and `extend`. 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](https://wiki.haskell.org/Monad_laws). The comonad laws can perhaps be made clearer by viewing them as stating that Cokleisli composition must be a) associative and b) have `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 implementations 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.0.8/Setup.lhs0000644000000000000000000000017307346545000013146 0ustar0000000000000000\begin{code} module Main (main) where import Distribution.Simple (defaultMain) main :: IO () main = defaultMain \end{code} comonad-5.0.8/comonad.cabal0000644000000000000000000000664407346545000013753 0ustar0000000000000000name: comonad category: Control, Comonads version: 5.0.8 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: Simple tested-with: GHC == 7.0.4 , GHC == 7.2.2 , GHC == 7.4.2 , GHC == 7.6.3 , GHC == 7.8.4 , GHC == 7.10.3 , GHC == 8.0.2 , GHC == 8.2.2 , GHC == 8.4.4 , GHC == 8.6.5 , GHC == 8.8.3 , GHC == 8.10.1 extra-source-files: .gitignore .hlint.yaml .vim.custom coq/Store.v README.markdown CHANGELOG.markdown examples/History.hs 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 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 flag indexed-traversable description: You can disable the use of the `indexed-traversable` package using `-f-indexed-traversable`. . 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 `FunctorWithIndex` . 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, tagged >= 0.8.6.1 && < 1, transformers >= 0.3 && < 0.6, transformers-compat >= 0.5 && < 1 if !impl(ghc >= 8.0) build-depends: semigroups >= 0.18.5 && < 1 if flag(containers) build-depends: containers >= 0.3 && < 0.7 if flag(distributive) build-depends: distributive >= 0.5.2 && < 1 if flag(indexed-traversable) build-depends: indexed-traversable >= 0.1.1 && < 0.2 if impl(ghc >= 9.0) -- these flags may abort compilation with GHC-8.10 -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/3295 ghc-options: -Winferred-safe-imports -Wmissing-safe-haskell-mode 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 comonad-5.0.8/coq/0000755000000000000000000000000007346545000012117 5ustar0000000000000000comonad-5.0.8/coq/Store.v0000755000000000000000000000452407346545000013412 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.0.8/examples/0000755000000000000000000000000007346545000013153 5ustar0000000000000000comonad-5.0.8/examples/History.hs0000755000000000000000000000314207346545000015153 0ustar0000000000000000{-# LANGUAGE DeriveFunctor, DeriveFoldable, DeriveTraversable #-} {-# OPTIONS_GHC -Wall #-} -- http://www.mail-archive.com/haskell@haskell.org/msg17244.html module History where import Control.Category import Control.Comonad import Data.Foldable hiding (sum) import Data.Traversable import Prelude hiding (id,(.),sum) 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.0.8/src/Control/0000755000000000000000000000000007346545000013544 5ustar0000000000000000comonad-5.0.8/src/Control/Comonad.hs0000644000000000000000000002653207346545000015470 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, Safe, DefaultSignatures #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy, DefaultSignatures #-} #endif #if __GLASGOW_HASKELL__ >= 706 {-# LANGUAGE PolyKinds #-} #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 #-} 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 #-} 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 #-} #if __GLASGOW_HASKELL__ >= 706 -- $ -- The variable `s` can have any kind. -- For example, here it has kind `Bool`: -- >>> :set -XDataKinds -- >>> extract (Tagged 42 :: Tagged 'True Integer) -- 42 #endif 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 'liftW' to define 'fmap' if your 'Comonad' -- defines '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.0.8/src/Control/Comonad/0000755000000000000000000000000007346545000015124 5ustar0000000000000000comonad-5.0.8/src/Control/Comonad/Env.hs0000644000000000000000000000241307346545000016210 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.0.8/src/Control/Comonad/Env/0000755000000000000000000000000007346545000015654 5ustar0000000000000000comonad-5.0.8/src/Control/Comonad/Env/Class.hs0000644000000000000000000000330107346545000017252 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 instance ComonadEnv e (Arg e) where ask (Arg e _) = e 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.0.8/src/Control/Comonad/Hoist/0000755000000000000000000000000007346545000016212 5ustar0000000000000000comonad-5.0.8/src/Control/Comonad/Hoist/Class.hs0000644000000000000000000000202407346545000017611 0ustar0000000000000000{-# LANGUAGE RankNTypes #-} {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- 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.0.8/src/Control/Comonad/Identity.hs0000644000000000000000000000145307346545000017254 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.0.8/src/Control/Comonad/Store.hs0000644000000000000000000000206107346545000016553 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.0.8/src/Control/Comonad/Store/0000755000000000000000000000000007346545000016220 5ustar0000000000000000comonad-5.0.8/src/Control/Comonad/Store/Class.hs0000644000000000000000000000467007346545000017630 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __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 #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.0.8/src/Control/Comonad/Traced.hs0000644000000000000000000000216207346545000016663 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.0.8/src/Control/Comonad/Traced/0000755000000000000000000000000007346545000016326 5ustar0000000000000000comonad-5.0.8/src/Control/Comonad/Traced/Class.hs0000644000000000000000000000362207346545000017732 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __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 #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.0.8/src/Control/Comonad/Trans/0000755000000000000000000000000007346545000016213 5ustar0000000000000000comonad-5.0.8/src/Control/Comonad/Trans/Class.hs0000644000000000000000000000147207346545000017620 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.0.8/src/Control/Comonad/Trans/Env.hs0000644000000000000000000001206007346545000017276 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 #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup #endif #ifdef __GLASGOW_HASKELL__ #if __GLASGOW_HASKELL__ >= 707 #define Typeable1 Typeable #endif import Data.Data -- $setup -- >>> import Control.Comonad #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.0.8/src/Control/Comonad/Trans/Identity.hs0000644000000000000000000000123007346545000020334 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.0.8/src/Control/Comonad/Trans/Store.hs0000644000000000000000000001311007346545000017637 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 #if !(MIN_VERSION_base(4,11,0)) import Data.Semigroup #endif #ifdef __GLASGOW_HASKELL__ import Data.Typeable -- $setup -- >>> import Control.Comonad -- >>> 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.0.8/src/Control/Comonad/Trans/Traced.hs0000644000000000000000000000776207346545000017765 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 707 {-# LANGUAGE StandaloneDeriving, DeriveDataTypeable, Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif #ifdef MIN_VERSION_indexed_traversable {-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-} #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 #ifdef MIN_VERSION_indexed_traversable import Data.Functor.WithIndex #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 #ifdef MIN_VERSION_indexed_traversable instance FunctorWithIndex i w => FunctorWithIndex (s, i) (TracedT s w) where imap f (TracedT w) = TracedT $ imap (\k' g k -> f (k, k') (g k)) w {-# INLINE imap #-} #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.0.8/src/Data/Functor/0000755000000000000000000000000007346545000014415 5ustar0000000000000000comonad-5.0.8/src/Data/Functor/Composition.hs0000644000000000000000000000112407346545000017252 0ustar0000000000000000{-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 704 {-# LANGUAGE Safe #-} #elif __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif module 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