distributive-0.6/0000755000000000000000000000000013316523174012267 5ustar0000000000000000distributive-0.6/CHANGELOG.markdown0000644000000000000000000000344413316523174015327 0ustar00000000000000000.6 [2018.07.02] ---------------- * Remove `fmapCollect`. (See [here](https://github.com/ekmett/distributive/commit/1020655f15714514048d0dc842ffe4adcec89a7b) for an explanation of why it was removed.) * Avoid incurring some dependencies when using recent GHCs. 0.5.3 ----- * Support `doctest-0.12` 0.5.2 ----- * Revamp `Setup.hs` to use `cabal-doctest`. This makes `distributive` build with `Cabal-1.25`, and makes the `doctest`s work with `cabal new-build` and sandboxes. * Fix bugs in `Data.Distributive.Generic` that cause generic `Distributive` instances not to work properly for datatypes with recursive types * Add `genericCollect` to `Data.Distributive.Generic`, and switch the underlying machinery in that module to work on a `collect`-like method instead of a `distribute`-like one * Add a test suite for regression-testing `Data.Distributive.Generic` 0.5.1 ----- * Add `Distributive` instances for datatypes from `Data.Semigroup` and `GHC.Generics` * Add `MINIMAL` pragma for `Distributive` 0.5.0.2 ------- * A more elegant fix for builds on GHC 7.2 0.5.0.1 ------- * Fix builds on GHC 7.2 0.5 --- * Added flags for removing some dependencies. * Support `doctests` when building to non-standard locations (such as when using `stack`.) * Support `base-orphans` 0.4.4 ----- * `transformers 0.4` compatibility 0.4.3.1 ----- * Fixed builds with older versions of GHC 0.4.2 ------- * Added `Data.Distributive.Generic`. 0.4.1 ----- * `Control.Monad.Instances` is deprecated in GHC 7.8. Don't import it there. 0.4 --- * Added support for `Data.Tagged` and `Data.Proxy`. 0.3.1 ----- * Minor documentation fix 0.3 --- * Added instances for `Control.Applicative.Backwards` and `Data.Functor.Reverse` from `transformers` 0.3, taking them from `transformers-compat` if necessary for `transformers` 0.2 distributive-0.6/config0000644000000000000000000000120613316523174013456 0ustar0000000000000000-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix -- -- This is particularly useful for travis-ci to get it to stop complaining -- about a broken build when everything is still correct on our end. -- -- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead -- -- To enable this, uncomment the before_script in .travis.yml remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive remote-repo-cache: ~/.cabal/packages world-file: ~/.cabal/world build-summary: ~/.cabal/logs/build.log remote-build-reporting: anonymous install-dirs user install-dirs global distributive-0.6/distributive.cabal0000644000000000000000000000571213316523174015775 0ustar0000000000000000name: distributive category: Data Structures version: 0.6 license: BSD3 cabal-version: >= 1.8 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett stability: provisional homepage: http://github.com/ekmett/distributive/ bug-reports: http://github.com/ekmett/distributive/issues copyright: Copyright (C) 2011-2016 Edward A. Kmett synopsis: Distributive functors -- Dual to Traversable description: Distributive functors -- Dual to @Traversable@ build-type: Custom 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.3 , GHC == 8.6.1 extra-source-files: .travis.yml .vim.custom config travis-cabal-apt-install CHANGELOG.markdown README.markdown Warning.hs source-repository head type: git location: git://github.com/ekmett/distributive.git custom-setup setup-depends: base >= 4 && <5, Cabal, cabal-doctest >= 1 && <1.1 flag semigroups manual: True default: True description: You can disable the use of the `semigroups` package using `-f-semigroups`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. flag tagged manual: True default: True description: You can disable the use of the `tagged` package using `-f-tagged`. . Disabling this is an unsupported configuration, but it may be useful for accelerating builds in sandboxes for expert users. library build-depends: base >= 4 && < 5, base-orphans >= 0.5.2 && < 1, transformers >= 0.2 && < 0.6 if !impl(ghc >= 7.8) && !impl(ghcjs) build-depends: transformers-compat >= 0.3 && < 1 hs-source-dirs: src exposed-modules: Data.Distributive if impl(ghc>=7.2) exposed-modules: Data.Distributive.Generic if flag(tagged) build-depends: tagged >= 0.7 && < 1 if impl(ghc>=7.2 && < 7.6) build-depends: ghc-prim if impl(ghc < 8.0) if flag(semigroups) build-depends: semigroups >= 0.13 && < 1 if impl(ghc < 7.8) hs-source-dirs: src-compat other-modules: Data.Coerce ghc-options: -Wall -- Verify the results of the examples test-suite doctests type: exitcode-stdio-1.0 main-is: doctests.hs build-depends: base >= 4, distributive, doctest >= 0.11.1 && <0.17 ghc-options: -Wall -threaded hs-source-dirs: tests test-suite spec type: exitcode-stdio-1.0 hs-source-dirs: tests build-tool-depends: hspec-discover:hspec-discover build-depends: base >= 4 && < 5, distributive, generic-deriving >= 1.11 && < 2, hspec >= 2 && < 3 main-is: Spec.hs other-modules: GenericsSpec ghc-options: -Wall -threaded -rtsopts distributive-0.6/README.markdown0000644000000000000000000000220213316523174014764 0ustar0000000000000000distributive ============ [![Hackage](https://img.shields.io/hackage/v/distributive.svg)](https://hackage.haskell.org/package/distributive) [![Build Status](https://secure.travis-ci.org/ekmett/distributive.png?branch=master)](http://travis-ci.org/ekmett/distributive) This package provides the notion that is categorically dual to `Traversable`. A `Distributive` `Functor` is one that you can push any functor inside of. ```haskell distribute :: (Functor f, Distributive g) => f (g a) -> g (f a) ``` Compare this with the corresponding Traversable notion, `sequenceA`. ```haskell sequenceA :: (Applicative f, Traversable g) => g (f a) -> f (g a) ``` This package includes instances for common types, and includes other methods similar to `traverse` which fuse the use of `fmap`. We only require `Functor` rather than some dual notion to `Applicative`, because the latter cannot meaningfully exist in Haskell since all comonoids there are trivial. Contact Information ------------------- Contributions and bug reports are welcome! Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net. -Edward Kmett distributive-0.6/Setup.lhs0000644000000000000000000000124113316523174014075 0ustar0000000000000000\begin{code} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wall #-} module Main (main) where #ifndef MIN_VERSION_cabal_doctest #define MIN_VERSION_cabal_doctest(x,y,z) 0 #endif #if MIN_VERSION_cabal_doctest(1,0,0) import Distribution.Extra.Doctest ( defaultMainWithDoctests ) main :: IO () main = defaultMainWithDoctests "doctests" #else #ifdef MIN_VERSION_Cabal -- If the macro is defined, we have new cabal-install, -- but for some reason we don't have cabal-doctest in package-db -- -- Probably we are running cabal sdist, when otherwise using new-build -- workflow import Warning () #endif import Distribution.Simple main :: IO () main = defaultMain #endif \end{code} distributive-0.6/travis-cabal-apt-install0000755000000000000000000000100713316523174017011 0ustar0000000000000000#!/bin/sh set -eu sudo apt-get -q update sudo apt-get -q -y install dctrl-tools # Try installing some of the build-deps with apt-get for speed. eval "$( printf '%s' "grep-aptavail -n -sPackage '(' -FFALSE -X FALSE ')'" 2>/dev/null cabal install "$@" --dry-run -v | \ sed -nre "s/^([^ ]+)-[0-9.]+ \(.*$/ -o '(' -FPackage -X libghc-\1-dev ')'/p" | \ xargs -d'\n' )" | sort -u | xargs -d'\n' sudo apt-get -q -y install -- libghc-quickcheck2-dev # Install whatever is still needed with cabal. cabal install "$@" distributive-0.6/.vim.custom0000644000000000000000000000137713316523174014404 0ustar0000000000000000" Add the following to your .vimrc to automatically load this on startup " if filereadable(".vim.custom") " so .vim.custom " endif function StripTrailingWhitespace() let myline=line(".") let mycolumn = col(".") silent %s/ *$// call cursor(myline, mycolumn) endfunction " enable syntax highlighting syntax on " search for the tags file anywhere between here and / set tags=TAGS;/ " highlight tabs and trailing spaces set listchars=tab:‗‗,trail:‗ set list " f2 runs hasktags map :exec ":!hasktags -x -c --ignore src" " strip trailing whitespace before saving " au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace() " rebuild hasktags after saving au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src" distributive-0.6/Warning.hs0000644000000000000000000000040013316523174014222 0ustar0000000000000000module Warning {-# WARNING ["You are configuring this package without cabal-doctest installed.", "The doctests test-suite will not work as a result.", "To fix this, install cabal-doctest before configuring."] #-} () where distributive-0.6/.travis.yml0000644000000000000000000001633213316523174014405 0ustar0000000000000000# 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: - "\x0313distributive\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-7.6.3" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.6.3], sources: [hvr-ghc]}} - compiler: "ghc-7.4.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.4.2], sources: [hvr-ghc]}} - compiler: "ghc-7.2.2" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.2.2], sources: [hvr-ghc]}} - compiler: "ghc-7.0.4" # env: TEST=--disable-tests BENCH=--disable-benchmarks addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.0.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-7.0.4" - compiler: "ghc-7.2.2" - compiler: "ghc-8.6.1" 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} - 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/distributive-*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \; - "printf 'packages: distributive-*/*.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 - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi # cabal check - (cd distributive-* && cabal check) # haddock - rm -rf ./dist-newstyle - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi # REGENDATA ["-o",".travis.yml","--ghc-head","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-unconstrained","cabal.project"] # EOF distributive-0.6/LICENSE0000644000000000000000000000236413316523174013301 0ustar0000000000000000Copyright 2011-2016 Edward Kmett All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. distributive-0.6/src-compat/0000755000000000000000000000000013316523174014337 5ustar0000000000000000distributive-0.6/src-compat/Data/0000755000000000000000000000000013316523174015210 5ustar0000000000000000distributive-0.6/src-compat/Data/Coerce.hs0000644000000000000000000000030013316523174016735 0ustar0000000000000000-- This is a shim for GHC before 7.8. Cabal ignores it -- for GHC 7.8 and later. module Data.Coerce (coerce) where import Unsafe.Coerce (unsafeCoerce) coerce :: a -> b coerce = unsafeCoerce distributive-0.6/src/0000755000000000000000000000000013316523174013056 5ustar0000000000000000distributive-0.6/src/Data/0000755000000000000000000000000013316523174013727 5ustar0000000000000000distributive-0.6/src/Data/Distributive.hs0000644000000000000000000002255213316523174016746 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ScopedTypeVariables #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Distributive -- Copyright : (C) 2011-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Distributive ( Distributive(..) , cotraverse , comapM ) where import Control.Applicative import Control.Applicative.Backwards import Control.Monad (liftM) #if __GLASGOW_HASKELL__ < 707 import Control.Monad.Instances () #endif import Control.Monad.Trans.Identity import Control.Monad.Trans.Reader import Data.Coerce import Data.Functor.Compose import Data.Functor.Identity import Data.Functor.Product import Data.Functor.Reverse import qualified Data.Monoid as Monoid import Data.Orphans () #if MIN_VERSION_base(4,4,0) import Data.Complex #endif #if __GLASGOW_HASKELL__ >= 707 || defined(MIN_VERSION_tagged) import Data.Proxy #endif #if __GLASGOW_HASKELL__ >= 800 || defined(MIN_VERSION_semigroups) import qualified Data.Semigroup as Semigroup #endif #ifdef MIN_VERSION_tagged import Data.Tagged #endif #if __GLASGOW_HASKELL__ >= 702 import GHC.Generics (U1(..), (:*:)(..), (:.:)(..), Par1(..), Rec1(..), M1(..)) #endif #ifdef HLINT {-# ANN module "hlint: ignore Use section" #-} #endif -- | This is the categorical dual of 'Traversable'. -- -- Due to the lack of non-trivial comonoids in Haskell, we can restrict -- ourselves to requiring a 'Functor' rather than -- some Coapplicative class. Categorically every 'Distributive' -- functor is actually a right adjoint, and so it must be 'Representable' -- endofunctor and preserve all limits. This is a fancy way of saying it -- isomorphic to @(->) x@ for some x. -- -- To be distributable a container will need to have a way to consistently -- zip a potentially infinite number of copies of itself. This effectively -- means that the holes in all values of that type, must have the same -- cardinality, fixed sized vectors, infinite streams, functions, etc. -- and no extra information to try to merge together. -- class Functor g => Distributive g where #if __GLASGOW_HASKELL__ >= 707 {-# MINIMAL distribute | collect #-} #endif -- | The dual of 'Data.Traversable.sequenceA' -- -- >>> distribute [(+1),(+2)] 1 -- [2,3] -- -- @ -- 'distribute' = 'collect' 'id' -- 'distribute' . 'distribute' = 'id' -- @ distribute :: Functor f => f (g a) -> g (f a) distribute = collect id -- | -- @ -- 'collect' f = 'distribute' . 'fmap' f -- 'fmap' f = 'runIdentity' . 'collect' ('Identity' . f) -- 'fmap' 'distribute' . 'collect' f = 'getCompose' . 'collect' ('Compose' . f) -- @ collect :: Functor f => (a -> g b) -> f a -> g (f b) collect f = distribute . fmap f -- | The dual of 'Data.Traversable.sequence' -- -- @ -- 'distributeM' = 'fmap' 'unwrapMonad' . 'distribute' . 'WrapMonad' -- @ distributeM :: Monad m => m (g a) -> g (m a) distributeM = fmap unwrapMonad . distribute . WrapMonad -- | -- @ -- 'collectM' = 'distributeM' . 'liftM' f -- @ collectM :: Monad m => (a -> g b) -> m a -> g (m b) collectM f = distributeM . liftM f -- | The dual of 'Data.Traversable.traverse' -- -- @ -- 'cotraverse' f = 'fmap' f . 'distribute' -- @ cotraverse :: (Distributive g, Functor f) => (f a -> b) -> f (g a) -> g b cotraverse f = fmap f . distribute -- | The dual of 'Data.Traversable.mapM' -- -- @ -- 'comapM' f = 'fmap' f . 'distributeM' -- @ comapM :: (Distributive g, Monad m) => (m a -> b) -> m (g a) -> g b comapM f = fmap f . distributeM instance Distributive Identity where collect = coerce (fmap :: (a -> b) -> f a -> f b) :: forall a b f . Functor f => (a -> Identity b) -> f a -> Identity (f b) distribute = Identity . fmap runIdentity #if __GLASGOW_HASKELL__ >= 707 || defined(MIN_VERSION_tagged) instance Distributive Proxy where collect _ _ = Proxy distribute _ = Proxy #endif #if defined(MIN_VERSION_tagged) instance Distributive (Tagged t) where collect = coerce (fmap :: (a -> b) -> f a -> f b) :: forall a b f . Functor f => (a -> Tagged t b) -> f a -> Tagged t (f b) distribute = Tagged . fmap unTagged #endif instance Distributive ((->)e) where distribute a e = fmap ($e) a collect f q e = fmap (flip f e) q instance Distributive g => Distributive (ReaderT e g) where distribute a = ReaderT $ \e -> collect (flip runReaderT e) a collect f x = ReaderT $ \e -> collect (\a -> runReaderT (f a) e) x instance Distributive g => Distributive (IdentityT g) where collect = coerce (collect :: (a -> g b) -> f a -> g (f b)) :: forall a b f . Functor f => (a -> IdentityT g b) -> f a -> IdentityT g (f b) instance (Distributive f, Distributive g) => Distributive (Compose f g) where distribute = Compose . fmap distribute . collect getCompose collect f = Compose . fmap distribute . collect (coerce f) instance (Distributive f, Distributive g) => Distributive (Product f g) where -- It might be tempting to write a 'collect' implementation that -- composes the passed function with fstP and sndP. This could be bad, -- because it would lead to the passed function being evaluated twice -- for each element of the underlying functor. distribute wp = Pair (collect fstP wp) (collect sndP wp) where fstP (Pair a _) = a sndP (Pair _ b) = b instance Distributive f => Distributive (Backwards f) where distribute = Backwards . collect forwards collect = coerce (collect :: (a -> f b) -> g a -> f (g b)) :: forall g a b . Functor g => (a -> Backwards f b) -> g a -> Backwards f (g b) instance Distributive f => Distributive (Reverse f) where distribute = Reverse . collect getReverse collect = coerce (collect :: (a -> f b) -> g a -> f (g b)) :: forall g a b . Functor g => (a -> Reverse f b) -> g a -> Reverse f (g b) instance Distributive Monoid.Dual where collect = coerce (fmap :: (a -> b) -> f a -> f b) :: forall f a b . Functor f => (a -> Monoid.Dual b) -> f a -> Monoid.Dual (f b) distribute = Monoid.Dual . fmap Monoid.getDual instance Distributive Monoid.Product where collect = coerce (fmap :: (a -> b) -> f a -> f b) :: forall f a b . Functor f => (a -> Monoid.Product b) -> f a -> Monoid.Product (f b) distribute = Monoid.Product . fmap Monoid.getProduct instance Distributive Monoid.Sum where collect = coerce (fmap :: (a -> b) -> f a -> f b) :: forall f a b . Functor f => (a -> Monoid.Sum b) -> f a -> Monoid.Sum (f b) distribute = Monoid.Sum . fmap Monoid.getSum #if __GLASGOW_HASKELL__ >= 800 || defined(MIN_VERSION_semigroups) instance Distributive Semigroup.Min where collect = coerce (fmap :: (a -> b) -> f a -> f b) :: forall f a b . Functor f => (a -> Semigroup.Min b) -> f a -> Semigroup.Min (f b) distribute = Semigroup.Min . fmap Semigroup.getMin instance Distributive Semigroup.Max where collect = coerce (fmap :: (a -> b) -> f a -> f b) :: forall f a b . Functor f => (a -> Semigroup.Max b) -> f a -> Semigroup.Max (f b) distribute = Semigroup.Max . fmap Semigroup.getMax instance Distributive Semigroup.First where collect = coerce (fmap :: (a -> b) -> f a -> f b) :: forall f a b . Functor f => (a -> Semigroup.First b) -> f a -> Semigroup.First (f b) distribute = Semigroup.First . fmap Semigroup.getFirst instance Distributive Semigroup.Last where collect = coerce (fmap :: (a -> b) -> f a -> f b) :: forall f a b . Functor f => (a -> Semigroup.Last b) -> f a -> Semigroup.Last (f b) distribute = Semigroup.Last . fmap Semigroup.getLast #endif #if MIN_VERSION_base(4,4,0) instance Distributive Complex where distribute wc = fmap realP wc :+ fmap imagP wc where -- Redefine realPart and imagPart to avoid incurring redundant RealFloat -- constraints on older versions of base realP (r :+ _) = r imagP (_ :+ i) = i #endif #if __GLASGOW_HASKELL__ >= 702 instance Distributive U1 where distribute _ = U1 instance (Distributive a, Distributive b) => Distributive (a :*: b) where -- It might be tempting to write a 'collect' implementation that -- composes the passed function with fstP and sndP. This could be bad, -- because it would lead to the passed function being evaluated twice -- for each element of the underlying functor. distribute f = collect fstP f :*: collect sndP f where fstP (l :*: _) = l sndP (_ :*: r) = r instance (Distributive a, Distributive b) => Distributive (a :.: b) where distribute = Comp1 . fmap distribute . collect unComp1 collect f = Comp1 . fmap distribute . collect (coerce f) instance Distributive Par1 where distribute = Par1 . fmap unPar1 collect = coerce (fmap :: (a -> b) -> f a -> f b) :: forall f a b . Functor f => (a -> Par1 b) -> f a -> Par1 (f b) instance Distributive f => Distributive (Rec1 f) where distribute = Rec1 . collect unRec1 collect = coerce (collect :: (a -> f b) -> g a -> f (g b)) :: forall g a b . Functor g => (a -> Rec1 f b) -> g a -> Rec1 f (g b) instance Distributive f => Distributive (M1 i c f) where distribute = M1 . collect unM1 collect = coerce (collect :: (a -> f b) -> g a -> f (g b)) :: forall g a b . Functor g => (a -> M1 i c f b) -> g a -> M1 i c f (g b) #endif distributive-0.6/src/Data/Distributive/0000755000000000000000000000000013316523174016404 5ustar0000000000000000distributive-0.6/src/Data/Distributive/Generic.hs0000644000000000000000000000564513316523174020326 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Data.Distributive -- Copyright : (C) 2011-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- ---------------------------------------------------------------------------- module Data.Distributive.Generic ( GDistributive(..) , genericCollect , genericDistribute ) where import Data.Distributive import GHC.Generics import Data.Coerce -- | 'collect' derived from a 'Generic1' type -- -- This can be used to easily produce a 'Distributive' instance for a -- type with a 'Generic1' instance, -- -- > data V2 a = V2 a a deriving (Show, Functor, Generic1) -- > instance Distributive V2' where collect = genericCollect genericCollect :: (Functor f, Generic1 g, GDistributive (Rep1 g)) => (a -> g b) -> f a -> g (f b) genericCollect f = to1 . gcollect (from1 . f) -- | 'distribute' derived from a 'Generic1' type -- -- It's often more efficient to use 'genericCollect' instead. genericDistribute :: (Functor f, Generic1 g, GDistributive (Rep1 g)) => f (g a) -> g (f a) genericDistribute = to1 . gdistribute . fmap from1 -- Can't distribute over, -- * sums (:+:) -- * K1 -- * V1 class GDistributive g where gcollect :: Functor f => (a -> g b) -> f a -> g (f b) gdistribute :: (GDistributive g, Functor f) => f (g b) -> g (f b) gdistribute = gcollect id {-# INLINE gdistribute #-} instance GDistributive U1 where gcollect _ _ = U1 {-# INLINE gcollect #-} instance (GDistributive a, GDistributive b) => GDistributive (a :*: b) where -- It might be tempting to fuse `gcollect fstP (fmap f x)` into -- `gcollect (fstP . f) x`, but this would lead to a loss of sharing. gcollect f x = gcollect fstP x' :*: gcollect sndP x' where x' = fmap f x fstP (l :*: _) = l sndP (_ :*: r) = r {-# INLINE gcollect #-} instance (Distributive a, GDistributive b) => GDistributive (a :.: b) where gcollect f = Comp1 . fmap gdistribute . collect (coerce f) {-# INLINE gcollect #-} instance GDistributive Par1 where gcollect = coerce (fmap :: (a -> b) -> f a -> f b) :: forall f a b . Functor f => (a -> Par1 b) -> f a -> Par1 (f b) {-# INLINE gcollect #-} instance Distributive f => GDistributive (Rec1 f) where gcollect = coerce (collect :: (a -> f b) -> g a -> f (g b)) :: forall g a b . Functor g => (a -> Rec1 f b) -> g a -> Rec1 f (g b) {-# INLINE gcollect #-} instance GDistributive f => GDistributive (M1 i c f) where gcollect = coerce (gcollect :: (a -> f b) -> g a -> f (g b)) :: forall g a b . Functor g => (a -> M1 i c f b) -> g a -> M1 i c f (g b) {-# INLINE gcollect #-} distributive-0.6/tests/0000755000000000000000000000000013316523174013431 5ustar0000000000000000distributive-0.6/tests/doctests.hs0000644000000000000000000000147213316523174015621 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Main (doctests) -- Copyright : (C) 2012-14 Edward Kmett -- License : BSD-style (see the file LICENSE) -- Maintainer : Edward Kmett -- Stability : provisional -- Portability : portable -- -- This module provides doctests for a project based on the actual versions -- of the packages it was built with. It requires a corresponding Setup.lhs -- to be added to the project ----------------------------------------------------------------------------- module Main where import Build_doctests (flags, pkgs, module_sources) import Data.Foldable (traverse_) import Test.DocTest main :: IO () main = do traverse_ putStrLn args doctest args where args = flags ++ pkgs ++ module_sources distributive-0.6/tests/Spec.hs0000644000000000000000000000005413316523174014656 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} distributive-0.6/tests/GenericsSpec.hs0000644000000000000000000000507613316523174016347 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE DeriveGeneric #-} #endif ----------------------------------------------------------------------------- -- | -- Module : GenericSpec -- Copyright : (C) 2011-2016 Edward Kmett -- License : BSD-style (see the file LICENSE) -- -- Maintainer : Edward Kmett -- Stability : provisional -- -- Tests for generically derived 'Distributive' instances. ---------------------------------------------------------------------------- module GenericsSpec (main, spec) where import Test.Hspec #if __GLASGOW_HASKELL__ >= 702 import Data.Distributive (Distributive(..)) import Data.Distributive.Generic (genericCollect, genericDistribute) # if __GLASGOW_HASKELL__ >= 706 import Generics.Deriving.Base hiding (Rep) # else import qualified Generics.Deriving.TH as Generics (deriveAll1) # endif #endif main :: IO () main = hspec spec spec :: Spec #if __GLASGOW_HASKELL__ < 702 spec = return () #else spec = do describe "Id" $ it "distribute idExample = idExample" $ distribute idExample `shouldBe` idExample describe "Stream" $ it "runId (shead (stail (distribute streamExample))) = 1" $ runId (shead (stail (distribute streamExample))) `shouldBe` 1 describe "PolyRec" $ it "runId (plast (runId (pinit (distribute polyRecExample)))) = 1" $ runId (plast (runId (pinit (distribute polyRecExample)))) `shouldBe` 1 newtype Id a = Id { runId :: a } deriving (Eq, Functor, Show) instance Distributive Id where collect = genericCollect distribute = genericDistribute idExample :: Id (Id Int) idExample = Id (Id 42) data Stream a = (:>) { shead :: a, stail :: Stream a } deriving Functor instance Distributive Stream where collect = genericCollect distribute = genericDistribute streamExample :: Id (Stream Int) streamExample = Id $ let s = 0 :> fmap (+1) s in s data PolyRec a = PolyRec { pinit :: Id (PolyRec a), plast :: a } deriving Functor instance Distributive PolyRec where collect = genericCollect distribute = genericDistribute polyRecExample :: Id (PolyRec Int) polyRecExample = Id $ let p = PolyRec (Id $ fmap (+1) p) 0 in p # if __GLASGOW_HASKELL__ >= 706 deriving instance Generic1 Id deriving instance Generic1 Stream deriving instance Generic1 PolyRec # else $(Generics.deriveAll1 ''Id) $(Generics.deriveAll1 ''Stream) $(Generics.deriveAll1 ''PolyRec) # endif #endif