packages feed

profunctors 5.2.2 → 5.6.3

raw patch · 22 files changed

Files

+ .hlint.yaml view
@@ -0,0 +1,71 @@+- arguments: [-XCPP]++- extensions:+  - default: false # all extension are banned by default+  - name:+    - CPP+    - DeriveFunctor+    - FlexibleContexts+    - FlexibleInstances+    - FunctionalDependencies+    - GADTs+    - InstanceSigs+    - MultiParamTypeClasses+    - PolyKinds+    - RankNTypes+    - Safe+    - ScopedTypeVariables+    - Trustworthy+    - TypeFamilies+    - TypeOperators+    - UndecidableInstances++- functions:+  - {name: unsafeCoerce, within: []} # banned++- ignore:+    name: Use const+    within:+    - Data.Profunctor.Types++- ignore:+    name: Avoid lambda+    within:+    - Data.Profunctor.Choice+    - Data.Profunctor.Traversing++- ignore:+    name: Use fmap+    within:+    - Data.Profunctor.Composition+    - Data.Profunctor.Strong+    - Data.Profunctor.Unsafe++- ignore:+    name: Avoid lambda+    within: Data.Profunctor.Strong++- ignore:+    name: Redundant lambda+    within: Data.Profunctor.Unsafe++- 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 .#"+- fixity: "infixr 0 :->"
− .travis.yml 
@@ -1,155 +0,0 @@-# This Travis job script has been generated by a script via-#-#   runghc make_travis_yml_2.hs '-o' '.travis.yml' '--irc-channel=irc.freenode.org#haskell-lens' '--no-no-tests-no-bench' '--no-installed' '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--addons:-  apt:-    packages: &apt_packages-      - ghc-ppa-tools-      - hlint--matrix:-  include:-    - compiler: "ghc-7.0.4"-    # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.0.4], sources: [hvr-ghc]}}-    - compiler: "ghc-7.2.2"-    # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.2.2], sources: [hvr-ghc]}}-    - compiler: "ghc-7.4.2"-    # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.4.2], sources: [hvr-ghc]}}-    - compiler: "ghc-7.6.3"-    # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.6.3], sources: [hvr-ghc]}}-    - compiler: "ghc-7.8.4"-    # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.8.4], sources: [hvr-ghc]}}-    - compiler: "ghc-7.10.3"-    # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-7.10.3], sources: [hvr-ghc]}}-    - compiler: "ghc-8.0.2"-    # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-8.0.2], sources: [hvr-ghc]}}-    - compiler: "ghc-8.2.2"-    # env: TEST=--disable-tests BENCH=--disable-benchmarks-      addons: {apt: {packages: [*apt_packages,cabal-install-2.0,ghc-8.2.2], sources: [hvr-ghc]}}-    - compiler: "ghc-8.4.1"-      env: GHCHEAD=true-      addons: {apt: {packages: [*apt_packages,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}-    - compiler: "ghc-head"-      env: GHCHEAD=true-      addons: {apt: {packages: [*apt_packages,cabal-install-head,ghc-head], sources: [hvr-ghc]}}--  allow_failures:-    - compiler: "ghc-7.0.4"-    - compiler: "ghc-7.2.2"-    - compiler: "ghc-8.4.1"-    - compiler: "ghc-head"--before_install:-  - HC=${CC}-  - HCPKG=${HC/ghc/ghc-pkg}-  - unset CC-  - ROOTDIR=$(pwd)-  - mkdir -p $HOME/.local/bin-  - "PATH=/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}-  - INSTALLED=${INSTALLED-true}-  - 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.bak 's/-- allow-newer:.*/allow-newer: *:base, *:template-haskell, *:ghc, *:Cabal/' ${HOME}/.cabal/config--      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--      cabal new-update head.hackage -v-    fi-  - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'-  - "printf 'packages: \".\"\\n' > cabal.project"-  - cat cabal.project-  - 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"-  - cat cabal.project---  # 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-  - (cd profunctors-* && hlint src --cpp-define=HLINT)--# REGENDATA ["-o",".travis.yml","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-installed","cabal.project"]-# EOF
CHANGELOG.markdown view
@@ -1,3 +1,67 @@+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:++  ```haskell+  (#.) :: (Profunctor p, Coercible c b) => (b -> c) -> p a b    -> p a c+  (.#) :: (Profunctor p, Coercible b a) => p b c    -> (a -> b) -> p a c+  ```++  Now, they are:++  ```haskell+  (#.) :: (Profunctor p, Coercible c b) => q b c    -> p a b    -> p a c+  (.#) :: (Profunctor p, Coercible b a) => p b c    -> q a b    -> p a c+  ```+* Drop support for GHC < 7.8.+* Add a `Profunctor` instance for `Data.Bifunctor.Sum`.+ 5.2.2 [2018.01.18] ------------------ * Add `Semigroup` instances for `Closure` and `Tambara`
− HLint.hs 
@@ -1,1 +0,0 @@-ignore "use const"
README.markdown view
@@ -1,7 +1,7 @@ Profunctors =========== -[![Hackage](https://img.shields.io/hackage/v/profunctors.svg)](https://hackage.haskell.org/package/profunctors) [![Build Status](https://secure.travis-ci.org/ekmett/profunctors.png?branch=master)](http://travis-ci.org/ekmett/profunctors)+[![Hackage](https://img.shields.io/hackage/v/profunctors.svg)](https://hackage.haskell.org/package/profunctors) [![Build Status](https://github.com/ekmett/profunctors/workflows/Haskell-CI/badge.svg)](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.2.2+version:       5.6.3 license:       BSD3 cabal-version: >= 1.10 license-file:  LICENSE@@ -12,33 +12,42 @@ copyright:     Copyright (C) 2011-2015 Edward A. Kmett synopsis:      Profunctors description:   Profunctors.-tested-with:   GHC == 7.0.4, GHC == 7.2.2, GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.1+tested-with:   GHC == 8.0.2+             , GHC == 8.2.2+             , 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-  .travis.yml+  .hlint.yaml   .vim.custom   README.markdown   CHANGELOG.markdown-  HLint.hs  source-repository head   type: git-  location: git://github.com/ekmett/profunctors.git+  location: https://github.com/ekmett/profunctors.git  library   build-depends:-    base                >= 4     && < 5,-    base-orphans        >= 0.4   && < 0.7,-    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@@ -57,7 +66,16 @@     Data.Profunctor.Unsafe     Data.Profunctor.Yoneda -  ghc-options:     -Wall -O2+  ghc-options:     -Wall -O2 -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    default-language: Haskell2010@@ -66,5 +84,6 @@     GADTs     FlexibleContexts     FlexibleInstances+    InstanceSigs     UndecidableInstances     TypeFamilies
src/Data/Profunctor.hs view
@@ -1,10 +1,4 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 708-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2011-2015 Edward Kmett,@@ -42,9 +36,7 @@   , Costar(..)   , WrappedArrow(..)   , Forget(..)-#ifndef HLINT   , (:->)-#endif   ) where  import Data.Profunctor.Choice
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,8 +1,6 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-}-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708 {-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2014-2015 Edward Kmett@@ -22,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@@ -52,10 +55,29 @@   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   Cayley fpbc . Cayley fpab = Cayley $ liftA2 (.) fpbc fpab@@ -72,7 +94,7 @@   right = Cayley . fmap right . runCayley   Cayley ab +++ Cayley cd = Cayley $ liftA2 (+++) ab cd   Cayley ac ||| Cayley bc = Cayley $ liftA2 (|||) ac bc-  + instance (Applicative f, ArrowLoop p) => ArrowLoop (Cayley f p) where   loop = Cayley . fmap loop . runCayley @@ -86,7 +108,7 @@ mapCayley f (Cayley g) = Cayley (f g)  -- instance Adjunction f g => ProfunctorAdjunction (Cayley f) (Cayley g) where-  + {- newtype Uncayley p a = Uncayley (p () a) @@ -107,7 +129,7 @@ -- only a true iso for Stronger p and q, no? _Smash :: (Strong p, Closed q) => Iso   (Cayley (Uncayley p) (->) a b)-  (Cayley (Uncayley q) (->) c d) +  (Cayley (Uncayley q) (->) c d)   (p a b)   (q c d) _Smash = dimap hither (fmap yon) where
src/Data/Profunctor/Choice.hs view
@@ -1,11 +1,8 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE MultiParamTypeClasses #-}-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2014-2015 Edward Kmett@@ -36,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@@ -76,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'@@ -97,15 +90,13 @@   --   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' -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708   {-# MINIMAL left' | right' #-}-#endif  instance Choice (->) where   left' ab (Left a) = Left (ab a)@@ -133,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' #-}@@ -170,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' #-}@@ -200,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@@ -217,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@@ -241,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 ----------------------------------------------------------------------------@@ -253,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)@@ -268,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@@ -309,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)@@ -330,15 +328,13 @@   --   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) -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708   {-# MINIMAL unleft | unright #-}-#endif  instance Cochoice (->) where   unleft f = go . Left where go = either id (go . Right) . f@@ -363,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 ----------------------------------------------------------------------------@@ -396,7 +402,7 @@ -- 'uncotambaraSum' '.' 'cotambaraSum' ≡ 'id' -- @ cotambaraSum :: Cochoice p => (p :-> q) -> p :-> CotambaraSum q-cotambaraSum = CotambaraSum+cotambaraSum f = CotambaraSum f  -- | -- @@@ -414,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
@@ -1,16 +1,14 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE MultiParamTypeClasses #-}--#if __GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 708+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-}-#endif- ----------------------------------------------------------------------------- -- |--- Copyright   :  (C) 2014-2015 Edward Kmett+-- Copyright   :  (C) 2014-2018 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -32,14 +30,16 @@ 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 import Data.Profunctor.Adjunction import Data.Profunctor.Monad 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)@@ -68,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)@@ -82,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) @@ -105,18 +109,22 @@   dimap f g (Closure p) = Closure $ dimap (fmap f) (fmap g) p   lmap f (Closure p) = Closure $ lmap (fmap f) p   rmap f (Closure p) = Closure $ rmap (fmap f) p-  w #. Closure p = Closure $ fmap w #. p-  Closure p .# w = Closure $ p .# fmap w +  (#.) :: forall a b c q. Coercible c b => q b c -> Closure p a b -> Closure p a c+  _ #. Closure p = Closure $ fmap (coerce (id :: c -> c) :: b -> c) #. p++  (.#) :: forall a b c q. Coercible b a => Closure p b c -> q a b -> Closure p a c+  Closure p .# _ = Closure $ p .# fmap (coerce (id :: b -> b) :: a -> b)+ instance ProfunctorFunctor Closure where   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@@ -186,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,13 +1,11 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE UndecidableInstances #-}-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Profunctor.Composition@@ -64,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 @@ -86,9 +88,9 @@   rmap k (Procompose f g) = Procompose (rmap k f) g   {-# INLINE lmap #-}   k #. Procompose f g     = Procompose (k #. f) g-  {-# INLINE ( #. ) #-}+  {-# INLINE (#.) #-}   Procompose f g .# k     = Procompose f (g .# k)-  {-# INLINE ( .# ) #-}+  {-# INLINE (.#) #-}  instance Profunctor p => Functor (Procompose p q a) where   fmap k (Procompose f g) = Procompose (rmap k f) g@@ -241,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@@ -259,7 +269,7 @@   rmap bd f = Rift (runRift f . lmap bd)   {-# INLINE rmap #-}   bd #. f = Rift (\p -> runRift f (p .# bd))-  {-# INLINE ( #. ) #-}+  {-# INLINE (#.) #-}   f .# ca = Rift (\p -> runRift f p .# ca)   {-# INLINE (.#) #-}
src/Data/Profunctor/Mapping.hs view
@@ -1,16 +1,30 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE Safe #-}+-----------------------------------------------------------------------------+-- |+-- Copyright   :  (C) 2015-2018 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+--+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  experimental+-- Portability :  portable+--+---------------------------------------------------------------------------- module Data.Profunctor.Mapping   ( 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@@ -21,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:@@ -34,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' @@ -69,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)@@ -85,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@@ -103,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,10 +1,8 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2013-2015 Edward Kmett and Dan Doel@@ -36,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@@ -54,7 +60,7 @@   rmap bd f = Ran (rmap bd . runRan f)   {-# INLINE rmap #-}   bd #. f = Ran (\p -> bd #. runRan f p)-  {-# INLINE ( #. ) #-}+  {-# INLINE (#.) #-}   f .# ca = Ran (\p -> runRan f (ca #. p))   {-# INLINE (.#) #-} @@ -92,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@@ -103,7 +115,7 @@   rmap bd f = Codensity (rmap bd . runCodensity f)   {-# INLINE rmap #-}   bd #. f = Codensity (\p -> bd #. runCodensity f p)-  {-# INLINE ( #. ) #-}+  {-# INLINE (#.) #-}   f .# ca = Codensity (\p -> runCodensity f (ca #. p))   {-# INLINE (.#) #-}
src/Data/Profunctor/Rep.hs view
@@ -1,14 +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 #-}-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- -- | -- Module      :  Data.Profunctor.Rep@@ -48,6 +47,7 @@ import Control.Applicative import Control.Arrow import Control.Comonad+import Control.Monad ((>=>)) import Data.Functor.Identity import Data.Profunctor import Data.Profunctor.Sieve@@ -141,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@@ -180,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 @@ -192,8 +196,10 @@     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-  Prep xa pa >>= f = Prep xa $ tabulate $ \xa' -> sieve pa xa' >>= \a -> case f a of+#endif+  Prep xa pa >>= f = Prep xa $ tabulate $ sieve pa >=> \a -> case f a of     Prep xb pb -> sieve pb xb  prepAdj :: (forall a. Prep p a -> g a) -> p :-> Star g@@ -212,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,12 +1,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708 {-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2015 Edward Kmett
src/Data/Profunctor/Strong.hs view
@@ -3,10 +3,7 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE MultiParamTypeClasses #-}--#if __GLASGOW_HASKELL__ >= 704 && __GLASGOW_HASKELL__ < 708-{-# LANGUAGE Trustworthy #-}-#endif+{-# LANGUAGE Safe #-}  ----------------------------------------------------------------------------- -- |@@ -23,6 +20,7 @@   -- * Strength     Strong(..)   , uncurry'+  , strong   , Tambara(..)   , tambara, untambara   , Pastro(..)@@ -42,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,(.))@@ -64,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:@@ -72,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)@@ -85,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)@@ -93,14 +92,15 @@   second' :: p a b -> p (c, a) (c, b)   second' = dimap swap swap . first' -#if __GLASGOW_HASKELL__ >= 708   {-# MINIMAL first' | second' #-}-#endif  uncurry' :: Strong p => p a (b -> c) -> p (a, b) c 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' #-}@@ -148,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' #-}@@ -178,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@@ -265,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)@@ -345,9 +356,7 @@   unsecond :: p (d, a) (d, b) -> p a b   unsecond = unfirst . dimap swap swap -#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 708   {-# MINIMAL unfirst | unsecond #-}-#endif  instance Costrong (->) where   unfirst f a = b where (b, d) = f (a, d)@@ -382,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 ----------------------------------------------------------------------------@@ -414,7 +429,7 @@ -- 'uncotambara' '.' 'cotambara' ≡ 'id' -- @ cotambara :: Costrong p => (p :-> q) -> p :-> Cotambara q-cotambara = Cotambara+cotambara f = Cotambara f  -- | -- @@@ -432,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' @@ -118,9 +113,7 @@   wander :: (forall f. Applicative f => (a -> f b) -> s -> f t) -> p a b -> p s t   wander f pab = dimap (\s -> Baz $ \afb -> f afb s) sold (traverse' pab) -#if __GLASGOW_HASKELL__ >= 708   {-# MINIMAL wander | traverse' #-}-#endif  instance Traversing (->) where   traverse' = fmap@@ -138,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@@ -165,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,11 +1,10 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-} -#if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}-#endif  ----------------------------------------------------------------------------- -- |@@ -30,30 +29,31 @@   , Costar(..)   , WrappedArrow(..)   , Forget(..)-#ifndef HLINT   , (:->)-#endif   ) where  import Control.Applicative hiding (WrappedArrow(..)) import Control.Arrow import Control.Category import Control.Comonad-import Control.Monad (MonadPlus(..))+import Control.Monad (MonadPlus(..), (>=>))+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,(.),sequence)+import Prelude hiding (id,(.)) -#if __GLASGOW_HASKELL__ >= 708-import Data.Coerce-#else-import Unsafe.Coerce+#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  ------------------------------------------------------------------------------@@ -61,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@@ -70,13 +74,9 @@   {-# INLINE lmap #-}   rmap k (Star f) = Star (fmap k . f)   {-# INLINE rmap #-}-  -- We cannot safely overload ( #. ) because we didn't write the 'Functor'.-#if __GLASGOW_HASKELL__ >= 708+  -- We cannot safely overload (#.) because we didn't write the 'Functor'.   p .# _ = coerce p-#else-  p .# _ = unsafeCoerce p-#endif-  {-# INLINE ( .# ) #-}+  {-# INLINE (.#) #-}  instance Functor f => Functor (Star f a) where   fmap = rmap@@ -93,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@@ -109,13 +106,21 @@  instance Monad f => Category (Star f) where   id = Star return-  Star f . Star g = Star $ \a -> g a >>= f+  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@@ -125,13 +130,9 @@   {-# INLINE lmap #-}   rmap k (Costar f) = Costar (k . f)   {-# INLINE rmap #-}-#if __GLASGOW_HASKELL__ >= 708-  ( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b-#else-  ( #. ) _ = unsafeCoerce-#endif-  {-# INLINE ( #. ) #-}-  -- We cannot overload ( .# ) because we didn't write the 'Functor'.+  (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b+  {-# INLINE (#.) #-}+  -- We cannot overload (.#) because we didn't write the 'Functor'.  instance Distributive (Costar f d) where   distribute fs = Costar $ \gd -> fmap (($ gd) .# runCostar) fs@@ -157,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@@ -204,12 +209,15 @@   {-# INLINE lmap #-}   rmap = (^<<)   {-# INLINE rmap #-}-  -- We cannot safely overload ( #. ) or ( .# ) because we didn't write the 'Arrow'.+  -- We cannot safely overload (#.) or (.#) because we didn't write the 'Arrow'.  ------------------------------------------------------------------------------ -- 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@@ -231,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,13 +1,8 @@-{-# LANGUAGE CPP #-}-#if __GLASGOW_HASKELL__ >= 708 {-# LANGUAGE Trustworthy #-}-#elif __GLASGOW_HASKELL >= 704-{-# LANGUAGE Unsafe #-}-#endif {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- |--- Copyright   :  (C) 2011-2015 Edward Kmett+-- Copyright   :  (C) 2011-2018 Edward Kmett -- License     :  BSD-style (see the file LICENSE) -- -- Maintainer  :  Edward Kmett <ekmett@gmail.com>@@ -42,24 +37,12 @@ import Data.Bifunctor.Clown (Clown(..)) import Data.Bifunctor.Joker (Joker(..)) import Data.Bifunctor.Product (Product(..))+import Data.Bifunctor.Sum (Sum(..)) import Data.Bifunctor.Tannen (Tannen(..))-#if __GLASGOW_HASKELL__ < 710-import Data.Functor-#endif+import Data.Coerce (Coercible, coerce) import Data.Functor.Contravariant (Contravariant(..)) import Data.Tagged-import Prelude hiding (id,(.),sequence)--#if __GLASGOW_HASKELL__ >= 708-import Data.Coerce-#else-import Unsafe.Coerce-#endif--#ifdef HLINT-{-# ANN module "Hlint: ignore Redundant lambda" #-}-{-# ANN module "Hlint: ignore Collapse lambdas" #-}-#endif+import Prelude hiding (id,(.))  infixr 9 #. infixl 8 .#@@ -145,14 +128,10 @@   -- The semantics of this function with respect to bottoms   -- should match the default definition:   ---  -- @('Profuctor.Unsafe.#.') ≡ \\f -> \\p -> p \`seq\` 'rmap' f p@-#if __GLASGOW_HASKELL__ >= 708-  ( #. ) :: Coercible c b => (b -> c) -> p a b -> p a c-#else-  ( #. ) :: (b -> c) -> p a b -> p a c-#endif-  ( #. ) = \f -> \p -> p `seq` rmap f p-  {-# INLINE ( #. ) #-}+  -- @('Profuctor.Unsafe.#.') ≡ \\_ -> \\p -> p \`seq\` 'rmap' 'coerce' p@+  (#.) :: forall a b c q. Coercible c b => q b c -> p a b -> p a c+  (#.) = \_ -> \p -> p `seq` rmap (coerce (id :: c -> c) :: b -> c) p+  {-# INLINE (#.) #-}    -- | Strictly map the first argument argument   -- contravariantly with a function that is assumed@@ -175,18 +154,12 @@   -- will only call this with a second argument that is   -- operationally identity.   ---  -- @('.#') ≡ \\p -> p \`seq\` \\f -> 'lmap' f p@-#if __GLASGOW_HASKELL__ >= 708-  ( .# ) :: Coercible b a => p b c -> (a -> b) -> p a c-#else-  ( .# ) :: p b c -> (a -> b) -> p a c-#endif-  ( .# ) = \p -> p `seq` \f -> lmap f p-  {-# INLINE ( .# ) #-}+  -- @('.#') ≡ \\p -> p \`seq\` \\f -> 'lmap' 'coerce' p@+  (.#) :: forall a b c q. Coercible b a => p b c -> q a b -> p a c+  (.#) = \p -> p `seq` \_ -> lmap (coerce (id :: b -> b) :: a -> b) p+  {-# INLINE (.#) #-} -#if __GLASGOW_HASKELL__ >= 708   {-# MINIMAL dimap | (lmap, rmap) #-}-#endif  instance Profunctor (->) where   dimap ab cd bc = cd . bc . ab@@ -195,15 +168,10 @@   {-# INLINE lmap #-}   rmap = (.)   {-# INLINE rmap #-}-#if __GLASGOW_HASKELL__ >= 708-  ( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b-  ( .# ) pbc _ = coerce pbc-#else-  ( #. ) _ = unsafeCoerce-  ( .# ) pbc _ = unsafeCoerce pbc-#endif-  {-# INLINE ( #. ) #-}-  {-# INLINE ( .# ) #-}+  (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b+  (.#) pbc _ = coerce pbc+  {-# INLINE (#.) #-}+  {-# INLINE (.#) #-}  instance Profunctor Tagged where   dimap _ f (Tagged s) = Tagged (f s)@@ -212,14 +180,10 @@   {-# INLINE lmap #-}   rmap = fmap   {-# INLINE rmap #-}-#if __GLASGOW_HASKELL__ >= 708-  ( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b-#else-  ( #. ) _ = unsafeCoerce-#endif-  {-# INLINE ( #. ) #-}+  (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b+  {-# INLINE (#.) #-}   Tagged s .# _ = Tagged s-  {-# INLINE ( .# ) #-}+  {-# INLINE (.#) #-}  instance Monad m => Profunctor (Kleisli m) where   dimap f g (Kleisli h) = Kleisli (liftM g . h . f)@@ -229,12 +193,8 @@   rmap k (Kleisli f) = Kleisli (liftM k . f)   {-# INLINE rmap #-}   -- We cannot safely overload (#.) because we didn't provide the 'Monad'.-#if __GLASGOW_HASKELL__ >= 708-  ( .# ) pbc _ = coerce pbc-#else-  ( .# ) pbc _ = unsafeCoerce pbc-#endif-  {-# INLINE ( .# ) #-}+  (.#) pbc _ = coerce pbc+  {-# INLINE (.#) #-}  instance Functor w => Profunctor (Cokleisli w) where   dimap f g (Cokleisli h) = Cokleisli (g . h . fmap f)@@ -244,12 +204,8 @@   rmap k (Cokleisli f) = Cokleisli (k . f)   {-# INLINE rmap #-}   -- We cannot safely overload (.#) because we didn't provide the 'Functor'.-#if __GLASGOW_HASKELL__ >= 708-  ( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b-#else-  ( #. ) _ = unsafeCoerce-#endif-  {-# INLINE ( #. ) #-}+  (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b+  {-# INLINE (#.) #-}  instance Contravariant f => Profunctor (Clown f) where   lmap f (Clown fa) = Clown (contramap f fa)@@ -279,11 +235,28 @@   {-# INLINE rmap #-}   dimap f g (Pair p q) = Pair (dimap f g p) (dimap f g q)   {-# INLINE dimap #-}-  ( #. ) f (Pair p q) = Pair (f #. p) (f #. q)-  {-# INLINE ( #. ) #-}-  ( .# ) (Pair p q) f = Pair (p .# f) (q .# f)-  {-# INLINE ( .# ) #-}+  (#.) f (Pair p q) = Pair (f #. p) (f #. q)+  {-# INLINE (#.) #-}+  (.#) (Pair p q) f = Pair (p .# f) (q .# f)+  {-# INLINE (.#) #-} +instance (Profunctor p, Profunctor q) => Profunctor (Sum p q) where+  lmap f (L2 x) = L2 (lmap f x)+  lmap f (R2 y) = R2 (lmap f y)+  {-# INLINE lmap #-}+  rmap g (L2 x) = L2 (rmap g x)+  rmap g (R2 y) = R2 (rmap g y)+  {-# INLINE rmap #-}+  dimap f g (L2 x) = L2 (dimap f g x)+  dimap f g (R2 y) = R2 (dimap f g y)+  {-# INLINE dimap #-}+  f #. L2 x = L2 (f #. x)+  f #. R2 y = R2 (f #. y)+  {-# INLINE (#.) #-}+  L2 x .# f = L2 (x .# f)+  R2 y .# f = R2 (y .# f)+  {-# INLINE (.#) #-}+ instance (Functor f, Profunctor p) => Profunctor (Tannen f p) where   lmap f (Tannen h) = Tannen (lmap f <$> h)   {-# INLINE lmap #-}@@ -291,7 +264,7 @@   {-# INLINE rmap #-}   dimap f g (Tannen h) = Tannen (dimap f g <$> h)   {-# INLINE dimap #-}-  ( #. ) f (Tannen h) = Tannen ((f #.) <$> h)-  {-# INLINE ( #. ) #-}-  ( .# ) (Tannen h) f = Tannen ((.# f) <$> h)-  {-# INLINE ( .# ) #-}+  (#.) f (Tannen h) = Tannen ((f #.) <$> h)+  {-# INLINE (#.) #-}+  (.#) (Tannen h) f = Tannen ((.# f) <$> h)+  {-# INLINE (.#) #-}
src/Data/Profunctor/Yoneda.hs view
@@ -1,12 +1,8 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-}-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ <= 708 {-# LANGUAGE Trustworthy #-}-#endif ----------------------------------------------------------------------------- -- | -- Copyright   :  (C) 2017 Edward Kmett@@ -23,18 +19,13 @@   ) where  import Control.Category+import Data.Coerce (Coercible, coerce) import Data.Profunctor import Data.Profunctor.Monad import Data.Profunctor.Traversing import Data.Profunctor.Unsafe import Prelude hiding (id,(.)) -#if __GLASGOW_HASKELL__ >= 708-import Data.Coerce-#else-import Unsafe.Coerce-#endif- -------------------------------------------------------------------------------- -- * Yoneda --------------------------------------------------------------------------------@@ -68,17 +59,10 @@   {-# INLINE lmap #-}   rmap r p = Yoneda $ \l r' -> runYoneda p l (r' . r)   {-# INLINE rmap #-}-#if __GLASGOW_HASKELL__ >= 708-  ( .# ) p _ = coerce p-  {-# INLINE ( .# ) #-}-  ( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b-  {-# INLINE ( #. ) #-}-#else-  ( .# ) p _ = unsafeCoerce p-  {-# INLINE ( .# ) #-}-  ( #. ) _ = unsafeCoerce-  {-# INLINE ( #. ) #-}-#endif+  (.#) p _ = coerce p+  {-# INLINE (.#) #-}+  (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b+  {-# INLINE (#.) #-}  instance Functor (Yoneda p a) where   fmap f p = Yoneda $ \l r -> runYoneda p l (r . f)@@ -171,6 +155,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   {-# INLINE dimap #-}@@ -178,17 +165,10 @@   {-# INLINE lmap #-}   rmap r (Coyoneda l r' p) = Coyoneda l (r . r') p   {-# INLINE rmap #-}-#if __GLASGOW_HASKELL__ >= 708-  ( .# ) p _ = coerce p-  {-# INLINE ( .# ) #-}-  ( #. ) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b-  {-# INLINE ( #. ) #-}-#else-  ( .# ) p _ = unsafeCoerce p-  {-# INLINE ( .# ) #-}-  ( #. ) _ = unsafeCoerce-  {-# INLINE ( #. ) #-}-#endif+  (.#) p _ = coerce p+  {-# INLINE (.#) #-}+  (#.) _ = coerce (\x -> x :: b) :: forall a b. Coercible b a => a -> b+  {-# INLINE (#.) #-}  instance ProfunctorFunctor Coyoneda where   promap f (Coyoneda l r p) = Coyoneda l r (f p)