kleisli (empty) → 0.0.1
raw patch · 8 files changed
+1290/−0 lines, 8 filesdep +adjunctionsdep +basedep +comonadsetup-changed
Dependencies added: adjunctions, base, comonad, contravariant, deepseq, distributive, kleisli, lens, mtl, process, profunctors, selective, semigroupoids, tasty-bench, transformers
Files
- LICENCE +30/−0
- README.md +66/−0
- Setup.hs +8/−0
- benchmarks/Main.hs +188/−0
- changelog.md +3/−0
- kleisli.cabal +90/−0
- src/Data/Kleisli.hs +887/−0
- test/Main.hs +18/−0
+ LICENCE view
@@ -0,0 +1,30 @@+Copyright (c) 2026 Tony Morris++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * 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.++ * Neither the name of Tony Morris nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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 COPYRIGHT+OWNER 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.
+ README.md view
@@ -0,0 +1,66 @@+# kleisli++Three newtype wrappers around `p a (f b)` with different type parameter orderings, enabling different type class instances depending on which parameter is last.++| Type | Parameter order | Primary instances |+|------|----------------|-------------------|+| `Kleisli p a f b` | functor in `b` | Functor, Applicative, Monad, MonadTrans, Distributive, Representable |+| `ProKleisli p f a b` | profunctor in `(a, b)` | Profunctor, Strong, Choice, Closed, Category, Arrow, Sieve, Representable |+| `ContraKleisli p b f a` | contravariant in `a` | Contravariant, Divisible, Decidable |++All three are representationally identical (`p a (f b)`) and connected by isomorphisms.++## Usage++When `p` is specialised to `(->)`, extensive instances are derived via `Star`, `ReaderT`, `Arrow.Kleisli`, and `Op`:++```haskell+import Data.Kleisli++-- Kleisli: use as a functor/monad in the result+k :: Kleisli (->) Int Maybe Int+k = fmap (+1) (Kleisli Just)++-- ProKleisli: use as a profunctor/arrow+p :: ProKleisli (->) Maybe Int Int+p = arr (+1) >>> arr (*2)++-- ContraKleisli: use as a contravariant functor+c :: ContraKleisli (->) Int Maybe Int+c = contramap (+1) (ContraKleisli Just)+```++## Type aliases++Convenient aliases eliminate common type parameters:++```haskell+type Kleisli' p a b = Kleisli p a Identity b -- no functor layer+type KleisliA a f b = Kleisli (->) a f b -- specialise profunctor to (->)+type KleisliA' a b = KleisliA a Identity b -- both specialised+```++Analogous aliases exist for `ProKleisli` and `ContraKleisli`.++## Isomorphisms++Lens `Iso`s convert between the three orderings:++```haskell+_Kleisli_ProKleisli :: Iso (Kleisli p a f b) ... (ProKleisli p f a b) ...+_Kleisli_ContraKleisli :: Iso (Kleisli p a f b) ... (ContraKleisli p b f a) ...+```++Identity-eliminating isos map through the `Identity` wrapper:++```haskell+kleisli' :: Iso (Kleisli' p a b) ... (p a b) ...+```++## Building++```+cabal build+cabal test doctest+cabal bench+```
+ Setup.hs view
@@ -0,0 +1,8 @@+{-# OPTIONS_GHC -Wall -Werror #-}++module Main (main) where++import Distribution.Simple (defaultMain)++main :: IO ()+main = defaultMain
+ benchmarks/Main.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -Wall -Werror #-}++module Main (main) where++import Control.Arrow (arr, (>>>))+import Control.Category ((.))+import Control.Comonad (duplicate, extract)+import Control.Monad ((>=>))+import Data.Functor.Apply ((<.>))+import Data.Functor.Bind ((>>-))+import Data.Functor.Contravariant (contramap)+import Data.Functor.Contravariant.Divisible (divide)+import Data.Functor.Identity (Identity (..))+import Data.Kleisli (ContraKleisli (..), Kleisli (..), ProKleisli (..))+import Data.Profunctor (dimap, lmap, rmap)+import Data.Semigroupoid (o)+import Test.Tasty.Bench (bench, bgroup, defaultMain, whnf)+import Prelude hiding ((.))++n :: Int+n = 1000++input :: Int+input = 42++kleisliFmap :: Int -> Kleisli (->) Int Maybe Int+kleisliFmap depth = iterate (fmap (+ 1)) (Kleisli Just) !! depth+{-# NOINLINE kleisliFmap #-}++rawFmap :: Int -> (Int -> Maybe Int)+rawFmap depth = iterate (\f x -> fmap (+ 1) (f x)) Just !! depth+{-# NOINLINE rawFmap #-}++kleisliApply :: Int -> Kleisli (->) Int Maybe Int+kleisliApply depth = iterate (\acc -> fmap (+) acc <.> Kleisli Just) (Kleisli Just) !! depth+{-# NOINLINE kleisliApply #-}++kleisliBind :: Int -> Kleisli (->) Int Maybe Int+kleisliBind depth = iterate (\acc -> acc >>- \x -> Kleisli (\_ -> Just (x + 1))) (Kleisli Just) !! depth+{-# NOINLINE kleisliBind #-}++rawBind :: Int -> (Int -> Maybe Int)+rawBind depth = iterate (\acc -> acc >=> \x -> Just (x + 1)) Just !! depth+{-# NOINLINE rawBind #-}++proKleisliCompose :: Int -> ProKleisli (->) Maybe Int Int+proKleisliCompose depth = iterate (\acc -> acc . ProKleisli (\x -> Just (x + 1))) (ProKleisli Just) !! depth+{-# NOINLINE proKleisliCompose #-}++proKleisliSemi :: Int -> ProKleisli (->) Maybe Int Int+proKleisliSemi depth = iterate (\acc -> acc `o` ProKleisli (\x -> Just (x + 1))) (ProKleisli Just) !! depth+{-# NOINLINE proKleisliSemi #-}++proKleisliArrow :: Int -> ProKleisli (->) Maybe Int Int+proKleisliArrow depth = iterate (\acc -> acc >>> arr (+ 1)) (ProKleisli Just) !! depth+{-# NOINLINE proKleisliArrow #-}++proKleisliLmap :: Int -> ProKleisli (->) Maybe Int Int+proKleisliLmap depth = iterate (lmap (+ 1)) (ProKleisli Just) !! depth+{-# NOINLINE proKleisliLmap #-}++rawLmap :: Int -> (Int -> Maybe Int)+rawLmap depth = iterate (\f x -> f (x + 1)) Just !! depth+{-# NOINLINE rawLmap #-}++proKleisliRmap :: Int -> ProKleisli (->) Maybe Int Int+proKleisliRmap depth = iterate (rmap (+ 1)) (ProKleisli Just) !! depth+{-# NOINLINE proKleisliRmap #-}++rawRmap :: Int -> (Int -> Maybe Int)+rawRmap depth = iterate (\f x -> fmap (+ 1) (f x)) Just !! depth+{-# NOINLINE rawRmap #-}++proKleisliDimap :: Int -> ProKleisli (->) Maybe Int Int+proKleisliDimap depth = iterate (dimap (+ 1) (+ 1)) (ProKleisli Just) !! depth+{-# NOINLINE proKleisliDimap #-}++rawDimap :: Int -> (Int -> Maybe Int)+rawDimap depth = iterate (\f x -> fmap (+ 1) (f (x + 1))) Just !! depth+{-# NOINLINE rawDimap #-}++contraKleisliContramap :: Int -> ContraKleisli (->) Int Identity Int+contraKleisliContramap depth = iterate (contramap (+ 1)) (ContraKleisli (Identity . (+ 1))) !! depth+{-# NOINLINE contraKleisliContramap #-}++rawContramap :: Int -> (Int -> Identity Int)+rawContramap depth = iterate (\f x -> f (x + 1)) (Identity . (+ 1)) !! depth+{-# NOINLINE rawContramap #-}++contraKleisliDivide :: Int -> ContraKleisli (->) Int [] Int+contraKleisliDivide depth =+ iterate (\acc -> divide (\x -> (x, x)) acc (ContraKleisli (\x -> [x + 1]))) (ContraKleisli (: [])) !! depth+{-# NOINLINE contraKleisliDivide #-}++kleisliComonad :: Int -> Kleisli (->) String ((,) String) Int+kleisliComonad depth = iterate (fmap (+ 1)) (Kleisli (\s -> (s, length s))) !! depth+{-# NOINLINE kleisliComonad #-}++rawExtract :: Int -> (String -> (String, Int))+rawExtract depth = iterate (\f s -> let (e, x) = f s in (e, x + 1)) (\s -> (s, length s)) !! depth+{-# NOINLINE rawExtract #-}++proKleisliComonad :: Int -> ProKleisli (->) ((,) String) String Int+proKleisliComonad depth = iterate (fmap (+ 1)) (ProKleisli (\s -> (s, length s))) !! depth+{-# NOINLINE proKleisliComonad #-}++main :: IO ()+main =+ defaultMain+ [ bgroup+ "Kleisli"+ [ bgroup+ "fmap"+ [ bench "newtype" $ whnf (\k -> let Kleisli f = k in f input) (kleisliFmap n),+ bench "raw" $ whnf (\f -> f input) (rawFmap n)+ ],+ bgroup+ "apply"+ [ bench "newtype" $ whnf (\k -> let Kleisli f = k in f input) (kleisliApply n)+ ],+ bgroup+ "bind"+ [ bench "newtype" $ whnf (\k -> let Kleisli f = k in f input) (kleisliBind n),+ bench "raw" $ whnf (\f -> f input) (rawBind n)+ ],+ bgroup+ "extract"+ [ bench "newtype" $ whnf extract (kleisliComonad n),+ bench "raw" $ whnf (\f -> snd (f "")) (rawExtract n)+ ],+ bgroup+ "duplicate"+ [ bench "newtype" $ whnf (\k -> let Kleisli f = duplicate k in f "") (kleisliComonad n)+ ]+ ],+ bgroup+ "ProKleisli"+ [ bgroup+ "category-compose"+ [ bench "newtype" $ whnf (\k -> let ProKleisli f = k in f input) (proKleisliCompose n),+ bench "raw" $ whnf (\f -> f input) (rawBind n)+ ],+ bgroup+ "semigroupoid-compose"+ [ bench "newtype" $ whnf (\k -> let ProKleisli f = k in f input) (proKleisliSemi n)+ ],+ bgroup+ "arrow-compose"+ [ bench "newtype" $ whnf (\k -> let ProKleisli f = k in f input) (proKleisliArrow n)+ ],+ bgroup+ "lmap"+ [ bench "newtype" $ whnf (\k -> let ProKleisli f = k in f input) (proKleisliLmap n),+ bench "raw" $ whnf (\f -> f input) (rawLmap n)+ ],+ bgroup+ "rmap"+ [ bench "newtype" $ whnf (\k -> let ProKleisli f = k in f input) (proKleisliRmap n),+ bench "raw" $ whnf (\f -> f input) (rawRmap n)+ ],+ bgroup+ "dimap"+ [ bench "newtype" $ whnf (\k -> let ProKleisli f = k in f input) (proKleisliDimap n),+ bench "raw" $ whnf (\f -> f input) (rawDimap n)+ ],+ bgroup+ "extract"+ [ bench "newtype" $ whnf extract (proKleisliComonad n)+ ],+ bgroup+ "duplicate"+ [ bench "newtype" $ whnf (\k -> let ProKleisli f = duplicate k in f "") (proKleisliComonad n)+ ]+ ],+ bgroup+ "ContraKleisli"+ [ bgroup+ "contramap"+ [ bench "newtype" $ whnf (\k -> let ContraKleisli f = k in f input) (contraKleisliContramap n),+ bench "raw" $ whnf (\f -> f input) (rawContramap n)+ ],+ bgroup+ "divide"+ [ bench "newtype" $ whnf (\k -> let ContraKleisli f = k in f input) (contraKleisliDivide n)+ ]+ ]+ ]
+ changelog.md view
@@ -0,0 +1,3 @@+0.0.1++* This change log starts
+ kleisli.cabal view
@@ -0,0 +1,90 @@+cabal-version: 2.4+name: kleisli+version: 0.0.1+synopsis: Kleisli-like newtypes with different type parameter orderings+description:+ Three newtype wrappers around @p a (f b)@ with different type parameter+ orderings, enabling different type class instances depending on which+ parameter is last:+ .+ * @Kleisli p a f b@ — functor in @b@ (Functor, Applicative, Monad, etc.)+ * @ProKleisli p f a b@ — profunctor in @(a, b)@ (Profunctor, Category, Arrow, etc.)+ * @ContraKleisli p b f a@ — contravariant in @a@ (Contravariant, Divisible, Decidable)+ .+ All three are representationally identical and connected by isomorphisms.+ When @p@ is specialised to @(->)@, extensive instances are derived via+ @Star@, @ReaderT@, @Arrow.Kleisli@, and @Op@.+license: BSD-3-Clause+license-file: LICENCE+author: Tony Morris <tmorris@tmorris.net>+maintainer: Tony Morris <tmorris@tmorris.net>+category: Data+build-type: Simple+extra-doc-files: changelog.md+ , README.md+homepage: https://gitlab.com/tonymorris/kleisli+bug-reports: https://gitlab.com/tonymorris/kleisli/-/issues+tested-with: GHC == 9.6.7++flag dev+ description: Enable development warnings (-Werror, -O2 for benchmarks)+ manual: True+ default: False++source-repository head+ type: git+ location: https://gitlab.com/tonymorris/kleisli.git++library+ exposed-modules:+ Data.Kleisli++ build-depends: base >= 4.8 && < 6+ , adjunctions >= 4.3 && < 5+ , comonad >= 5 && < 6+ , contravariant >= 1 && < 2+ , deepseq >= 1.4 && < 2+ , distributive >= 0.5 && < 1+ , lens >= 4 && < 6+ , mtl >= 2.2 && < 3+ , profunctors >= 5 && < 6+ , selective >= 0.5 && < 1+ , semigroupoids >= 5.2 && < 7+ , transformers >= 0.5 && < 1++ hs-source-dirs: src++ default-language: Haskell2010++ ghc-options: -Wall++ if flag(dev)+ ghc-options: -Werror++benchmark bench+ type: exitcode-stdio-1.0+ hs-source-dirs: benchmarks+ main-is: Main.hs+ build-depends: base >= 4.8 && < 6+ , tasty-bench >= 0.3 && < 1+ , kleisli+ , comonad >= 5 && < 6+ , contravariant >= 1 && < 2+ , profunctors >= 5 && < 6+ , semigroupoids >= 5.2 && < 7+ , transformers >= 0.5 && < 1+ default-language: Haskell2010+ ghc-options: -Wall++ if flag(dev)+ ghc-options: -Werror -O2++test-suite doctest+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends: base >= 4.8 && < 6+ , process >= 1 && < 2+ build-tool-depends: doctest:doctest >= 0.22 && < 1+ default-language: Haskell2010+ ghc-options: -Wall
+ src/Data/Kleisli.hs view
@@ -0,0 +1,887 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wall #-}++{- HLINT ignore "Use camelCase" -}++-- |+-- Module : Data.Kleisli+-- Description : Kleisli-like newtypes with different type parameter orderings+--+-- Three newtype wrappers around @p a (f b)@ with different type parameter+-- orderings, enabling different type class instances:+--+-- * 'Kleisli' @p a f b@ — functor in @b@+-- * 'ProKleisli' @p f a b@ — profunctor in @(a, b)@, category/arrow instances+-- * 'ContraKleisli' @p b f a@ — contravariant in @a@+--+-- All three are representationally identical and connected by isomorphisms.+module Data.Kleisli+ ( -- * Types+ Kleisli (..),+ ProKleisli (..),+ ContraKleisli (..),++ -- * Kleisli type aliases+ Kleisli',+ KleisliA,+ KleisliA',++ -- * ProKleisli type aliases+ ProKleisli',+ ProKleisliA,+ ProKleisliA',++ -- * ContraKleisli type aliases+ ContraKleisli',+ ContraKleisliA,+ ContraKleisliA',++ -- * Kleisli isomorphisms+ kleisli',+ _Kleisli_ProKleisli,+ _Kleisli_ContraKleisli,++ -- * ProKleisli isomorphisms+ proKleisli',+ _ProKleisli_Kleisli,+ _ProKleisli_ContraKleisli,++ -- * ContraKleisli isomorphisms+ contraKleisli',+ _ContraKleisli_ProKleisli,+ _ContraKleisli_Kleisli,++ -- * Functor layer mapping+ hoistKleisli,+ hoistKleisli',+ hoistProKleisli,+ hoistProKleisli',+ hoistContraKleisli,+ hoistContraKleisli',+ )+where++import Control.Applicative (Alternative)+import Control.Arrow (Arrow, ArrowApply, ArrowChoice, ArrowLoop, ArrowPlus, ArrowZero)+import qualified Control.Arrow as Arrow (Kleisli (..))+import Control.Category (Category)+import Control.Comonad (Comonad (..), ComonadApply ((<@>)))+import Control.Comonad.Traced.Class (ComonadTraced (..))+import Control.DeepSeq (NFData (..))+import Control.Lens (Iso, Rewrapped, Wrapped (..), iso)+import Control.Monad (MonadPlus)+import Control.Monad.Cont.Class (MonadCont)+import Control.Monad.Error.Class (MonadError)+import Control.Monad.Fix (MonadFix)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader.Class (MonadReader)+import Control.Monad.State.Class (MonadState)+import Control.Monad.Trans.Class (MonadTrans)+import Control.Monad.Trans.Reader (ReaderT (..))+import Control.Monad.Writer.Class (MonadWriter)+import Control.Monad.Zip (MonadZip)+import Control.Selective (Selective)+import Data.Distributive (Distributive (..))+import Data.Functor.Alt (Alt (..))+import Data.Functor.Apply (Apply (..))+import Data.Functor.Bind (Bind (..))+import Data.Functor.Bind.Trans (BindTrans)+import Data.Functor.Contravariant (Contravariant (..), Op (..))+import Data.Functor.Contravariant.Conclude (Conclude)+import Data.Functor.Contravariant.Decide (Decide (..))+import Data.Functor.Contravariant.Divise (Divise (..))+import Data.Functor.Contravariant.Divisible (Decidable, Divisible (..))+import qualified Data.Functor.Contravariant.Rep as CRep (Representable (..))+import Data.Functor.Extend (Extend (..))+import Data.Functor.Identity (Identity (..))+import Data.Functor.Plus (Plus (..))+import qualified Data.Functor.Rep as FRep (Rep, Representable (..))+import Data.Profunctor (Closed, Profunctor (..), Strong)+import Data.Profunctor.Choice (Choice, Cochoice)+import Data.Profunctor.Mapping (Mapping)+import qualified Data.Profunctor.Rep as PRep (Representable (..))+import Data.Profunctor.Sieve (Sieve (..))+import Data.Profunctor.Strong (Costrong)+import Data.Profunctor.Traversing (Traversing)+import Data.Profunctor.Types (Star (..))+import Data.Semigroupoid (Semigroupoid)+import GHC.Generics (Generic)++-- $setup+-- >>> import Control.Applicative (Alternative(..))+-- >>> import Control.Monad (MonadPlus(..))+-- >>> import Control.Monad.Trans.Class (lift)+-- >>> import Data.Functor.Identity (Identity(..))+-- >>> import Data.Functor.Bind.Trans (liftB)+-- >>> import Data.Profunctor (lmap, rmap)+-- >>> import Control.Lens (view, review)++-- | A newtype around @p a (f b)@ with the functor parameter @f@ as the+-- penultimate type variable, enabling 'Functor' and related instances in @b@.+--+-- >>> let k = Kleisli (\x -> Just (x + 1))+-- >>> let Kleisli f = k in f 3+-- Just 4+newtype Kleisli p a f b = Kleisli (p a (f b))+ deriving stock (Generic)++-- | A newtype around @p a (f b)@ with the functor parameter @f@ as the+-- first type variable after @p@, enabling 'Profunctor', 'Category', and+-- 'Arrow' instances when @p@ is @(->)@.+--+-- >>> let k = ProKleisli (\x -> Just (x + 1))+-- >>> let ProKleisli f = k in f 3+-- Just 4+newtype ProKleisli p f a b = ProKleisli (p a (f b))+ deriving stock (Generic)++-- | A newtype around @p a (f b)@ with @a@ as the last type variable,+-- enabling 'Contravariant' and related instances.+--+-- >>> let k = ContraKleisli (\x -> Just (x + 1))+-- >>> let ContraKleisli f = k in f 3+-- Just 4+newtype ContraKleisli p b f a = ContraKleisli (p a (f b))+ deriving stock (Generic)++-- | @'Kleisli' p a 'Identity' b@, eliminating the functor layer.+--+-- >>> let k = Kleisli (Identity . (+1)) :: Kleisli' (->) Int Int+-- >>> let Kleisli f = k in runIdentity (f 5)+-- 6+type Kleisli' p a b = Kleisli p a Identity b++-- | @'Kleisli' (->) a f b@, specialising the profunctor to @(->)@.+--+-- >>> let k = Kleisli Just :: KleisliA Int Maybe Int+-- >>> let Kleisli f = k in f 5+-- Just 5+type KleisliA a f b = Kleisli (->) a f b++-- | @'KleisliA' a 'Identity' b@, specialising both profunctor and functor.+--+-- >>> let k = Kleisli (Identity . (+1)) :: KleisliA' Int Int+-- >>> let Kleisli f = k in f 5+-- Identity 6+type KleisliA' a b = KleisliA a Identity b++-- | @'ProKleisli' p 'Identity' a b@, eliminating the functor layer.+--+-- >>> let k = ProKleisli (Identity . (+1)) :: ProKleisli' (->) Int Int+-- >>> let ProKleisli f = k in runIdentity (f 5)+-- 6+type ProKleisli' p a b = ProKleisli p Identity a b++-- | @'ProKleisli' (->) f a b@, specialising the profunctor to @(->)@.+--+-- >>> let k = ProKleisli Just :: ProKleisliA Maybe Int Int+-- >>> let ProKleisli f = k in f 5+-- Just 5+type ProKleisliA f a b = ProKleisli (->) f a b++-- | @'ProKleisliA' 'Identity' a b@, specialising both profunctor and functor.+--+-- >>> let k = ProKleisli (Identity . (+1)) :: ProKleisliA' Int Int+-- >>> let ProKleisli f = k in f 5+-- Identity 6+type ProKleisliA' a b = ProKleisliA Identity a b++-- | @'ContraKleisli' p b 'Identity' a@, eliminating the functor layer.+--+-- >>> let k = ContraKleisli (Identity . (+1)) :: ContraKleisli' (->) Int Int+-- >>> let ContraKleisli f = k in runIdentity (f 5)+-- 6+type ContraKleisli' p b a = ContraKleisli p b Identity a++-- | @'ContraKleisli' (->) b f a@, specialising the profunctor to @(->)@.+--+-- >>> let k = ContraKleisli Just :: ContraKleisliA Int Maybe Int+-- >>> let ContraKleisli f = k in f 5+-- Just 5+type ContraKleisliA b f a = ContraKleisli (->) b f a++-- | @'ContraKleisliA' b 'Identity' a@, specialising both profunctor and functor.+--+-- >>> let k = ContraKleisli (Identity . (+1)) :: ContraKleisliA' Int Int+-- >>> let ContraKleisli f = k in f 5+-- Identity 6+type ContraKleisliA' b a = ContraKleisliA b Identity a++-- | An isomorphism between @'Kleisli'' p a b@ and @p a b@, mapping through+-- the 'Identity' wrapper using 'rmap'.+--+-- >>> view kleisli' (Kleisli (Identity . (+1)) :: Kleisli' (->) Int Int) 5+-- 6+-- >>> let Kleisli f = review kleisli' (+1) :: Kleisli' (->) Int Int in runIdentity (f 5)+-- 6+kleisli' :: (Profunctor p, Profunctor p') => Iso (Kleisli' p a b) (Kleisli' p' a' b') (p a b) (p' a' b')+kleisli' = iso (\(Kleisli x) -> rmap runIdentity x) (Kleisli . rmap Identity)+{-# INLINE kleisli' #-}++-- | An isomorphism between 'Kleisli' and 'ProKleisli', reordering type parameters.+--+-- >>> let ProKleisli f = view _Kleisli_ProKleisli (Kleisli Just :: Kleisli (->) Int Maybe Int) in f 5+-- Just 5+_Kleisli_ProKleisli :: Iso (Kleisli p a f b) (Kleisli p' a' f' b') (ProKleisli p f a b) (ProKleisli p' f' a' b')+_Kleisli_ProKleisli = iso (\(Kleisli x) -> ProKleisli x) (\(ProKleisli x) -> Kleisli x)+{-# INLINE _Kleisli_ProKleisli #-}++-- | An isomorphism between 'Kleisli' and 'ContraKleisli', reordering type parameters.+--+-- >>> let ContraKleisli f = view _Kleisli_ContraKleisli (Kleisli Just :: Kleisli (->) Int Maybe Int) in f 5+-- Just 5+_Kleisli_ContraKleisli :: Iso (Kleisli p a f b) (Kleisli p' a' f' b') (ContraKleisli p b f a) (ContraKleisli p' b' f' a')+_Kleisli_ContraKleisli = iso (\(Kleisli x) -> ContraKleisli x) (\(ContraKleisli x) -> Kleisli x)+{-# INLINE _Kleisli_ContraKleisli #-}++-- | An isomorphism between @'ProKleisli'' p a b@ and @p a b@, mapping through+-- the 'Identity' wrapper using 'rmap'.+--+-- >>> view proKleisli' (ProKleisli (Identity . (+1)) :: ProKleisli' (->) Int Int) 5+-- 6+-- >>> let ProKleisli f = review proKleisli' (+1) :: ProKleisli' (->) Int Int in runIdentity (f 5)+-- 6+proKleisli' :: (Profunctor p, Profunctor p') => Iso (ProKleisli' p a b) (ProKleisli' p' a' b') (p a b) (p' a' b')+proKleisli' = iso (\(ProKleisli x) -> rmap runIdentity x) (ProKleisli . rmap Identity)+{-# INLINE proKleisli' #-}++-- | An isomorphism between 'ProKleisli' and 'Kleisli', reordering type parameters.+--+-- >>> let Kleisli f = view _ProKleisli_Kleisli (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f 5+-- Just 5+_ProKleisli_Kleisli :: Iso (ProKleisli p f a b) (ProKleisli p' f' a' b') (Kleisli p a f b) (Kleisli p' a' f' b')+_ProKleisli_Kleisli = iso (\(ProKleisli x) -> Kleisli x) (\(Kleisli x) -> ProKleisli x)+{-# INLINE _ProKleisli_Kleisli #-}++-- | An isomorphism between 'ProKleisli' and 'ContraKleisli', reordering type parameters.+--+-- >>> let ContraKleisli f = view _ProKleisli_ContraKleisli (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f 5+-- Just 5+_ProKleisli_ContraKleisli :: Iso (ProKleisli p f a b) (ProKleisli p' f' a' b') (ContraKleisli p b f a) (ContraKleisli p' b' f' a')+_ProKleisli_ContraKleisli = iso (\(ProKleisli x) -> ContraKleisli x) (\(ContraKleisli x) -> ProKleisli x)+{-# INLINE _ProKleisli_ContraKleisli #-}++-- | An isomorphism between @'ContraKleisli'' p b a@ and @p a b@, mapping through+-- the 'Identity' wrapper using 'rmap'.+--+-- >>> view contraKleisli' (ContraKleisli (Identity . (+1)) :: ContraKleisli' (->) Int Int) 5+-- 6+-- >>> let ContraKleisli f = review contraKleisli' (+1) :: ContraKleisli' (->) Int Int in runIdentity (f 5)+-- 6+contraKleisli' :: (Profunctor p, Profunctor p') => Iso (ContraKleisli' p b a) (ContraKleisli' p' b' a') (p a b) (p' a' b')+contraKleisli' = iso (\(ContraKleisli x) -> rmap runIdentity x) (ContraKleisli . rmap Identity)+{-# INLINE contraKleisli' #-}++-- | An isomorphism between 'ContraKleisli' and 'ProKleisli', reordering type parameters.+--+-- >>> let ProKleisli f = view _ContraKleisli_ProKleisli (ContraKleisli Just :: ContraKleisli (->) Int Maybe Int) in f 5+-- Just 5+_ContraKleisli_ProKleisli :: Iso (ContraKleisli p b f a) (ContraKleisli p' b' f' a') (ProKleisli p f a b) (ProKleisli p' f' a' b')+_ContraKleisli_ProKleisli = iso (\(ContraKleisli x) -> ProKleisli x) (\(ProKleisli x) -> ContraKleisli x)+{-# INLINE _ContraKleisli_ProKleisli #-}++-- | An isomorphism between 'ContraKleisli' and 'Kleisli', reordering type parameters.+--+-- >>> let Kleisli f = view _ContraKleisli_Kleisli (ContraKleisli Just :: ContraKleisli (->) Int Maybe Int) in f 5+-- Just 5+_ContraKleisli_Kleisli :: Iso (ContraKleisli p b f a) (ContraKleisli p' b' f' a') (Kleisli p a f b) (Kleisli p' a' f' b')+_ContraKleisli_Kleisli = iso (\(ContraKleisli x) -> Kleisli x) (\(Kleisli x) -> ContraKleisli x)+{-# INLINE _ContraKleisli_Kleisli #-}++-- | Map over the functor layer of a 'Kleisli' using 'rmap'.+--+-- >>> let Kleisli f = hoistKleisli (Just . runIdentity) (Kleisli (Identity . (+1)) :: Kleisli (->) Int Identity Int) in f 5+-- Just 6+hoistKleisli :: (Profunctor p) => (f b -> g c) -> Kleisli p a f b -> Kleisli p a g c+hoistKleisli h (Kleisli k) = Kleisli (rmap h k)+{-# INLINE hoistKleisli #-}++-- | Map over the functor layer of a 'Kleisli'' using 'dimap', first stripping+-- the 'Identity' wrapper.+--+-- >>> let Kleisli f = hoistKleisli' Just (Kleisli (Identity . (+1)) :: Kleisli' (->) Int Int) in f 5+-- Just 6+hoistKleisli' :: (Profunctor p) => (b -> g c) -> Kleisli' p a b -> Kleisli p a g c+hoistKleisli' h = hoistKleisli (h . runIdentity)+{-# INLINE hoistKleisli' #-}++-- | Map over the functor layer of a 'ProKleisli' using 'rmap'.+--+-- >>> let ProKleisli f = hoistProKleisli (Just . runIdentity) (ProKleisli (Identity . (+1)) :: ProKleisli (->) Identity Int Int) in f 5+-- Just 6+hoistProKleisli :: (Profunctor p) => (f b -> g c) -> ProKleisli p f a b -> ProKleisli p g a c+hoistProKleisli h (ProKleisli k) = ProKleisli (rmap h k)+{-# INLINE hoistProKleisli #-}++-- | Map over the functor layer of a 'ProKleisli'' using 'dimap', first+-- stripping the 'Identity' wrapper.+--+-- >>> let ProKleisli f = hoistProKleisli' Just (ProKleisli (Identity . (+1)) :: ProKleisli' (->) Int Int) in f 5+-- Just 6+hoistProKleisli' :: (Profunctor p) => (b -> g c) -> ProKleisli' p a b -> ProKleisli p g a c+hoistProKleisli' h = hoistProKleisli (h . runIdentity)+{-# INLINE hoistProKleisli' #-}++-- | Map over the functor layer of a 'ContraKleisli' using 'rmap'.+--+-- >>> let ContraKleisli f = hoistContraKleisli (Just . runIdentity) (ContraKleisli (Identity . (+1)) :: ContraKleisli (->) Int Identity Int) in f 5+-- Just 6+hoistContraKleisli :: (Profunctor p) => (f b -> g c) -> ContraKleisli p b f a -> ContraKleisli p c g a+hoistContraKleisli h (ContraKleisli k) = ContraKleisli (rmap h k)+{-# INLINE hoistContraKleisli #-}++-- | Map over the functor layer of a 'ContraKleisli'' using 'dimap', first+-- stripping the 'Identity' wrapper.+--+-- >>> let ContraKleisli f = hoistContraKleisli' Just (ContraKleisli (Identity . (+1)) :: ContraKleisli' (->) Int Int) in f 5+-- Just 6+hoistContraKleisli' :: (Profunctor p) => (b -> g c) -> ContraKleisli' p b a -> ContraKleisli p c g a+hoistContraKleisli' h = hoistContraKleisli (h . runIdentity)+{-# INLINE hoistContraKleisli' #-}++-- | >>> import Control.Lens (op, _Wrapped')+-- >>> op Kleisli (Kleisli Just :: Kleisli (->) Int Maybe Int) 5+-- Just 5+instance (Kleisli p' a' f' b' ~ t) => Rewrapped (Kleisli p a f b) t++instance Wrapped (Kleisli p a f b) where+ type Unwrapped (Kleisli p a f b) = p a (f b)+ _Wrapped' = iso (\(Kleisli x) -> x) Kleisli+ {-# INLINE _Wrapped' #-}++-- | >>> import Control.DeepSeq (rnf)+-- >>> rnf (Kleisli Just :: Kleisli (->) Int Maybe Int)+-- ()+instance (NFData (p a (f b))) => NFData (Kleisli p a f b) where+ rnf (Kleisli x) = rnf x+ {-# INLINE rnf #-}++-- | >>> let Kleisli f = Kleisli (\_ -> [1,2]) <> Kleisli (\_ -> [3,4]) :: Kleisli (->) Int [] Int in f 0+-- [1,2,3,4]+deriving via (a -> f b) instance (Semigroup (f b)) => Semigroup (Kleisli (->) a f b)++-- | >>> let Kleisli f = mempty :: Kleisli (->) Int [] Int in f 5+-- []+deriving via (a -> f b) instance (Monoid (f b)) => Monoid (Kleisli (->) a f b)++-- | >>> let Kleisli f = fmap (+1) (Kleisli Just) in f 5+-- Just 6+instance (Functor f) => Functor (Kleisli (->) a f) where+ fmap g (Kleisli k) = Kleisli (fmap g . k)+ {-# INLINE fmap #-}++-- | >>> let Kleisli f = pure 42 :: Kleisli (->) String Maybe Int in f "ignored"+-- Just 42+deriving via (Star f a) instance (Applicative f) => Applicative (Kleisli (->) a f)++-- | >>> let Kleisli f = (Kleisli Just :: Kleisli (->) Int Maybe Int) >>= \x -> Kleisli (\_ -> Just (x + 1)) in f 5+-- Just 6+deriving via (Star f a) instance (Monad f) => Monad (Kleisli (->) a f)++-- | >>> let Kleisli f = Kleisli (\a -> Just (a+)) <.> Kleisli (\a -> Just (a*2)) in f 3+-- Just 9+instance (Apply f) => Apply (Kleisli (->) a f) where+ Kleisli f <.> Kleisli x = Kleisli (\a -> f a <.> x a)+ {-# INLINE (<.>) #-}++-- | >>> let Kleisli f = Kleisli Just >>- \x -> Kleisli (\_ -> Just (x + 1)) in f 5+-- Just 6+instance (Bind f) => Bind (Kleisli (->) a f) where+ Kleisli m >>- f = Kleisli (\a -> m a >>- \x -> let Kleisli g = f x in g a)+ {-# INLINE (>>-) #-}++-- | >>> let Kleisli f = Kleisli (\_ -> Nothing) <!> Kleisli Just :: Kleisli (->) Int Maybe Int in f 5+-- Just 5+instance (Alt f) => Alt (Kleisli (->) a f) where+ Kleisli f <!> Kleisli g = Kleisli (\a -> f a <!> g a)+ {-# INLINE (<!>) #-}++-- | >>> let Kleisli f = zero :: Kleisli (->) Int Maybe Int in f 5+-- Nothing+instance (Plus f) => Plus (Kleisli (->) a f) where+ zero = Kleisli (const zero)+ {-# INLINE zero #-}++-- | >>> let Kleisli f = empty :: Kleisli (->) Int Maybe Int in f 5+-- Nothing+deriving via (ReaderT a f) instance (Alternative f) => Alternative (Kleisli (->) a f)++-- | >>> let Kleisli f = mzero :: Kleisli (->) Int Maybe Int in f 5+-- Nothing+deriving via (ReaderT a f) instance (MonadPlus f) => MonadPlus (Kleisli (->) a f)++-- | >>> import Control.Monad.Fix (mfix)+-- >>> let Kleisli f = mfix (\_ -> Kleisli (\_ -> Just 42)) :: Kleisli (->) Int Maybe Int in f 5+-- Just 42+deriving via (ReaderT a f) instance (MonadFix f) => MonadFix (Kleisli (->) a f)++-- | >>> let Kleisli f = (fail "oops" :: Kleisli (->) Int Maybe Int) in f 5+-- Nothing+deriving via (ReaderT a f) instance (MonadFail f) => MonadFail (Kleisli (->) a f)++-- | >>> import Control.Monad.Reader.Class (ask)+-- >>> let Kleisli f = ask :: Kleisli (->) Int Maybe Int in f 5+-- Just 5+deriving via (ReaderT a f) instance (Monad f) => MonadReader a (Kleisli (->) a f)++-- | >>> import Control.Monad.IO.Class (liftIO)+-- >>> let Kleisli f = liftIO (pure 42) :: Kleisli (->) String IO Int in f "ignored"+-- 42+deriving via (ReaderT a f) instance (MonadIO f) => MonadIO (Kleisli (->) a f)++-- | >>> import Control.Monad.Writer.Class (tell)+-- >>> import Control.Monad.Trans.Writer (runWriterT, WriterT)+-- >>> let Kleisli f = tell "hello" :: Kleisli (->) Int (WriterT String Maybe) () in runWriterT (f 5)+-- Just ((),"hello")+deriving via (ReaderT a f) instance (MonadWriter w f) => MonadWriter w (Kleisli (->) a f)++-- | >>> import Control.Monad.State.Class (get, put)+-- >>> import Control.Monad.Trans.State (runStateT, StateT)+-- >>> let Kleisli f = put 99 :: Kleisli (->) String (StateT Int Maybe) () in runStateT (f "ignored") 0+-- Just ((),99)+deriving via (ReaderT a f) instance (MonadState s f) => MonadState s (Kleisli (->) a f)++-- | >>> import Control.Monad.Error.Class (throwError)+-- >>> import Control.Monad.Trans.Except (runExceptT, ExceptT)+-- >>> let Kleisli f = throwError "oops" :: Kleisli (->) Int (ExceptT String Maybe) () in runExceptT (f 5)+-- Just (Left "oops")+deriving via (ReaderT a f) instance (MonadError e f) => MonadError e (Kleisli (->) a f)++-- | >>> import Control.Monad.Cont.Class (callCC)+-- >>> import Control.Monad.Trans.Cont (runContT, ContT)+-- >>> let Kleisli f = callCC (\k -> k 42) :: Kleisli (->) String (ContT Int Maybe) Int+-- >>> runContT (f "ignored") Just+-- Just 42+deriving via (ReaderT a f) instance (MonadCont f) => MonadCont (Kleisli (->) a f)++-- | >>> import Control.Selective (select, ifS)+-- >>> let Kleisli f = ifS (Kleisli (\_ -> Just True)) (Kleisli (\_ -> Just 1)) (Kleisli (\_ -> Just 2)) in f ()+-- Just 1+deriving via (ReaderT a f) instance (Selective f) => Selective (Kleisli (->) a f)++-- | >>> import Control.Monad.Zip (mzip)+-- >>> let Kleisli f = mzip (Kleisli (\_ -> [1,2])) (Kleisli (\_ -> [3,4])) in f ()+-- [(1,3),(2,4)]+deriving via (ReaderT a f) instance (MonadZip f) => MonadZip (Kleisli (->) a f)++-- | >>> let Kleisli f = lift (Just 42) :: Kleisli (->) String Maybe Int in f "ignored"+-- Just 42+deriving via (ReaderT a) instance MonadTrans (Kleisli (->) a)++-- | >>> let Kleisli f = liftB (Just 42) :: Kleisli (->) String Maybe Int in f "ignored"+-- Just 42+deriving via (ReaderT a) instance BindTrans (Kleisli (->) a)++-- | >>> import Data.Functor.Extend (duplicated)+-- >>> let Kleisli g = duplicated (Kleisli (\s -> Just (length s)) :: Kleisli (->) String Maybe Int) in fmap (\(Kleisli h) -> h " world") (g "hello")+-- Just (Just 11)+instance (Semigroup a, Applicative f) => Extend (Kleisli (->) a f) where+ duplicated (Kleisli w) = Kleisli (\a -> pure (Kleisli (w . (<>) a)))+ {-# INLINE duplicated #-}++-- | >>> import Control.Comonad (extract)+-- >>> extract (Kleisli (\s -> (s, length s)) :: Kleisli (->) String ((,) String) Int)+-- 0+instance (Monoid a, Comonad f, Applicative f) => Comonad (Kleisli (->) a f) where+ extract (Kleisli w) = extract (w mempty)+ {-# INLINE extract #-}+ duplicate (Kleisli w) = Kleisli (\a -> pure (Kleisli (w . (<>) a)))+ {-# INLINE duplicate #-}++-- | >>> import Control.Comonad ((<@>))+-- >>> let Kleisli f = Kleisli (\s -> (s, (+ length s))) <@> Kleisli (\s -> (s, 10)) :: Kleisli (->) String ((,) String) Int in f ""+-- ("",10)+instance (Monoid a, Comonad f, Applicative f) => ComonadApply (Kleisli (->) a f) where+ (<@>) = (<*>)+ {-# INLINE (<@>) #-}++-- | >>> import Control.Comonad.Traced.Class (trace)+-- >>> trace "!" (Kleisli (\s -> (s, length s)) :: Kleisli (->) String ((,) String) Int)+-- 1+instance (Monoid a, Comonad f, Applicative f) => ComonadTraced a (Kleisli (->) a f) where+ trace m (Kleisli w) = extract (w m)+ {-# INLINE trace #-}++-- | >>> import Data.Distributive (distribute)+-- >>> let xs = [Kleisli (\n -> Identity (n+1)), Kleisli (\n -> Identity (n*2))] :: [Kleisli (->) Int Identity Int]+-- >>> let Kleisli f = distribute xs in runIdentity (f 3)+-- [4,6]+instance (Distributive f) => Distributive (Kleisli (->) a f) where+ distribute gs = Kleisli (\a -> distribute (fmap (\(Kleisli k) -> k a) gs))+ {-# INLINE distribute #-}++-- | >>> import Data.Functor.Rep (index)+-- >>> let k = Kleisli (\a -> Identity (a * 2)) :: Kleisli (->) Int Identity Int+-- >>> index k (3, ())+-- 6+instance (FRep.Representable f) => FRep.Representable (Kleisli (->) a f) where+ type Rep (Kleisli (->) a f) = (a, FRep.Rep f)+ tabulate f = Kleisli (\a -> FRep.tabulate (\r -> f (a, r)))+ {-# INLINE tabulate #-}+ index (Kleisli k) (a, r) = FRep.index (k a) r+ {-# INLINE index #-}++-- | >>> import Control.Lens (op, _Wrapped')+-- >>> op ProKleisli (ProKleisli Just :: ProKleisli (->) Maybe Int Int) 5+-- Just 5+instance (ProKleisli p' f' a' b' ~ t) => Rewrapped (ProKleisli p f a b) t++instance Wrapped (ProKleisli p f a b) where+ type Unwrapped (ProKleisli p f a b) = p a (f b)+ _Wrapped' = iso (\(ProKleisli x) -> x) ProKleisli+ {-# INLINE _Wrapped' #-}++-- | >>> import Control.DeepSeq (rnf)+-- >>> rnf (ProKleisli Just :: ProKleisli (->) Maybe Int Int)+-- ()+instance (NFData (p a (f b))) => NFData (ProKleisli p f a b) where+ rnf (ProKleisli x) = rnf x+ {-# INLINE rnf #-}++-- | >>> let ProKleisli f = ProKleisli (\_ -> [1,2]) <> ProKleisli (\_ -> [3,4]) :: ProKleisli (->) [] Int Int in f 0+-- [1,2,3,4]+deriving via (a -> f b) instance (Semigroup (f b)) => Semigroup (ProKleisli (->) f a b)++-- | >>> let ProKleisli f = mempty :: ProKleisli (->) [] Int Int in f 5+-- []+deriving via (a -> f b) instance (Monoid (f b)) => Monoid (ProKleisli (->) f a b)++-- | >>> let ProKleisli f = fmap (+1) (ProKleisli Just) in f 5+-- Just 6+instance (Functor f) => Functor (ProKleisli (->) f a) where+ fmap g (ProKleisli k) = ProKleisli (fmap g . k)+ {-# INLINE fmap #-}++-- | >>> let ProKleisli f = pure 42 :: ProKleisli (->) Maybe String Int in f "ignored"+-- Just 42+deriving via (Star f a) instance (Applicative f) => Applicative (ProKleisli (->) f a)++-- | >>> let ProKleisli f = return 42 :: ProKleisli (->) Maybe String Int in f "ignored"+-- Just 42+deriving via (Star f a) instance (Monad f) => Monad (ProKleisli (->) f a)++-- | >>> let ProKleisli f = ProKleisli (\a -> Just (a+)) <.> ProKleisli (\a -> Just (a*2)) in f 3+-- Just 9+instance (Apply f) => Apply (ProKleisli (->) f a) where+ ProKleisli f <.> ProKleisli x = ProKleisli (\a -> f a <.> x a)+ {-# INLINE (<.>) #-}++-- | >>> let ProKleisli f = ProKleisli Just >>- \x -> ProKleisli (\_ -> Just (x + 1)) in f 5+-- Just 6+instance (Bind f) => Bind (ProKleisli (->) f a) where+ ProKleisli m >>- f = ProKleisli (\a -> m a >>- \x -> let ProKleisli g = f x in g a)+ {-# INLINE (>>-) #-}++-- | >>> let ProKleisli f = ProKleisli (\_ -> Nothing) <!> ProKleisli Just :: ProKleisli (->) Maybe Int Int in f 5+-- Just 5+instance (Alt f) => Alt (ProKleisli (->) f a) where+ ProKleisli f <!> ProKleisli g = ProKleisli (\a -> f a <!> g a)+ {-# INLINE (<!>) #-}++-- | >>> let ProKleisli f = zero :: ProKleisli (->) Maybe Int Int in f 5+-- Nothing+instance (Plus f) => Plus (ProKleisli (->) f a) where+ zero = ProKleisli (const zero)+ {-# INLINE zero #-}++-- | >>> let ProKleisli f = empty :: ProKleisli (->) Maybe Int Int in f 5+-- Nothing+deriving via (ReaderT a f) instance (Alternative f) => Alternative (ProKleisli (->) f a)++-- | >>> let ProKleisli f = mzero :: ProKleisli (->) Maybe Int Int in f 5+-- Nothing+deriving via (ReaderT a f) instance (MonadPlus f) => MonadPlus (ProKleisli (->) f a)++-- | >>> import Control.Monad.Fix (mfix)+-- >>> let ProKleisli f = mfix (\_ -> ProKleisli (\_ -> Just 42)) :: ProKleisli (->) Maybe Int Int in f 5+-- Just 42+deriving via (ReaderT a f) instance (MonadFix f) => MonadFix (ProKleisli (->) f a)++-- | >>> let ProKleisli f = (fail "oops" :: ProKleisli (->) Maybe Int Int) in f 5+-- Nothing+deriving via (ReaderT a f) instance (MonadFail f) => MonadFail (ProKleisli (->) f a)++-- | >>> import Control.Monad.Reader.Class (ask)+-- >>> let ProKleisli f = ask :: ProKleisli (->) Maybe Int Int in f 5+-- Just 5+deriving via (ReaderT a f) instance (Monad f) => MonadReader a (ProKleisli (->) f a)++-- | >>> import Control.Monad.IO.Class (liftIO)+-- >>> let ProKleisli f = liftIO (pure 42) :: ProKleisli (->) IO String Int in f "ignored"+-- 42+deriving via (ReaderT a f) instance (MonadIO f) => MonadIO (ProKleisli (->) f a)++-- | >>> import Control.Monad.Writer.Class (tell)+-- >>> import Control.Monad.Trans.Writer (runWriterT, WriterT)+-- >>> let ProKleisli f = tell "hello" :: ProKleisli (->) (WriterT String Maybe) Int () in runWriterT (f 5)+-- Just ((),"hello")+deriving via (ReaderT a f) instance (MonadWriter w f) => MonadWriter w (ProKleisli (->) f a)++-- | >>> import Control.Monad.State.Class (get, put)+-- >>> import Control.Monad.Trans.State (runStateT, StateT)+-- >>> let ProKleisli f = put 99 :: ProKleisli (->) (StateT Int Maybe) String () in runStateT (f "ignored") 0+-- Just ((),99)+deriving via (ReaderT a f) instance (MonadState s f) => MonadState s (ProKleisli (->) f a)++-- | >>> import Control.Monad.Error.Class (throwError)+-- >>> import Control.Monad.Trans.Except (runExceptT, ExceptT)+-- >>> let ProKleisli f = throwError "oops" :: ProKleisli (->) (ExceptT String Maybe) Int () in runExceptT (f 5)+-- Just (Left "oops")+deriving via (ReaderT a f) instance (MonadError e f) => MonadError e (ProKleisli (->) f a)++-- | >>> import Control.Monad.Cont.Class (callCC)+-- >>> import Control.Monad.Trans.Cont (runContT, ContT)+-- >>> let ProKleisli f = callCC (\k -> k 42) :: ProKleisli (->) (ContT Int Maybe) String Int+-- >>> runContT (f "ignored") Just+-- Just 42+deriving via (ReaderT a f) instance (MonadCont f) => MonadCont (ProKleisli (->) f a)++-- | >>> import Control.Selective (ifS)+-- >>> let ProKleisli f = ifS (ProKleisli (\_ -> Just True)) (ProKleisli (\_ -> Just 1)) (ProKleisli (\_ -> Just 2)) in f ()+-- Just 1+deriving via (ReaderT a f) instance (Selective f) => Selective (ProKleisli (->) f a)++-- | >>> import Control.Monad.Zip (mzip)+-- >>> let ProKleisli f = mzip (ProKleisli (\_ -> [1,2])) (ProKleisli (\_ -> [3,4])) in f ()+-- [(1,3),(2,4)]+deriving via (ReaderT a f) instance (MonadZip f) => MonadZip (ProKleisli (->) f a)++-- | >>> import Data.Functor.Extend (duplicated)+-- >>> let ProKleisli g = duplicated (ProKleisli (\s -> Just (length s)) :: ProKleisli (->) Maybe String Int) in fmap (\(ProKleisli h) -> h " world") (g "hello")+-- Just (Just 11)+instance (Semigroup a, Applicative f) => Extend (ProKleisli (->) f a) where+ duplicated (ProKleisli w) = ProKleisli (\a -> pure (ProKleisli (w . (<>) a)))+ {-# INLINE duplicated #-}++-- | >>> import Control.Comonad (extract)+-- >>> extract (ProKleisli (\s -> (s, length s)) :: ProKleisli (->) ((,) String) String Int)+-- 0+instance (Monoid a, Comonad f, Applicative f) => Comonad (ProKleisli (->) f a) where+ extract (ProKleisli w) = extract (w mempty)+ {-# INLINE extract #-}+ duplicate (ProKleisli w) = ProKleisli (\a -> pure (ProKleisli (w . (<>) a)))+ {-# INLINE duplicate #-}++-- | >>> import Control.Comonad ((<@>))+-- >>> let ProKleisli f = ProKleisli (\s -> (s, (+ length s))) <@> ProKleisli (\s -> (s, 10)) :: ProKleisli (->) ((,) String) String Int in f ""+-- ("",10)+instance (Monoid a, Comonad f, Applicative f) => ComonadApply (ProKleisli (->) f a) where+ (<@>) = (<*>)+ {-# INLINE (<@>) #-}++-- | >>> import Control.Comonad.Traced.Class (trace)+-- >>> trace "!" (ProKleisli (\s -> (s, length s)) :: ProKleisli (->) ((,) String) String Int)+-- 1+instance (Monoid a, Comonad f, Applicative f) => ComonadTraced a (ProKleisli (->) f a) where+ trace m (ProKleisli w) = extract (w m)+ {-# INLINE trace #-}++-- | >>> import Data.Distributive (distribute)+-- >>> let xs = [ProKleisli (\n -> Identity (n+1)), ProKleisli (\n -> Identity (n*2))] :: [ProKleisli (->) Identity Int Int]+-- >>> let ProKleisli f = distribute xs in runIdentity (f 3)+-- [4,6]+instance (Distributive f) => Distributive (ProKleisli (->) f a) where+ distribute gs = ProKleisli (\a -> distribute (fmap (\(ProKleisli k) -> k a) gs))+ {-# INLINE distribute #-}++-- | >>> import Data.Functor.Rep (index)+-- >>> let k = ProKleisli (\a -> Identity (a * 2)) :: ProKleisli (->) Identity Int Int+-- >>> index k (3, ())+-- 6+instance (FRep.Representable f) => FRep.Representable (ProKleisli (->) f a) where+ type Rep (ProKleisli (->) f a) = (a, FRep.Rep f)+ tabulate f = ProKleisli (\a -> FRep.tabulate (\r -> f (a, r)))+ {-# INLINE tabulate #-}+ index (ProKleisli k) (a, r) = FRep.index (k a) r+ {-# INLINE index #-}++-- | >>> let ProKleisli f = lmap (+1) (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f 5+-- Just 6+--+-- >>> let ProKleisli f = rmap (+1) (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f 5+-- Just 6+instance (Functor f) => Profunctor (ProKleisli (->) f) where+ dimap f g (ProKleisli k) = ProKleisli (fmap g . k . f)+ {-# INLINE dimap #-}+ lmap f (ProKleisli k) = ProKleisli (k . f)+ {-# INLINE lmap #-}+ rmap g (ProKleisli k) = ProKleisli (fmap g . k)+ {-# INLINE rmap #-}++-- | >>> import Data.Profunctor (Strong(..))+-- >>> let ProKleisli f = first' (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f (5, "hi")+-- Just (5,"hi")+deriving via (Star f) instance (Functor f) => Strong (ProKleisli (->) f)++-- | >>> import Data.Profunctor.Choice (Choice(..))+-- >>> let ProKleisli f = left' (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f (Left 5)+-- Just (Left 5)+deriving via (Star f) instance (Applicative f) => Choice (ProKleisli (->) f)++-- | >>> import Data.Profunctor.Choice (Cochoice(..))+-- >>> let ProKleisli f = unleft (ProKleisli (\e -> [e]) :: ProKleisli (->) [] (Either Int ()) (Either Int ())) in f 5+-- [5]+deriving via (Star f) instance (Traversable f) => Cochoice (ProKleisli (->) f)++-- | >>> import Data.Profunctor (Closed(..))+-- >>> import Data.Functor.Identity (Identity(..))+-- >>> let ProKleisli f = closed (ProKleisli (Identity . (+1)) :: ProKleisli (->) Identity Int Int) in runIdentity (f (const 5)) ()+-- 6+deriving via (Star f) instance (Distributive f) => Closed (ProKleisli (->) f)++-- | >>> import Data.Profunctor.Traversing (Traversing(..))+-- >>> let ProKleisli f = traverse' (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f [1,2,3]+-- Just [1,2,3]+deriving via (Star f) instance (Applicative f) => Traversing (ProKleisli (->) f)++-- | >>> import Data.Profunctor.Mapping (Mapping(..))+-- >>> import Data.Functor.Identity (Identity(..))+-- >>> let ProKleisli f = map' (ProKleisli (Identity . (+1)) :: ProKleisli (->) Identity Int Int) in f [1,2,3]+-- Identity [2,3,4]+deriving via (Star f) instance (Applicative f, Distributive f) => Mapping (ProKleisli (->) f)++-- | >>> import Data.Profunctor.Sieve (sieve)+-- >>> sieve (ProKleisli Just :: ProKleisli (->) Maybe Int Int) 5+-- Just 5+instance (Functor f) => Sieve (ProKleisli (->) f) f where+ sieve (ProKleisli f) = f+ {-# INLINE sieve #-}++-- | >>> import qualified Data.Profunctor.Rep as PRep (tabulate)+-- >>> import Data.Functor.Identity (Identity(..))+-- >>> let ProKleisli f = PRep.tabulate Identity :: ProKleisli (->) Identity Int Int in f 5+-- Identity 5+instance (Functor f, Distributive f) => PRep.Representable (ProKleisli (->) f) where+ type Rep (ProKleisli (->) f) = f+ tabulate = ProKleisli+ {-# INLINE tabulate #-}++-- | >>> import Data.Profunctor.Strong (Costrong(..))+-- >>> let ProKleisli f = unfirst (ProKleisli (\(x,y) -> Just (x+1, y)) :: ProKleisli (->) Maybe (Int, String) (Int, String)) in f 5+-- Just 6+deriving via (Arrow.Kleisli f) instance (MonadFix f) => Costrong (ProKleisli (->) f)++-- | >>> import Data.Semigroupoid (o)+-- >>> let ProKleisli f = ProKleisli (\x -> Just (x + 1)) `o` ProKleisli (\x -> Just (x * 2)) in f 3+-- Just 7+deriving via (Arrow.Kleisli f) instance (Bind f) => Semigroupoid (ProKleisli (->) f)++-- | >>> import Control.Category (id)+-- >>> let ProKleisli f = (Control.Category.id :: ProKleisli (->) Maybe Int Int) in f 5+-- Just 5+deriving via (Arrow.Kleisli f) instance (Monad f) => Category (ProKleisli (->) f)++-- | >>> import Control.Arrow (arr, (>>>))+-- >>> let ProKleisli f = arr (+1) >>> arr (*2) :: ProKleisli (->) Maybe Int Int in f 3+-- Just 8+deriving via (Arrow.Kleisli f) instance (Monad f) => Arrow (ProKleisli (->) f)++-- | >>> import Control.Arrow (left)+-- >>> let ProKleisli f = left (ProKleisli Just :: ProKleisli (->) Maybe Int Int) in f (Left 5)+-- Just (Left 5)+deriving via (Arrow.Kleisli f) instance (Monad f) => ArrowChoice (ProKleisli (->) f)++-- | >>> import Control.Arrow (app)+-- >>> let ProKleisli f = app :: ProKleisli (->) Maybe (ProKleisli (->) Maybe Int Int, Int) Int in f (ProKleisli Just, 5)+-- Just 5+deriving via (Arrow.Kleisli f) instance (Monad f) => ArrowApply (ProKleisli (->) f)++-- | >>> import Control.Arrow (loop)+-- >>> let ProKleisli f = loop (ProKleisli (\(x,_) -> Just (x+1, "hi"))) :: ProKleisli (->) Maybe Int Int in f 5+-- Just 6+deriving via (Arrow.Kleisli f) instance (MonadFix f) => ArrowLoop (ProKleisli (->) f)++-- | >>> import Control.Arrow (zeroArrow)+-- >>> let ProKleisli f = zeroArrow :: ProKleisli (->) Maybe Int Int in f 5+-- Nothing+deriving via (Arrow.Kleisli f) instance (MonadPlus f) => ArrowZero (ProKleisli (->) f)++-- | >>> import Control.Arrow ((<+>))+-- >>> let ProKleisli f = (ProKleisli (\_ -> Nothing) <+> ProKleisli Just) :: ProKleisli (->) Maybe Int Int in f 5+-- Just 5+deriving via (Arrow.Kleisli f) instance (MonadPlus f) => ArrowPlus (ProKleisli (->) f)++-- | >>> import Control.Lens (op, _Wrapped')+-- >>> op ContraKleisli (ContraKleisli Just :: ContraKleisli (->) Int Maybe Int) 5+-- Just 5+instance (ContraKleisli p' b' f' a' ~ t) => Rewrapped (ContraKleisli p b f a) t++instance Wrapped (ContraKleisli p b f a) where+ type Unwrapped (ContraKleisli p b f a) = p a (f b)+ _Wrapped' = iso (\(ContraKleisli x) -> x) ContraKleisli+ {-# INLINE _Wrapped' #-}++-- | >>> import Control.DeepSeq (rnf)+-- >>> rnf (ContraKleisli Just :: ContraKleisli (->) Int Maybe Int)+-- ()+instance (NFData (p a (f b))) => NFData (ContraKleisli p b f a) where+ rnf (ContraKleisli x) = rnf x+ {-# INLINE rnf #-}++-- | >>> let ContraKleisli f = ContraKleisli (\_ -> [1,2]) <> ContraKleisli (\_ -> [3,4]) :: ContraKleisli (->) Int [] Int in f 0+-- [1,2,3,4]+deriving via (a -> f b) instance (Semigroup (f b)) => Semigroup (ContraKleisli (->) b f a)++-- | >>> let ContraKleisli f = mempty :: ContraKleisli (->) Int [] Int in f 5+-- []+deriving via (a -> f b) instance (Monoid (f b)) => Monoid (ContraKleisli (->) b f a)++-- | >>> import Data.Functor.Contravariant (contramap)+-- >>> let ContraKleisli f = contramap (+1) (ContraKleisli Just :: ContraKleisli (->) Int Maybe Int) in f 5+-- Just 6+instance Contravariant (ContraKleisli (->) b f) where+ contramap f (ContraKleisli k) = ContraKleisli (k . f)+ {-# INLINE contramap #-}++-- | >>> import Data.Functor.Contravariant.Divisible (divide, conquer)+-- >>> let ContraKleisli f = conquer :: ContraKleisli (->) Int [] Int in f 5+-- []+instance (Monoid (f b)) => Divisible (ContraKleisli (->) b f) where+ divide f (ContraKleisli g) (ContraKleisli h) = ContraKleisli (\a -> let (b, c) = f a in g b <> h c)+ {-# INLINE divide #-}+ conquer = ContraKleisli (const mempty)+ {-# INLINE conquer #-}++-- | >>> import Data.Functor.Contravariant.Divisible (choose)+-- >>> let ContraKleisli f = choose Left (ContraKleisli (\_ -> [1 :: Int])) (ContraKleisli (\_ -> [2])) :: ContraKleisli (->) Int [] Int in f 5+-- [1]+deriving via (Op (f b)) instance (Monoid (f b)) => Decidable (ContraKleisli (->) b f)++-- | >>> import Data.Functor.Contravariant.Divise (divise)+-- >>> let ContraKleisli f = divise (\x -> (x, x)) (ContraKleisli (\x -> [x])) (ContraKleisli (\x -> [x+1])) :: ContraKleisli (->) Int [] Int in f 5+-- [5,6]+instance (Semigroup (f b)) => Divise (ContraKleisli (->) b f) where+ divise f (ContraKleisli g) (ContraKleisli h) = ContraKleisli (\a -> let (x, y) = f a in g x <> h y)+ {-# INLINE divise #-}++-- | >>> import Data.Functor.Contravariant.Decide (decide)+-- >>> let ContraKleisli f = decide Left (ContraKleisli (\_ -> [1 :: Int])) (ContraKleisli (\_ -> [2])) :: ContraKleisli (->) Int [] Int in f 5+-- [1]+instance Decide (ContraKleisli (->) b f) where+ decide f (ContraKleisli g) (ContraKleisli h) = ContraKleisli (either g h . f)+ {-# INLINE decide #-}++-- | >>> import Data.Functor.Contravariant.Conclude (conclude)+-- >>> import Data.Void (Void)+-- >>> let _ = conclude id :: ContraKleisli (->) Int [] Void in "ok"+-- "ok"+deriving via (Op (f b)) instance Conclude (ContraKleisli (->) b f)++-- | >>> import qualified Data.Functor.Contravariant.Rep as CRep (index, tabulate)+-- >>> let k = CRep.tabulate Just :: ContraKleisli (->) Int Maybe Int+-- >>> CRep.index k 5+-- Just 5+instance CRep.Representable (ContraKleisli (->) b f) where+ type Rep (ContraKleisli (->) b f) = f b+ tabulate = ContraKleisli+ {-# INLINE tabulate #-}+ index (ContraKleisli f) = f+ {-# INLINE index #-}
+ test/Main.hs view
@@ -0,0 +1,18 @@+{-# OPTIONS_GHC -Wall -Werror -Wno-orphans #-}++module Main (main) where++import System.Exit (exitWith)+import System.Process (rawSystem)++main :: IO ()+main =+ exitWith+ =<< rawSystem+ "cabal"+ [ "repl",+ "--with-compiler=doctest",+ "--repl-options=-w",+ "--repl-options=-Wdefault",+ "lib:kleisli"+ ]