profunctors 5.4 → 5.5
raw patch · 5 files changed
+76/−63 lines, 5 files
Files
- .travis.yml +32/−33
- CHANGELOG.markdown +5/−0
- profunctors.cabal +1/−1
- src/Data/Profunctor/Choice.hs +12/−8
- src/Data/Profunctor/Mapping.hs +26/−21
.travis.yml view
@@ -4,7 +4,7 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci #-# version: 0.3.20190425+# version: 0.4 # language: c dist: xenial@@ -35,34 +35,32 @@ include: - compiler: ghc-8.8.1 addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}- env: GHCHEAD=true - compiler: ghc-8.6.5- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}} - compiler: ghc-8.4.4- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}}+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}} - compiler: ghc-8.2.2- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}}+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}} - compiler: ghc-8.0.2- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}}+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}} - compiler: ghc-7.10.3- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}}+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-3.0"]}} - compiler: ghc-7.8.4- addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}}+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-3.0"]}} - compiler: ghc-head addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-head","cabal-install-head"]}}- env: GHCHEAD=true allow_failures: - compiler: ghc-head- - compiler: ghc-8.8.1 before_install: - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')+ - WITHCOMPILER="-w $HC" - HCPKG="$HC-pkg" - unset CC - CABAL=/opt/ghc/bin/cabal - CABALHOME=$HOME/.cabal - export PATH="$CABALHOME/bin:$PATH" - TOP=$(pwd)- - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))+ - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')" - echo $HCNUMVER - CABAL="$CABAL -vnormal+nowrap+markoutput" - set -o pipefail@@ -89,11 +87,13 @@ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]" - TEST=--enable-tests - BENCH=--enable-benchmarks- - GHCHEAD=${GHCHEAD-false}+ - HEADHACKAGE=false+ - if [ $HCNUMVER -gt 80801 ] ; then HEADHACKAGE=true ; fi - rm -f $CABALHOME/config - | echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config echo "remote-build-reporting: anonymous" >> $CABALHOME/config+ echo "write-ghc-environment-files: always" >> $CABALHOME/config echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config echo "world-file: $CABALHOME/world" >> $CABALHOME/config@@ -107,36 +107,34 @@ echo "repository hackage.haskell.org" >> $CABALHOME/config echo " url: http://hackage.haskell.org/" >> $CABALHOME/config - |- if $GHCHEAD; then+ if $HEADHACKAGE; then echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config- - echo "repository head.hackage" >> $CABALHOME/config- echo " url: http://head.hackage.haskell.org/" >> $CABALHOME/config+ echo "repository head.hackage.ghc.haskell.org" >> $CABALHOME/config+ echo " url: https://ghc.gitlab.haskell.org/head.hackage/" >> $CABALHOME/config echo " secure: True" >> $CABALHOME/config- echo " root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740" >> $CABALHOME/config- echo " 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb" >> $CABALHOME/config- echo " 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e" >> $CABALHOME/config+ echo " root-keys: 7541f32a4ccca4f97aea3b22f5e593ba2c0267546016b992dfadcd2fe944e55d" >> $CABALHOME/config+ echo " 26021a13b401500c8eb2761ca95c61f2d625bfef951b939a8124ed12ecf07329" >> $CABALHOME/config+ echo " f76d08be13e9a61a377a85e2fb63f4c5435d40f8feb3e12eb05905edb8cdea89" >> $CABALHOME/config echo " key-threshold: 3" >> $CABALHOME/config fi - cat $CABALHOME/config - rm -fv cabal.project cabal.project.local cabal.project.freeze - travis_retry ${CABAL} v2-update -v- - if [ $HCNUMVER -eq 80801 ] ; then ${CABAL} v2-install -w ${HC} -j2 hlint --constraint='hlint ==2.1.*' | color_cabal_output ; fi+ - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 80802 ] ; then (cd /tmp && ${CABAL} v2-install $WITHCOMPILER -j2 hlint --constraint='hlint ==2.1.*' | color_cabal_output) ; fi # Generate cabal.project - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project - |- echo 'packages: "."' >> cabal.project+ echo "packages: ." >> cabal.project - |- echo "write-ghc-environment-files: always" >> cabal.project- - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(profunctors)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(profunctors)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi- - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'" - rm cabal.project.freeze- - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all | color_cabal_output+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output script: - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX) # Packaging...@@ -144,26 +142,27 @@ # Unpacking... - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/ - cd ${DISTDIR} || false- - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;+ - PKGDIR_profunctors="$(find . -maxdepth 1 -type d -regex '.*/profunctors-[0-9.]*')" # Generate cabal.project - rm -rf cabal.project cabal.project.local cabal.project.freeze - touch cabal.project - |- echo 'packages: "profunctors-*/*.cabal"' >> cabal.project+ echo "packages: ${PKGDIR_profunctors}" >> cabal.project - |- echo "write-ghc-environment-files: always" >> cabal.project- - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(profunctors)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(profunctors)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done" - cat cabal.project || true - cat cabal.project.local || true # Building with tests and benchmarks... # build & run tests, build benchmarks- - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output # HLint..- - if [ $HCNUMVER -eq 80801 ] ; then (cd profunctors-* && hlint --cpp-ansi --cpp-define=HLINT src) ; fi+ - if [ $HCNUMVER -ge 80800 ] && [ $HCNUMVER -lt 80802 ] ; then (cd ${PKGDIR_profunctors} && hlint src) ; fi # cabal check...- - (cd profunctors-* && ${CABAL} -vnormal check)+ - (cd ${PKGDIR_profunctors} && ${CABAL} -vnormal check) # haddock...- - ${CABAL} v2-haddock -w ${HC} ${TEST} ${BENCH} all | color_cabal_output+ - ${CABAL} v2-haddock $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output # REGENDATA ["--output=.travis.yml","--config=cabal.haskell-ci","cabal.project"] # EOF
CHANGELOG.markdown view
@@ -1,3 +1,8 @@+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`.
profunctors.cabal view
@@ -1,6 +1,6 @@ name: profunctors category: Control, Categories-version: 5.4+version: 5.5 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE
src/Data/Profunctor/Choice.hs view
@@ -73,8 +73,8 @@ -- assocE ('Right' c) = 'Right' ('Right' c) -- unassocE :: 'Either' a ('Either' b c) -> 'Either' ('Either' a b) c -- unassocE ('Left' a) = 'Left' ('Left' a)- -- unassocE ('Right' ('Left' b) = 'Left' ('Right' b)- -- unassocE ('Right' ('Right' c)) = 'Right' c)+ -- unassocE ('Right' ('Left' b)) = 'Left' ('Right' b)+ -- unassocE ('Right' ('Right' c)) = 'Right' c -- @ left' :: p a b -> p (Either a c) (Either b c) left' = dimap (either Right Left) (either Right Left) . right'@@ -94,8 +94,8 @@ -- assocE ('Right' c) = 'Right' ('Right' c) -- unassocE :: 'Either' a ('Either' b c) -> 'Either' ('Either' a b) c -- unassocE ('Left' a) = 'Left' ('Left' a)- -- unassocE ('Right' ('Left' b) = 'Left' ('Right' b)- -- unassocE ('Right' ('Right' c)) = 'Right' c)+ -- unassocE ('Right' ('Left' b)) = 'Left' ('Right' b)+ -- unassocE ('Right' ('Right' c)) = 'Right' c -- @ right' :: p a b -> p (Either c a) (Either c b) right' = dimap (either Right Left) (either Right Left) . left'@@ -297,8 +297,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)@@ -318,8 +318,8 @@ -- assocE ('Right' c) = 'Right' ('Right' c) -- unassocE :: 'Either' a ('Either' b c) -> 'Either' ('Either' a b) c -- unassocE ('Left' a) = 'Left' ('Left' a)- -- unassocE ('Right' ('Left' b) = 'Left' ('Right' b)- -- unassocE ('Right' ('Right' c)) = 'Right' c)+ -- unassocE ('Right' ('Left' b)) = 'Left' ('Right' b)+ -- unassocE ('Right' ('Right' c)) = 'Right' c -- @ unright :: p (Either d a) (Either d b) -> p a b unright = unleft . dimap (either Right Left) (either Right Left)@@ -348,6 +348,10 @@ instance (Cochoice p, Cochoice q) => Cochoice (Product p q) where unleft (Pair p q) = Pair (unleft p) (unleft q) unright (Pair p q) = Pair (unright p) (unright q)++instance Cochoice (Forget r) where+ unleft (Forget f) = Forget (f . Left)+ unright (Forget f) = Forget (f . Right) ---------------------------------------------------------------------------- -- * CotambaraSum
src/Data/Profunctor/Mapping.hs view
@@ -47,45 +47,51 @@ -- 'dimap' 'Data.Functor.Identity.Identity' 'Data.Functor.Identity.runIdentity' '.' 'map'' ≡ 'id' -- @ map' :: Functor f => p a b -> p (f a) (f b)- map' = roam collect+ map' = roam fmap - roam :: (forall f. (Distributive f, Applicative f)- => (a -> f b) -> s -> f t)+ roam :: ((a -> b) -> s -> t) -> p a b -> p s t- roam f = dimap (\s -> Bar $ \afb -> f afb s) lent . map'+ roam f = dimap (\s -> Bar $ \ab -> f ab s) lent . map' newtype Bar t b a = Bar- { runBar :: forall f. (Distributive f, Applicative f)- => (a -> f b) -> f t }+ { runBar :: (a -> b) -> t } deriving Functor lent :: Bar t a a -> t-lent m = runIdentity (runBar m Identity)+lent m = runBar m id instance Mapping (->) where map' = fmap- roam f g = runIdentity #. f (Identity #. g)+ roam f = f instance (Monad m, Distributive m) => Mapping (Kleisli m) where map' (Kleisli f) = Kleisli (collect f) #if __GLASGOW_HASKELL__ >= 710- roam f = Kleisli #. f .# runKleisli+ roam f = Kleisli #. genMap f .# runKleisli+#else+ -- We could actually use this implementation everywhere, but it's kind of a+ -- warty mess, and there have been rumblings of WrappedMonad deprecation.+ -- If/when GHC 7.8 moves out of the support window, this will vanish in a+ -- puff of cleanup.+ roam f = (Kleisli . (unwrapMonad .)) #. genMapW f .# ((WrapMonad .) . runKleisli)+ where+ genMapW+ :: (Monad m, Distributive m)+ => ((a -> b) -> s -> t)+ -> (a -> WrappedMonad m b) -> s -> WrappedMonad m t+ genMapW abst amb s = WrapMonad $ (\ab -> abst ab s) <$> distribute (unwrapMonad #. amb) #endif-{--For earlier versions, we'd like to use something like - roam f = (Kleisli . (unwrapMonad .)) #. f .# ((WrapMonad .) . runKleisli)--but it seems WrappedMonad doesn't have a Distributive instance.--}+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 #. f .# runStar+ roam f = Star #. genMap f .# runStar wanderMapping :: Mapping p => (forall f. Applicative f => (a -> f b) -> s -> f t) -> p a b -> p s t-wanderMapping f = roam f+wanderMapping f = roam ((runIdentity .) #. f .# (Identity .)) traverseMapping :: (Mapping p, Functor f) => p a b -> p (f a) (f b) traverseMapping = map'@@ -111,15 +117,14 @@ instance Profunctor p => Traversing (CofreeMapping p) where traverse' = map'- wander f = roam f+ 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 $ \afb -> f afb s))- (fmap lent .# getCompose) p+ dimap (Compose #. fmap (\s -> Bar $ \ab -> f ab s)) (fmap lent .# getCompose) p instance ProfunctorFunctor CofreeMapping where promap f (CofreeMapping p) = CofreeMapping (f p)@@ -150,7 +155,7 @@ instance Traversing (FreeMapping p) where traverse' = map'- wander f = roam f+ wander f = roam ((runIdentity .) #. f .# (Identity .)) instance Mapping (FreeMapping p) where map' (FreeMapping l m r) = FreeMapping (fmap l .# getCompose) m (Compose #. fmap r)