profunctors 5.3 → 5.6.3
raw patch · 21 files changed
Files
- .hlint.yaml +18/−1
- .travis.yml +0/−151
- CHANGELOG.markdown +46/−0
- README.markdown +1/−1
- profunctors.cabal +30/−21
- src/Data/Profunctor.hs +1/−3
- src/Data/Profunctor/Adjunction.hs +3/−1
- src/Data/Profunctor/Cayley.hs +26/−1
- src/Data/Profunctor/Choice.hs +43/−27
- src/Data/Profunctor/Closed.hs +13/−5
- src/Data/Profunctor/Composition.hs +16/−2
- src/Data/Profunctor/Mapping.hs +37/−4
- src/Data/Profunctor/Monad.hs +10/−6
- src/Data/Profunctor/Ran.hs +18/−2
- src/Data/Profunctor/Rep.hs +17/−6
- src/Data/Profunctor/Sieve.hs +0/−1
- src/Data/Profunctor/Strong.hs +32/−6
- src/Data/Profunctor/Traversing.hs +8/−7
- src/Data/Profunctor/Types.hs +52/−5
- src/Data/Profunctor/Unsafe.hs +0/−4
- src/Data/Profunctor/Yoneda.hs +3/−1
.hlint.yaml view
@@ -1,3 +1,5 @@+- arguments: [-XCPP]+ - extensions: - default: false # all extension are banned by default - name:@@ -9,11 +11,13 @@ - GADTs - InstanceSigs - MultiParamTypeClasses+ - PolyKinds - RankNTypes+ - Safe - ScopedTypeVariables - Trustworthy- - TypeOperators - TypeFamilies+ - TypeOperators - UndecidableInstances - functions:@@ -48,6 +52,19 @@ - ignore: name: Collapse lambdas within: Data.Profunctor.Unsafe++- ignore:+ name: Eta reduce+ within:+ - Data.Profunctor.Mapping+ - Data.Profunctor.Choice+ - Data.Profunctor.Strong++- ignore:+ name: "Use tuple-section"++- ignore:+ name: "Avoid lambda using `infix`" - fixity: "infixr 9 #." - fixity: "infixl 8 .#"
− .travis.yml
@@ -1,151 +0,0 @@-# This Travis job script has been generated by a script via-#-# runghc make_travis_yml_2.hs '-o' '.travis.yml' '--ghc-head' '--irc-channel=irc.freenode.org#haskell-lens' '--no-no-tests-no-bench' '--no-unconstrained' 'cabal.project'-#-# For more information, see https://github.com/hvr/multi-ghc-travis-#-language: c-sudo: false--git:- submodules: false # whether to recursively clone submodules--notifications:- irc:- channels:- - "irc.freenode.org#haskell-lens"- skip_join: true- template:- - "\x0313profunctors\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"--cache:- directories:- - $HOME/.cabal/packages- - $HOME/.cabal/store--before_cache:- - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log- # remove files that are regenerated by 'cabal update'- - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*- - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json- - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache- - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar- - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx-- - rm -rfv $HOME/.cabal/packages/head.hackage--matrix:- include:- - compiler: "ghc-8.6.1"- env: GHCHEAD=true- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.6.1], sources: [hvr-ghc]}}- - compiler: "ghc-8.4.3"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3], sources: [hvr-ghc]}}- - compiler: "ghc-8.2.2"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2], sources: [hvr-ghc]}}- - compiler: "ghc-8.0.2"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2], sources: [hvr-ghc]}}- - compiler: "ghc-7.10.3"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3], sources: [hvr-ghc]}}- - compiler: "ghc-7.8.4"- # env: TEST=--disable-tests BENCH=--disable-benchmarks- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4], sources: [hvr-ghc]}}- - compiler: "ghc-head"- env: GHCHEAD=true- addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-head], sources: [hvr-ghc]}}-- allow_failures:- - compiler: "ghc-head"- - compiler: "ghc-8.6.1"--before_install:- - HC=${CC}- - HCPKG=${HC/ghc/ghc-pkg}- - unset CC- - export HLINTVER=2.1.3- - mkdir ~/.hlint- - curl -L https://github.com/ndmitchell/hlint/releases/download/v$HLINTVER/hlint-$HLINTVER-x86_64-linux.tar.gz | tar -xz --strip-components=1 -C ~/.hlint- - ROOTDIR=$(pwd)- - mkdir -p $HOME/.local/bin- - "PATH=~/.hlint:/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"- - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))- - echo $HCNUMVER--install:- - cabal --version- - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"- - BENCH=${BENCH---enable-benchmarks}- - TEST=${TEST---enable-tests}- - HADDOCK=${HADDOCK-true}- - UNCONSTRAINED=${UNCONSTRAINED-true}- - NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}- - GHCHEAD=${GHCHEAD-false}- - travis_retry cabal update -v- - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"- - rm -fv cabal.project cabal.project.local- # Overlay Hackage Package Index for GHC HEAD: https://github.com/hvr/head.hackage- - |- if $GHCHEAD; then- sed -i 's/-- allow-newer: .*/allow-newer: *:base/' ${HOME}/.cabal/config- for pkg in $($HCPKG list --simple-output); do pkg=$(echo $pkg | sed 's/-[^-]*$//'); sed -i "s/allow-newer: /allow-newer: *:$pkg, /" ${HOME}/.cabal/config; done-- echo 'repository head.hackage' >> ${HOME}/.cabal/config- echo ' url: http://head.hackage.haskell.org/' >> ${HOME}/.cabal/config- echo ' secure: True' >> ${HOME}/.cabal/config- echo ' root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740' >> ${HOME}/.cabal/config- echo ' 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb' >> ${HOME}/.cabal/config- echo ' 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >> ${HOME}/.cabal/config- echo ' key-threshold: 3' >> ${HOME}/.cabal.config-- grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'-- cabal new-update head.hackage -v- fi- - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'- - "printf 'packages: \".\"\\n' > cabal.project"- - touch cabal.project.local- - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"- - cat cabal.project || true- - cat cabal.project.local || true- - if [ -f "./configure.ac" ]; then- (cd "." && autoreconf -i);- fi- - rm -f cabal.project.freeze- - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all- - rm -rf .ghc.environment.* "."/dist- - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)--# Here starts the actual work to be performed for the package under test;-# any command which exits with a non-zero exit code causes the build to fail.-script:- # test that source-distributions can be generated- - (cd "." && cabal sdist)- - mv "."/dist/profunctors-*.tar.gz ${DISTDIR}/- - cd ${DISTDIR} || false- - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;- - "printf 'packages: profunctors-*/*.cabal\\n' > cabal.project"- - touch cabal.project.local- - "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"- - cat cabal.project || true- - cat cabal.project.local || true-- # build & run tests, build benchmarks- - cabal new-build -w ${HC} ${TEST} ${BENCH} all-- # cabal check- - (cd profunctors-* && cabal check)-- # haddock- - rm -rf ./dist-newstyle- - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi-- # hlint- - hlint --version- - (cd profunctors-* && hlint src)--# REGENDATA ["-o",".travis.yml","--ghc-head","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-unconstrained","cabal.project"]-# EOF
CHANGELOG.markdown view
@@ -1,3 +1,49 @@+5.6.3 [2025.06.17]+------------------+* Drop support for pre-8.0 versions of GHC.++5.6.2 [2021.02.17]+------------------+* Add `Semigroup` and `Monoid` instances for `Forget`++5.6.1 [2020.12.31]+------------------+* Add `Functor` instances for `PastroSum`, `CopastroSum`, `Environment`,+ `FreeMapping`, `Pastro`, `Copastro`, `FreeTraversing`, and `Coyoneda`.+* Explicitly mark modules as `Safe`.++5.6 [2020.10.01]+----------------+* Enable the `PolyKinds` extension. The following datatypes now have+ polymorphic kinds: `(:->)`, `Cayley`, `Procompose`, `Rift`,+ `ProfunctorFunctor`, `Ran`, `Codensity`, `Prep`, `Coprep`, `Star`, `Costar`,+ `WrappedArrow`, `Forget`.+* Allow building with GHC 9.0.++5.5.2 [2020.02.13]+------------------+* Add `Cochoice`, `Costrong`, `Closed`, `Traversing`, and `Mapping` instances+ for `Cayley`.+* Add `Mapping` and `Traversing` instances for `Tannen`.++5.5.1 [2019.11.26]+------------------+* Add `Choice`, `Cochoice`, `Closed`, `Strong`, and `Costrong` instances for+ `Data.Bifunctor.Sum`.++5.5 [2019.09.06]+----------------+* Change the type of `roam` to make it actually useful.+* Add a `Cochoice` instance for `Forget`.++5.4 [2019.05.10]+----------------+* Add `wander`-like combinator `roam` to `Mapping`.+* Remove illegal `instance Choice (Costar w)`.+* Add `strong` combinator #62.+* Only depend on `semigroups` before GHC 8.0.+* Add `Contravariant` instances for `Star` and `Forget`.+ 5.3 [2018.07.02] ---------------- * Generalize the types of `(#.)` and `(.#)`. Before, they were:
README.markdown view
@@ -1,7 +1,7 @@ Profunctors =========== -[](https://hackage.haskell.org/package/profunctors) [](http://travis-ci.org/ekmett/profunctors)+[](https://hackage.haskell.org/package/profunctors) [](https://github.com/ekmett/profunctors/actions?query=workflow%3AHaskell-CI) Profunctors for Haskell.
profunctors.cabal view
@@ -1,6 +1,6 @@ name: profunctors category: Control, Categories-version: 5.3+version: 5.6.3 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -12,38 +12,42 @@ copyright: Copyright (C) 2011-2015 Edward A. Kmett synopsis: Profunctors description: Profunctors.-tested-with: GHC == 7.8.4- , GHC == 7.10.3- , GHC == 8.0.2+tested-with: GHC == 8.0.2 , GHC == 8.2.2- , GHC == 8.4.3- , GHC == 8.6.1+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.2+ , GHC == 9.2.8+ , GHC == 9.4.8+ , GHC == 9.6.6+ , GHC == 9.8.4+ , GHC == 9.10.1+ , GHC == 9.12.2 build-type: Simple extra-source-files: .ghci .gitignore .hlint.yaml- .travis.yml .vim.custom README.markdown CHANGELOG.markdown source-repository head type: git- location: git://github.com/ekmett/profunctors.git+ location: https://github.com/ekmett/profunctors.git library build-depends:- base >= 4.7 && < 5,- base-orphans >= 0.4 && < 0.9,- bifunctors >= 5.2 && < 6,- comonad >= 4 && < 6,- contravariant >= 1 && < 2,- distributive >= 0.4.4 && < 1,- semigroups >= 0.11 && < 0.19,- tagged >= 0.4.4 && < 1,- transformers >= 0.2 && < 0.6-+ base >= 4.9 && < 5,+ base-orphans >= 0.8.4 && < 0.10,+ bifunctors >= 5.5.9 && < 6,+ comonad >= 5.0.8 && < 6,+ contravariant >= 1.5.3 && < 2,+ distributive >= 0.5.2 && < 1,+ tagged >= 0.8.6.1 && < 1,+ transformers >= 0.3 && < 0.7 exposed-modules: Data.Profunctor Data.Profunctor.Adjunction@@ -62,10 +66,15 @@ Data.Profunctor.Unsafe Data.Profunctor.Yoneda - ghc-options: -Wall -O2+ ghc-options: -Wall -O2 -Wno-trustworthy-safe - if impl(ghc>=8.0)- ghc-options: -Wno-trustworthy-safe+ if impl(ghc >= 8.6)+ ghc-options: -Wno-star-is-type++ 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 hs-source-dirs: src
src/Data/Profunctor.hs view
@@ -1,6 +1,4 @@-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2011-2015 Edward Kmett,
src/Data/Profunctor/Adjunction.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2015 Edward Kmett@@ -23,6 +23,8 @@ -- 'unit' '.' 'counit' ≡ 'id' -- 'counit' '.' 'unit' ≡ 'id' -- @++-- ProfunctorAdjunction :: ((Type -> Type -> Type) -> (Type -> Type -> Type)) -> ((Type -> Type -> Type) -> (Type -> Type -> Type)) -> Constraint class (ProfunctorFunctor f, ProfunctorFunctor u) => ProfunctorAdjunction f u | f -> u, u -> f where unit :: Profunctor p => p :-> u (f p) counit :: Profunctor p => f (u p) :-> p
src/Data/Profunctor/Cayley.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Trustworthy #-} -----------------------------------------------------------------------------@@ -19,10 +20,15 @@ import Control.Comonad import Data.Profunctor import Data.Profunctor.Monad+import Data.Profunctor.Traversing import Data.Profunctor.Unsafe import Prelude hiding ((.), id) --- static arrows+-- | Static arrows. Lifted by 'Applicative'.+--+-- 'Cayley' has a polymorphic kind since @5.6@.++-- Cayley :: (k3 -> Type) -> (k1 -> k2 -> k3) -> (k1 -> k2 -> Type) newtype Cayley f p a b = Cayley { runCayley :: f (p a b) } instance Functor f => ProfunctorFunctor (Cayley f) where@@ -49,9 +55,28 @@ first' = Cayley . fmap first' . runCayley second' = Cayley . fmap second' . runCayley +instance (Functor f, Costrong p) => Costrong (Cayley f p) where+ unfirst (Cayley fp) = Cayley (fmap unfirst fp)+ unsecond (Cayley fp) = Cayley (fmap unsecond fp)+ instance (Functor f, Choice p) => Choice (Cayley f p) where left' = Cayley . fmap left' . runCayley right' = Cayley . fmap right' . runCayley++instance (Functor f, Cochoice p) => Cochoice (Cayley f p) where+ unleft (Cayley fp) = Cayley (fmap unleft fp)+ {-# INLINE unleft #-}+ unright (Cayley fp) = Cayley (fmap unright fp)+ {-# INLINE unright #-}++instance (Functor f, Closed p) => Closed (Cayley f p) where+ closed = Cayley . fmap closed . runCayley++instance (Functor f, Traversing p) => Traversing (Cayley f p) where+ traverse' = Cayley . fmap traverse' . runCayley++instance (Functor f, Mapping p) => Mapping (Cayley f p) where+ map' = Cayley . fmap map' . runCayley instance (Applicative f, Category p) => Category (Cayley f p) where id = Cayley $ pure id
src/Data/Profunctor/Choice.hs view
@@ -1,8 +1,8 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2014-2015 Edward Kmett@@ -33,20 +33,16 @@ import Control.Comonad import Data.Bifunctor.Joker (Joker(..)) import Data.Bifunctor.Product (Product(..))+import Data.Bifunctor.Sum (Sum(..)) import Data.Bifunctor.Tannen (Tannen(..))-import Data.Monoid hiding (Product)+import Data.Monoid hiding (Product, Sum) import Data.Profunctor.Adjunction import Data.Profunctor.Monad import Data.Profunctor.Strong import Data.Profunctor.Types import Data.Profunctor.Unsafe import Data.Tagged-#if __GLASGOW_HASKELL__ < 710-import Data.Traversable-import Prelude hiding (id,(.),sequence)-#else import Prelude hiding (id,(.))-#endif ------------------------------------------------------------------------------ -- Choice@@ -73,8 +69,8 @@ -- assocE ('Right' c) = 'Right' ('Right' c) -- unassocE :: 'Either' a ('Either' b c) -> 'Either' ('Either' a b) c -- unassocE ('Left' a) = 'Left' ('Left' a)- -- unassocE ('Right' ('Left' b) = 'Left' ('Right' b)- -- unassocE ('Right' ('Right' c)) = 'Right' c)+ -- unassocE ('Right' ('Left' b)) = 'Left' ('Right' b)+ -- unassocE ('Right' ('Right' c)) = 'Right' c -- @ left' :: p a b -> p (Either a c) (Either b c) left' = dimap (either Right Left) (either Right Left) . right'@@ -94,8 +90,8 @@ -- assocE ('Right' c) = 'Right' ('Right' c) -- unassocE :: 'Either' a ('Either' b c) -> 'Either' ('Either' a b) c -- unassocE ('Left' a) = 'Left' ('Left' a)- -- unassocE ('Right' ('Left' b) = 'Left' ('Right' b)- -- unassocE ('Right' ('Right' c)) = 'Right' c)+ -- unassocE ('Right' ('Left' b)) = 'Left' ('Right' b)+ -- unassocE ('Right' ('Right' c)) = 'Right' c -- @ right' :: p a b -> p (Either c a) (Either c b) right' = dimap (either Right Left) (either Right Left) . left'@@ -128,13 +124,6 @@ right' = right {-# INLINE right' #-} --- NB: This instance is highly questionable-instance Traversable w => Choice (Costar w) where- left' (Costar wab) = Costar (either Right Left . fmap wab . traverse (either Right Left))- {-# INLINE left' #-}- right' (Costar wab) = Costar (fmap wab . sequence)- {-# INLINE right' #-}- instance Choice Tagged where left' (Tagged b) = Tagged (Left b) {-# INLINE left' #-}@@ -165,6 +154,14 @@ right' (Pair p q) = Pair (right' p) (right' q) {-# INLINE right' #-} +instance (Choice p, Choice q) => Choice (Sum p q) where+ left' (L2 p) = L2 (left' p)+ left' (R2 q) = R2 (left' q)+ {-# INLINE left' #-}+ right' (L2 p) = L2 (right' p)+ right' (R2 q) = R2 (right' q)+ {-# INLINE right' #-}+ instance (Functor f, Choice p) => Choice (Tannen f p) where left' (Tannen fp) = Tannen (fmap left' fp) {-# INLINE left' #-}@@ -195,7 +192,7 @@ promap f (TambaraSum p) = TambaraSum (f p) instance ProfunctorComonad TambaraSum where- proextract (TambaraSum p) = dimap Left (\(Left a) -> a) p+ proextract (TambaraSum p) = dimap Left fromEither p produplicate (TambaraSum p) = TambaraSum (TambaraSum $ dimap hither yon p) where hither :: Either (Either a b) c -> Either a (Either b c) hither (Left (Left x)) = Left x@@ -212,7 +209,7 @@ {-# INLINE dimap #-} instance Profunctor p => Choice (TambaraSum p) where- left' = runTambaraSum . produplicate+ left' p = runTambaraSum $ produplicate p {-# INLINE left' #-} instance Category p => Category (TambaraSum p) where@@ -236,8 +233,11 @@ -- 'untambaraSum' '.' 'tambaraSum' ≡ 'id' -- @ untambaraSum :: Profunctor q => (p :-> TambaraSum q) -> p :-> q-untambaraSum f p = dimap Left (\(Left a) -> a) $ runTambaraSum $ f p+untambaraSum f p = dimap Left fromEither $ runTambaraSum $ f p +fromEither :: Either a a -> a+fromEither = either id id+ ---------------------------------------------------------------------------- -- * PastroSum ----------------------------------------------------------------------------@@ -248,6 +248,9 @@ data PastroSum p a b where PastroSum :: (Either y z -> b) -> p x y -> (a -> Either x z) -> PastroSum p a b +instance Functor (PastroSum p a) where+ fmap f (PastroSum l m r) = PastroSum (f . l) m r+ instance Profunctor (PastroSum p) where dimap f g (PastroSum l m r) = PastroSum (g . l) m (r . f) lmap f (PastroSum l m r) = PastroSum l m (r . f)@@ -263,7 +266,7 @@ promap f (PastroSum l m r) = PastroSum l (f m) r instance ProfunctorMonad PastroSum where- proreturn p = PastroSum (\(Left a)-> a) p Left+ proreturn p = PastroSum fromEither p Left projoin (PastroSum l (PastroSum m n o) q) = PastroSum lm n oq where oq a = case q a of Left b -> Left <$> o b@@ -304,8 +307,8 @@ -- assocE ('Right' c) = 'Right' ('Right' c) -- unassocE :: 'Either' a ('Either' b c) -> 'Either' ('Either' a b) c -- unassocE ('Left' a) = 'Left' ('Left' a)- -- unassocE ('Right' ('Left' b) = 'Left' ('Right' b)- -- unassocE ('Right' ('Right' c)) = 'Right' c)+ -- unassocE ('Right' ('Left' b)) = 'Left' ('Right' b)+ -- unassocE ('Right' ('Right' c)) = 'Right' c -- @ unleft :: p (Either a d) (Either b d) -> p a b unleft = unright . dimap (either Right Left) (either Right Left)@@ -325,8 +328,8 @@ -- assocE ('Right' c) = 'Right' ('Right' c) -- unassocE :: 'Either' a ('Either' b c) -> 'Either' ('Either' a b) c -- unassocE ('Left' a) = 'Left' ('Left' a)- -- unassocE ('Right' ('Left' b) = 'Left' ('Right' b)- -- unassocE ('Right' ('Right' c)) = 'Right' c)+ -- unassocE ('Right' ('Left' b)) = 'Left' ('Right' b)+ -- unassocE ('Right' ('Right' c)) = 'Right' c -- @ unright :: p (Either d a) (Either d b) -> p a b unright = unleft . dimap (either Right Left) (either Right Left)@@ -356,6 +359,16 @@ unleft (Pair p q) = Pair (unleft p) (unleft q) unright (Pair p q) = Pair (unright p) (unright q) +instance (Cochoice p, Cochoice q) => Cochoice (Sum p q) where+ unleft (L2 p) = L2 (unleft p)+ unleft (R2 q) = R2 (unleft q)+ unright (L2 p) = L2 (unright p)+ unright (R2 q) = R2 (unright q)++instance Cochoice (Forget r) where+ unleft (Forget f) = Forget (f . Left)+ unright (Forget f) = Forget (f . Right)+ ---------------------------------------------------------------------------- -- * CotambaraSum ----------------------------------------------------------------------------@@ -389,7 +402,7 @@ -- 'uncotambaraSum' '.' 'cotambaraSum' ≡ 'id' -- @ cotambaraSum :: Cochoice p => (p :-> q) -> p :-> CotambaraSum q-cotambaraSum = CotambaraSum+cotambaraSum f = CotambaraSum f -- | -- @@@ -407,6 +420,9 @@ -- -- 'CopastroSum' freely constructs costrength with respect to 'Either' (aka 'Choice') newtype CopastroSum p a b = CopastroSum { runCopastroSum :: forall r. Cochoice r => (forall x y. p x y -> r x y) -> r a b }++instance Functor (CopastroSum p a) where+ fmap f (CopastroSum h) = CopastroSum $ \ n -> rmap f (h n) instance Profunctor (CopastroSum p) where dimap f g (CopastroSum h) = CopastroSum $ \ n -> dimap f g (h n)
src/Data/Profunctor/Closed.hs view
@@ -30,6 +30,7 @@ import Control.Category import Control.Comonad import Data.Bifunctor.Product (Product(..))+import Data.Bifunctor.Sum (Sum(..)) import Data.Bifunctor.Tannen (Tannen(..)) import Data.Coerce (Coercible, coerce) import Data.Distributive@@ -38,7 +39,7 @@ import Data.Profunctor.Strong import Data.Profunctor.Types import Data.Profunctor.Unsafe-import Data.Semigroup hiding (Product)+import Data.Semigroup hiding (Product, Sum) import Data.Tagged import Data.Tuple import Prelude hiding ((.),id)@@ -67,10 +68,10 @@ closed = (.) instance Functor f => Closed (Costar f) where- closed (Costar fab) = Costar $ \fxa x -> fab (fmap ($x) fxa)+ closed (Costar fab) = Costar $ \fxa x -> fab (fmap ($ x) fxa) instance Functor f => Closed (Cokleisli f) where- closed (Cokleisli fab) = Cokleisli $ \fxa x -> fab (fmap ($x) fxa)+ closed (Cokleisli fab) = Cokleisli $ \fxa x -> fab (fmap ($ x) fxa) instance Distributive f => Closed (Star f) where closed (Star afb) = Star $ \xa -> distribute $ \x -> afb (xa x)@@ -81,6 +82,10 @@ instance (Closed p, Closed q) => Closed (Product p q) where closed (Pair p q) = Pair (closed p) (closed q) +instance (Closed p, Closed q) => Closed (Sum p q) where+ closed (L2 p) = L2 (closed p)+ closed (R2 q) = R2 (closed q)+ instance (Functor f, Closed p) => Closed (Tannen f p) where closed (Tannen fp) = Tannen (fmap closed fp) @@ -115,11 +120,11 @@ promap f (Closure p) = Closure (f p) instance ProfunctorComonad Closure where- proextract = dimap const ($ ()) . runClosure+ proextract p = dimap const ($ ()) $ runClosure p produplicate (Closure p) = Closure $ Closure $ dimap uncurry curry p instance Profunctor p => Closed (Closure p) where- closed = runClosure . produplicate+ closed p = runClosure $ produplicate p instance Strong p => Strong (Closure p) where first' (Closure p) = Closure $ dimap hither yon $ first' p@@ -189,6 +194,9 @@ data Environment p a b where Environment :: ((z -> y) -> b) -> p x y -> (a -> z -> x) -> Environment p a b++instance Functor (Environment p a) where+ fmap f (Environment l m r) = Environment (f . l) m r instance Profunctor (Environment p) where dimap f g (Environment l m r) = Environment (g . l) m (r . f)
src/Data/Profunctor/Composition.hs view
@@ -1,9 +1,11 @@ {-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Profunctor.Composition@@ -60,6 +62,10 @@ -- see Dan Piponi's article: -- -- <http://blog.sigfpe.com/2011/07/profunctors-in-haskell.html>+--+-- 'Procompose' has a polymorphic kind since @5.6@.++-- Procompose :: (k1 -> k2 -> Type) -> (k3 -> k1 -> Type) -> (k3 -> k2 -> Type) data Procompose p q d c where Procompose :: p x c -> q d x -> Procompose p q d c @@ -237,7 +243,15 @@ -- * Rift ---------------------------------------------------------------------------- --- | This represents the right Kan lift of a 'Profunctor' @q@ along a 'Profunctor' @p@ in a limited version of the 2-category of Profunctors where the only object is the category Hask, 1-morphisms are profunctors composed and compose with Profunctor composition, and 2-morphisms are just natural transformations.+-- | This represents the right Kan lift of a 'Profunctor' @q@ along a+-- 'Profunctor' @p@ in a limited version of the 2-category of Profunctors where+-- the only object is the category Hask, 1-morphisms are profunctors composed+-- and compose with Profunctor composition, and 2-morphisms are just natural+-- transformations.+--+-- 'Rift' has a polymorphic kind since @5.6@.++-- Rift :: (k3 -> k2 -> Type) -> (k1 -> k2 -> Type) -> (k1 -> k3 -> Type) newtype Rift p q a b = Rift { runRift :: forall x. p b x -> q a x } instance ProfunctorFunctor (Rift p) where
src/Data/Profunctor/Mapping.hs view
@@ -1,6 +1,7 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2015-2018 Edward Kmett@@ -15,12 +16,15 @@ ( Mapping(..) , CofreeMapping(..) , FreeMapping(..)+ -- * Traversing in terms of Mapping+ , wanderMapping -- * Closed in terms of Mapping , traverseMapping , closedMapping ) where import Control.Arrow (Kleisli(..))+import Data.Bifunctor.Tannen import Data.Distributive import Data.Functor.Compose import Data.Functor.Identity@@ -31,9 +35,6 @@ import Data.Profunctor.Traversing import Data.Profunctor.Types import Data.Profunctor.Unsafe-#if __GLASGOW_HASKELL__ < 710-import Control.Applicative-#endif class (Traversing p, Closed p) => Mapping p where -- | Laws:@@ -44,17 +45,41 @@ -- 'dimap' 'Data.Functor.Identity.Identity' 'Data.Functor.Identity.runIdentity' '.' 'map'' ≡ 'id' -- @ map' :: Functor f => p a b -> p (f a) (f b)+ map' = roam fmap + roam :: ((a -> b) -> s -> t)+ -> p a b -> p s t+ roam f = dimap (\s -> Bar $ \ab -> f ab s) lent . map'++newtype Bar t b a = Bar+ { runBar :: (a -> b) -> t }+ deriving Functor++lent :: Bar t a a -> t+lent m = runBar m id+ instance Mapping (->) where map' = fmap+ roam f = f instance (Monad m, Distributive m) => Mapping (Kleisli m) where map' (Kleisli f) = Kleisli (collect f)+ roam f = Kleisli #. genMap f .# runKleisli +genMap :: Distributive f => ((a -> b) -> s -> t) -> (a -> f b) -> s -> f t+genMap abst afb s = fmap (\ab -> abst ab s) (distribute afb)+ -- see <https://github.com/ekmett/distributive/issues/12> instance (Applicative m, Distributive m) => Mapping (Star m) where map' (Star f) = Star (collect f)+ roam f = Star #. genMap f .# runStar +instance (Functor f, Mapping p) => Mapping (Tannen f p) where+ map' = Tannen . fmap map' . runTannen++wanderMapping :: Mapping p => (forall f. Applicative f => (a -> f b) -> s -> f t) -> p a b -> p s t+wanderMapping f = roam ((runIdentity .) #. f .# (Identity .))+ traverseMapping :: (Mapping p, Functor f) => p a b -> p (f a) (f b) traverseMapping = map' @@ -79,10 +104,14 @@ instance Profunctor p => Traversing (CofreeMapping p) where traverse' = map'+ wander f = roam $ (runIdentity .) #. f .# (Identity .) instance Profunctor p => Mapping (CofreeMapping p) where -- !@(#*&() Compose isn't representational in its second arg or we could use #. and .# map' (CofreeMapping p) = CofreeMapping (dimap Compose getCompose p)+ roam f (CofreeMapping p) =+ CofreeMapping $+ dimap (Compose #. fmap (\s -> Bar $ \ab -> f ab s)) (fmap lent .# getCompose) p instance ProfunctorFunctor CofreeMapping where promap f (CofreeMapping p) = CofreeMapping (f p)@@ -95,6 +124,9 @@ data FreeMapping p a b where FreeMapping :: Functor f => (f y -> b) -> p x y -> (a -> f x) -> FreeMapping p a b +instance Functor (FreeMapping p a) where+ fmap f (FreeMapping l m r) = FreeMapping (f . l) m r+ instance Profunctor (FreeMapping p) where lmap f (FreeMapping l m r) = FreeMapping l m (r . f) rmap g (FreeMapping l m r) = FreeMapping (g . l) m r@@ -113,6 +145,7 @@ instance Traversing (FreeMapping p) where traverse' = map'+ wander f = roam ((runIdentity .) #. f .# (Identity .)) instance Mapping (FreeMapping p) where map' (FreeMapping l m r) = FreeMapping (fmap l .# getCompose) m (Compose #. fmap r)
src/Data/Profunctor/Monad.hs view
@@ -1,6 +1,7 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2014-2015 Edward Kmett@@ -19,6 +20,9 @@ import Data.Bifunctor.Sum import Data.Profunctor.Types +-- | 'ProfunctorFunctor' has a polymorphic kind since @5.6@.++-- ProfunctorFunctor :: ((Type -> Type -> Type) -> (k1 -> k2 -> Type)) -> Constraint class ProfunctorFunctor t where -- | Laws: --@@ -26,7 +30,7 @@ -- 'promap' f '.' 'promap' g ≡ 'promap' (f '.' g) -- 'promap' 'id' ≡ 'id' -- @- promap :: Profunctor p => (p :-> q) -> t p :-> t q+ promap :: Profunctor p => (p :-> q) -> t p :-> t q instance Functor f => ProfunctorFunctor (Tannen f) where promap f (Tannen g) = Tannen (fmap f g)@@ -46,15 +50,13 @@ -- 'projoin' '.' 'promap' 'proreturn' ≡ 'id' -- 'projoin' '.' 'projoin' ≡ 'projoin' '.' 'promap' 'projoin' -- @++-- ProfunctorMonad :: ((Type -> Type -> Type) -> (Type -> Type -> Type)) -> Constraint class ProfunctorFunctor t => ProfunctorMonad t where proreturn :: Profunctor p => p :-> t p projoin :: Profunctor p => t (t p) :-> t p -#if __GLASGOW_HASKELL__ < 710-instance (Functor f, Monad f) => ProfunctorMonad (Tannen f) where-#else instance Monad f => ProfunctorMonad (Tannen f) where-#endif proreturn = Tannen . return projoin (Tannen m) = Tannen $ m >>= runTannen @@ -71,6 +73,8 @@ -- 'promap' 'proextract' '.' 'produplicate' ≡ 'id' -- 'produplicate' '.' 'produplicate' ≡ 'promap' 'produplicate' '.' 'produplicate' -- @++-- ProfunctorComonad :: ((Type -> Type -> Type) -> (Type -> Type -> Type)) -> Constraint class ProfunctorFunctor t => ProfunctorComonad t where proextract :: Profunctor p => t p :-> p produplicate :: Profunctor p => t p :-> t (t p)
src/Data/Profunctor/Ran.hs view
@@ -1,6 +1,8 @@+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Copyright : (C) 2013-2015 Edward Kmett and Dan Doel@@ -32,7 +34,15 @@ -- * Ran -------------------------------------------------------------------------------- --- | This represents the right Kan extension of a 'Profunctor' @q@ along a 'Profunctor' @p@ in a limited version of the 2-category of Profunctors where the only object is the category Hask, 1-morphisms are profunctors composed and compose with Profunctor composition, and 2-morphisms are just natural transformations.+-- | This represents the right Kan extension of a 'Profunctor' @q@ along a+-- 'Profunctor' @p@ in a limited version of the 2-category of Profunctors where+-- the only object is the category Hask, 1-morphisms are profunctors composed+-- and compose with Profunctor composition, and 2-morphisms are just natural+-- transformations.+--+-- 'Ran' has a polymorphic kind since @5.6@.++-- Ran :: (k1 -> k2 -> Type) -> (k1 -> k3 -> Type) -> (k2 -> k3 -> Type) newtype Ran p q a b = Ran { runRan :: forall x. p x a -> q x b } instance ProfunctorFunctor (Ran p) where@@ -88,7 +98,13 @@ -- * Codensity -------------------------------------------------------------------------------- --- | This represents the right Kan extension of a 'Profunctor' @p@ along itself. This provides a generalization of the \"difference list\" trick to profunctors.+-- | This represents the right Kan extension of a 'Profunctor' @p@ along+-- itself. This provides a generalization of the \"difference list\" trick to+-- profunctors.+--+-- 'Codensity' has a polymorphic kind since @5.6@.++-- Codensity :: (k1 -> k2 -> Type) -> (k2 -> k2 -> Type) newtype Codensity p a b = Codensity { runCodensity :: forall x. p x a -> p x b } instance Profunctor p => Profunctor (Codensity p) where
src/Data/Profunctor/Rep.hs view
@@ -1,11 +1,13 @@-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE CPP #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Profunctor.Rep@@ -139,7 +141,7 @@ -- | Default definition for 'closed' given that @p@ is 'Corepresentable' closedCorep :: Corepresentable p => p a b -> p (x -> a) (x -> b)-closedCorep p = cotabulate $ \fs x -> cosieve p (fmap ($x) fs)+closedCorep p = cotabulate $ \fs x -> cosieve p (fmap ($ x) fs) instance Corepresentable (->) where type Corep (->) = Identity@@ -178,6 +180,10 @@ -- -- This gives rise to a monad in @Prof@, @('Star'.'Prep')@, and -- a comonad in @[Hask,Hask]@ @('Prep'.'Star')@+--+-- 'Prep' has a polymorphic kind since @5.6@.++-- Prep :: (Type -> k -> Type) -> (k -> Type) data Prep p a where Prep :: x -> p x a -> Prep p a @@ -190,7 +196,9 @@ go (xf',xa') = sieve pf xf' <*> sieve pa xa' instance (Monad (Rep p), Representable p) => Monad (Prep p) where+#if !(MIN_VERSION_base(4,11,0)) return a = Prep () $ tabulate $ const $ return a+#endif Prep xa pa >>= f = Prep xa $ tabulate $ sieve pa >=> \a -> case f a of Prep xb pb -> sieve pb xb @@ -210,6 +218,9 @@ -- * Coprep -------------------------------------------------------------------------------- +-- | 'Prep' has a polymorphic kind since @5.6@.++-- Coprep :: (k -> Type -> Type) -> (k -> Type) newtype Coprep p a = Coprep { runCoprep :: forall r. p a r -> r } instance Profunctor p => Functor (Coprep p) where
src/Data/Profunctor/Sieve.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE Trustworthy #-} -----------------------------------------------------------------------------
src/Data/Profunctor/Strong.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- |@@ -19,6 +20,7 @@ -- * Strength Strong(..) , uncurry'+ , strong , Tambara(..) , tambara, untambara , Pastro(..)@@ -38,13 +40,14 @@ import Control.Monad.Fix import Data.Bifunctor.Clown (Clown(..)) import Data.Bifunctor.Product (Product(..))+import Data.Bifunctor.Sum (Sum(..)) import Data.Bifunctor.Tannen (Tannen(..)) import Data.Functor.Contravariant (Contravariant(..)) import Data.Profunctor.Adjunction import Data.Profunctor.Monad import Data.Profunctor.Types import Data.Profunctor.Unsafe-import Data.Semigroup hiding (Product)+import Data.Semigroup hiding (Product, Sum) import Data.Tagged import Data.Tuple import Prelude hiding (id,(.))@@ -60,7 +63,7 @@ -- This describes profunctor strength with respect to the product structure -- of Hask. ----- <http://www-kb.is.s.u-tokyo.ac.jp/~asada/papers/arrStrMnd.pdf>+-- <http://www.riec.tohoku.ac.jp/~asada/papers/arrStrMnd.pdf> -- class Profunctor p => Strong p where -- | Laws:@@ -68,7 +71,7 @@ -- @ -- 'first'' ≡ 'dimap' 'swap' 'swap' '.' 'second'' -- 'lmap' 'fst' ≡ 'rmap' 'fst' '.' 'first''- -- 'lmap' ('second' f) '.' 'first'' ≡ 'rmap' ('second' f) '.' 'first'+ -- 'lmap' ('second'' f) '.' 'first'' ≡ 'rmap' ('second'' f) '.' 'first'' -- 'first'' '.' 'first'' ≡ 'dimap' assoc unassoc '.' 'first'' where -- assoc ((a,b),c) = (a,(b,c)) -- unassoc (a,(b,c)) = ((a,b),c)@@ -81,7 +84,7 @@ -- @ -- 'second'' ≡ 'dimap' 'swap' 'swap' '.' 'first'' -- 'lmap' 'snd' ≡ 'rmap' 'snd' '.' 'second''- -- 'lmap' ('first' f) '.' 'second'' ≡ 'rmap' ('first' f) '.' 'second''+ -- 'lmap' ('first'' f) '.' 'second'' ≡ 'rmap' ('first'' f) '.' 'second'' -- 'second'' '.' 'second'' ≡ 'dimap' unassoc assoc '.' 'second'' where -- assoc ((a,b),c) = (a,(b,c)) -- unassoc (a,(b,c)) = ((a,b),c)@@ -95,6 +98,9 @@ uncurry' = rmap (\(f,x) -> f x) . first' {-# INLINE uncurry' #-} +strong :: Strong p => (a -> b -> c) -> p a b -> p a c+strong f x = dimap (\a -> (a, a)) (\(b, a) -> f a b) (first' x)+ instance Strong (->) where first' ab ~(a, c) = (ab a, c) {-# INLINE first' #-}@@ -142,6 +148,14 @@ second' (Pair p q) = Pair (second' p) (second' q) {-# INLINE second' #-} +instance (Strong p, Strong q) => Strong (Sum p q) where+ first' (L2 p) = L2 (first' p)+ first' (R2 q) = R2 (first' q)+ {-# INLINE first' #-}+ second' (L2 p) = L2 (second' p)+ second' (R2 q) = R2 (second' q)+ {-# INLINE second' #-}+ instance (Functor f, Strong p) => Strong (Tannen f p) where first' (Tannen fp) = Tannen (fmap first' fp) {-# INLINE first' #-}@@ -172,7 +186,7 @@ yon ~(x,~(y,z)) = ((x,y),z) instance Profunctor p => Strong (Tambara p) where- first' = runTambara . produplicate+ first' p = runTambara $ produplicate p {-# INLINE first' #-} instance Category p => Category (Tambara p) where@@ -259,6 +273,9 @@ data Pastro p a b where Pastro :: ((y, z) -> b) -> p x y -> (a -> (x, z)) -> Pastro p a b +instance Functor (Pastro p a) where+ fmap f (Pastro l m r) = Pastro (f . l) m r+ instance Profunctor (Pastro p) where dimap f g (Pastro l m r) = Pastro (g . l) m (r . f) lmap f (Pastro l m r) = Pastro l m (r . f)@@ -374,6 +391,12 @@ unfirst (Pair p q) = Pair (unfirst p) (unfirst q) unsecond (Pair p q) = Pair (unsecond p) (unsecond q) +instance (Costrong p, Costrong q) => Costrong (Sum p q) where+ unfirst (L2 p) = L2 (unfirst p)+ unfirst (R2 q) = R2 (unfirst q)+ unsecond (L2 p) = L2 (unsecond p)+ unsecond (R2 q) = R2 (unsecond q)+ ---------------------------------------------------------------------------- -- * Cotambara ----------------------------------------------------------------------------@@ -406,7 +429,7 @@ -- 'uncotambara' '.' 'cotambara' ≡ 'id' -- @ cotambara :: Costrong p => (p :-> q) -> p :-> Cotambara q-cotambara = Cotambara+cotambara f = Cotambara f -- | -- @@@ -424,6 +447,9 @@ -- -- Copastro freely constructs costrength newtype Copastro p a b = Copastro { runCopastro :: forall r. Costrong r => (forall x y. p x y -> r x y) -> r a b }++instance Functor (Copastro p a) where+ fmap f (Copastro h) = Copastro $ \ n -> rmap f (h n) instance Profunctor (Copastro p) where dimap f g (Copastro h) = Copastro $ \ n -> dimap f g (h n)
src/Data/Profunctor/Traversing.hs view
@@ -1,7 +1,7 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE Safe #-} module Data.Profunctor.Traversing ( Traversing(..) , CofreeTraversing(..)@@ -20,6 +20,7 @@ import Control.Applicative import Control.Arrow (Kleisli(..))+import Data.Bifunctor.Tannen import Data.Functor.Compose import Data.Functor.Identity import Data.Orphans ()@@ -31,12 +32,6 @@ import Data.Traversable import Data.Tuple (swap) -#if __GLASGOW_HASKELL__ < 710-import Data.Monoid (Monoid)-import Data.Foldable-import Prelude hiding (mapM)-#endif- firstTraversing :: Traversing p => p a b -> p (a, c) (b, c) firstTraversing = dimap swap swap . traverse' @@ -136,6 +131,9 @@ traverse' (Star m) = Star (traverse m) wander f (Star amb) = Star (f amb) +instance (Functor f, Traversing p) => Traversing (Tannen f p) where+ traverse' = Tannen . fmap traverse' . runTannen+ newtype CofreeTraversing p a b = CofreeTraversing { runCofreeTraversing :: forall f. Traversable f => p (f a) (f b) } instance Profunctor p => Profunctor (CofreeTraversing p) where@@ -163,6 +161,9 @@ -- | @FreeTraversing -| CofreeTraversing@ data FreeTraversing p a b where FreeTraversing :: Traversable f => (f y -> b) -> p x y -> (a -> f x) -> FreeTraversing p a b++instance Functor (FreeTraversing p a) where+ fmap f (FreeTraversing l m r) = FreeTraversing (f . l) m r instance Profunctor (FreeTraversing p) where lmap f (FreeTraversing l m r) = FreeTraversing l m (r . f)
src/Data/Profunctor/Types.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE Trustworthy #-} @@ -39,12 +40,20 @@ import Data.Coerce (Coercible, coerce) import Data.Distributive import Data.Foldable-import Data.Monoid hiding (Product)+import Data.Functor.Contravariant import Data.Profunctor.Unsafe import Data.Traversable import Prelude hiding (id,(.)) +#if !(MIN_VERSION_base(4,11,0))+import Data.Semigroup (Semigroup(..))+#endif+ infixr 0 :->++-- | (':->') has a polymorphic kind since @5.6@.++-- (:->) :: forall k1 k2. (k1 -> k2 -> Type) -> (k1 -> k2 -> Type) -> Type type p :-> q = forall a b. p a b -> q a b ------------------------------------------------------------------------------@@ -52,6 +61,10 @@ ------------------------------------------------------------------------------ -- | Lift a 'Functor' into a 'Profunctor' (forwards).+--+-- 'Star' has a polymorphic kind since @5.6@.++-- Star :: (k -> Type) -> (Type -> k -> Type) newtype Star f d c = Star { runStar :: d -> f c } instance Functor f => Profunctor (Star f) where@@ -80,9 +93,6 @@ Star f <|> Star g = Star $ \a -> f a <|> g a instance Monad f => Monad (Star f a) where-#if __GLASGOW_HASKELL__ < 710- return a = Star $ \_ -> return a-#endif Star m >>= f = Star $ \ e -> do a <- m e runStar (f a) e@@ -98,11 +108,19 @@ id = Star return Star f . Star g = Star $ g >=> f +instance Contravariant f => Contravariant (Star f a) where+ contramap f (Star g) = Star (contramap f . g)+ {-# INLINE contramap #-}+ ------------------------------------------------------------------------------ -- Costar ------------------------------------------------------------------------------ -- | Lift a 'Functor' into a 'Profunctor' (backwards).+--+-- 'Costar' has a polymorphic kind since @5.6@.++-- Costar :: (k -> Type) -> k -> Type -> Type newtype Costar f d c = Costar { runCostar :: f d -> c } instance Functor f => Profunctor (Costar f) where@@ -140,6 +158,10 @@ ------------------------------------------------------------------------------ -- | Wrap an arrow for use as a 'Profunctor'.+--+-- 'WrappedArrow' has a polymorphic kind since @5.6@.++-- WrappedArrow :: (k1 -> k2 -> Type) -> (k1 -> k2 -> Type) newtype WrappedArrow p a b = WrapArrow { unwrapArrow :: p a b } instance Category p => Category (WrappedArrow p) where@@ -193,6 +215,9 @@ -- Forget ------------------------------------------------------------------------------ +-- | 'Forget' has a polymorphic kind since @5.6@.++-- Forget :: Type -> Type -> k -> Type newtype Forget r a b = Forget { runForget :: a -> r } instance Profunctor (Forget r) where@@ -214,3 +239,25 @@ instance Traversable (Forget r a) where traverse _ (Forget k) = pure (Forget k) {-# INLINE traverse #-}++instance Contravariant (Forget r a) where+ contramap _ (Forget k) = Forget k+ {-# INLINE contramap #-}++-- | Via @Semigroup r => (a -> r)@+--+-- @since 5.6.2+instance Semigroup r => Semigroup (Forget r a b) where+ Forget f <> Forget g = Forget (f <> g)+ {-# INLINE (<>) #-}++-- | Via @Monoid r => (a -> r)@+--+-- @since 5.6.2+instance Monoid r => Monoid (Forget r a b) where+ mempty = Forget mempty+ {-# INLINE mempty #-}+#if !(MIN_VERSION_base(4,11,0))+ mappend (Forget f) (Forget g) = Forget (mappend f g)+ {-# INLINE mappend #-}+#endif
src/Data/Profunctor/Unsafe.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE ScopedTypeVariables #-} -----------------------------------------------------------------------------@@ -41,9 +40,6 @@ import Data.Bifunctor.Sum (Sum(..)) import Data.Bifunctor.Tannen (Tannen(..)) import Data.Coerce (Coercible, coerce)-#if __GLASGOW_HASKELL__ < 710-import Data.Functor-#endif import Data.Functor.Contravariant (Contravariant(..)) import Data.Tagged import Prelude hiding (id,(.))
src/Data/Profunctor/Yoneda.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-} {-# LANGUAGE Trustworthy #-} ----------------------------------------------------------------------------- -- |@@ -155,6 +154,9 @@ -- @ joinCoyoneda :: Coyoneda (Coyoneda p) a b -> Coyoneda p a b joinCoyoneda (Coyoneda l r p) = dimap l r p++instance Functor (Coyoneda p a) where+ fmap f (Coyoneda l r' p) = Coyoneda l (f . r') p instance Profunctor (Coyoneda p) where dimap l r (Coyoneda l' r' p) = Coyoneda (l' . l) (r . r') p