keys 3.11 → 3.12

raw patch · 5 files changed

+603/−17 lines, 5 filesdep +base-orphansdep +ghc-primdep +taggeddep ~basedep ~freedep ~semigroupoidsnew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: base-orphans, ghc-prim, tagged, void

Dependency ranges changed: base, free, semigroupoids

API changes (from Hackage documentation)

Files

• .travis.yml +131/−1
• CHANGELOG.markdown +10/−1
• cabal.project +5/−0
• keys.cabal +28/−7
• src/Data/Key.hs +429/−8

@@ -1,4 +1,15 @@-language: haskell+# 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:@@ -6,3 +17,122 @@     skip_join: true     template:       - "\x0313keys\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-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-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/keys-*.tar.gz ${DISTDIR}/+  - cd ${DISTDIR} || false+  - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;+  - "printf 'packages: keys-*/*.cabal\\n' > cabal.project"+  - cat cabal.project+++  # build & run tests, build benchmarks+  - cabal new-build -w ${HC} ${TEST} ${BENCH} all++  # cabal check+  - (cd keys-* && 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","--irc-channel=irc.freenode.org#haskell-lens","--no-no-tests-no-bench","--no-installed","cabal.project"]+# EOF

@@ -1,5 +1,14 @@+3.12 [2018.01.28]+-----------------+* Add instances for data types in `GHC.Generics`. Change the existing instances+  for `Data.Functor.Sum` to be consistent with those for `(GHC.Generics.:+:)`.+* Add instances for `Proxy` and `Tagged`.+* Add instances for `ZipList`.+* Add `MINIMAL` sets for `Zip` and `FoldableWithKey`.+* Allow `free-6`.+ 3.11---------+---- * Support for `comonad` 5 * Support for GHC 8 * Support for `transformers` 0.5

@@ -0,0 +1,5 @@+packages: .++-- use local semigroupoids checkout if found+--  git clone https://github.com/ekmett/semigroupoids.git+optional-packages: semigroupoids/

@@ -1,8 +1,8 @@ name:          keys category:      Data Structures, Containers-version:       3.11+version:       3.12 license:       BSD3-cabal-version: >= 1.6+cabal-version: >= 1.10 license-file:  LICENSE author:        Edward A. Kmett maintainer:    Edward A. Kmett <ekmett@gmail.com>@@ -11,27 +11,48 @@ bug-reports:   http://github.com/ekmett/keys/issues copyright:     Copyright (C) 2011-2016 Edward A. Kmett synopsis:      Keyed functors and containers-description:   Keyed functors and containers+description:   This package provides a bunch of ad hoc classes for accessing parts of a container.+               .+               In practice this package is largely subsumed by the+               <https://hackage.haskell.org/package/lens lens package>,+               but it is maintained for now as it has much+               simpler dependencies.+ build-type:    Simple-extra-source-files: .travis.yml CHANGELOG.markdown README.markdown+extra-source-files: .travis.yml CHANGELOG.markdown README.markdown cabal.project+tested-with:   GHC == 8.4.1, GHC == 8.2.2, GHC == 8.0.2, GHC == 7.10.3, GHC == 7.8.4, GHC == 7.6.3, GHC == 7.4.2  source-repository head   type: git   location: git://github.com/ekmett/keys.git  library+  default-language: Haskell2010+  other-extensions: CPP, FlexibleInstances, TypeOperators, TypeFamilies+   build-depends:     array                >= 0.3.0.2 && < 0.6,-    base                 >= 4       && < 5,+    base                 >= 4.5     && < 5,     comonad              >= 4       && < 6,     containers           >= 0.3     && < 0.6,-    free                 >= 4       && < 5,+    free                 >= 4       && < 6,     hashable             >= 1.1.2.3 && < 1.3,-    semigroupoids        >= 4       && < 6,+    semigroupoids        >= 5.2     && < 6,     semigroups           >= 0.8.3.1 && < 1,+    tagged               >= 0.7.3   && < 1,     transformers         >= 0.2     && < 0.6,     transformers-compat  >= 0.3     && < 1,     unordered-containers >= 0.2.4   && < 0.3++  if impl(ghc < 7.10)+    build-depends: void >= 0.4 && < 0.8++  if impl(ghc < 7.6)+    -- GHC.Generics lived in ghc-prim initially+    build-depends: ghc-prim == 0.2.*++  if impl(ghc < 8)+    build-depends: base-orphans >= 0.5.4 && < 0.6    exposed-modules:     Data.Key

@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE CPP #-} module Data.Key (@@ -83,7 +85,11 @@ import Data.Ix hiding (index) import Data.Map (Map) import qualified Data.Map as Map-import Data.Tree++#ifdef MIN_VERSION_base_orphans+import Data.Orphans ()+#endif+import Data.Proxy import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (fromJust, listToMaybe)@@ -93,8 +99,12 @@ import Data.Semigroup.Traversable import Data.Sequence (Seq, ViewL(EmptyL), viewl, (|>)) import qualified Data.Sequence as Seq+import Data.Tagged import Data.Traversable+import Data.Tree import qualified Data.List as List+import Data.Void+import GHC.Generics import Prelude hiding (lookup, zip, zipWith)  -- TODO: half of the functions manipulating Cofree and Free build the keys in the wrong order@@ -104,6 +114,17 @@ type instance Key (Free f) = Seq (Key f) type instance Key Tree = Seq Int type instance Key NonEmpty = Int+type instance Key U1 = Void+type instance Key V1 = Void+type instance Key Par1 = ()+type instance Key Proxy = Void+type instance Key (Tagged a) = ()+type instance Key (g :.: f) = (Key g, Key f)+type instance Key (f :*: g) = Either (Key f) (Key g)+type instance Key (f :+: g) = Either (Key f) (Key g)+type instance Key (Rec1 f) = Key f+type instance Key (M1 i c f) = Key f+type instance Key (K1 i c) = Void  -- * Keyed class Functor f => Keyed f where@@ -119,6 +140,69 @@ instance Keyed Tree where   mapWithKey f (Node a as) = Node (f Seq.empty a) (mapWithKey (mapWithKey . fmap f . flip (|>)) as) +instance Keyed U1 where+  mapWithKey _ U1 = U1++instance Keyed V1 where+  mapWithKey _ v = v `seq` undefined++instance Keyed Par1 where+  mapWithKey q = fmap (q ())++instance Keyed (K1 i c) where+  mapWithKey _ (K1 c) = K1 c++instance Keyed (Tagged a) where+  mapWithKey q (Tagged a) = Tagged (q () a)++instance Keyed Proxy where+  mapWithKey _ Proxy = Proxy++instance Keyed f => Keyed (M1 i c f) where+  mapWithKey q (M1 f) = M1 (mapWithKey q f)++instance Keyed f => Keyed (Rec1 f) where+  mapWithKey q (Rec1 f) = Rec1 (mapWithKey q f)++instance (Keyed g, Keyed f) => Keyed (f :*: g) where+  mapWithKey q (fa :*: ga) = mapWithKey (q . Left) fa :*: mapWithKey (q . Right) ga++instance (Keyed g, Keyed f) => Keyed (f :+: g) where+  mapWithKey q (L1 fa) = L1 (mapWithKey (q . Left) fa)+  mapWithKey q (R1 ga) = R1 (mapWithKey (q . Right) ga)++instance (Keyed g, Keyed f) => Keyed (g :.: f) where+  mapWithKey q = inComp (mapWithKey (mapWithKey . fmap q . (,)))++#if 0+mapWithKey :: (Key (g :.: f) -> a -> b) -> (g :.: f) a -> (g :.: f) b+           :: ((Key g, Key f) -> a -> b) -> (g :.: f) a -> (g :.: f) b++mapWithKey q+  = \ (Comp1 gfa) -> Comp1 (mapWithKey (\ gk -> mapWithKey (\ fk a -> q (gk, fk) a)) gfa)+  = inComp $ mapWithKey (\ gk -> mapWithKey (\ fk a -> q (gk, fk) a))+  = inComp $ mapWithKey (\ gk -> mapWithKey (\ fk -> q (gk, fk)))+  = inComp $ mapWithKey (\ gk -> mapWithKey (q . (gk,)))+  = inComp $ mapWithKey (\ gk -> mapWithKey . (q .) $ (gk,))+  = inComp $ mapWithKey (\ gk -> mapWithKey . (q .) $ (,) gk)+  = inComp (mapWithKey (mapWithKey . fmap q . (,)))++q   :: ((Key g, Key f) -> a -> b)+gfa :: g (f a)+gk  :: Key g+fk  :: Key f+#endif++-- |+--+-- Laws:+--+-- @+-- 'fmap' 'fst' ('zip' u u) = u+-- 'fmap' 'snd' ('zip' u u) = u+-- 'zip' ('fmap' 'fst' u) ('fmap' 'snd' u) = u+-- 'zip' ('flip' (,)) x y = 'zip' y x+-- @ class Functor f => Zip f where   zipWith :: (a -> b -> c) -> f a -> f b -> f c   zipWith f a b = uncurry f <$> zip a b@@ -130,12 +214,57 @@   zap :: f (a -> b) -> f a -> f b   zap = zipWith id +#if __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL zipWith | zip #-}+#endif+ instance Zip f => Zip (Cofree f) where   zipWith f (a :< as) (b :< bs) = f a b :< zipWith (zipWith f) as bs  instance Zip Tree where   zipWith f (Node a as) (Node b bs) = Node (f a b) (zipWith (zipWith f) as bs) +instance Zip Proxy where+  zipWith = liftA2++instance Zip (Tagged a) where+  zipWith = liftA2++instance Zip U1 where+  zipWith = liftA2++instance Zip V1 where+  zipWith _ v = v `seq` undefined++instance Zip Par1 where+  zipWith = liftA2++instance (Zip f, Zip g) => Zip (f :*: g) where+  zipWith h (fa :*: ga) (fa' :*: ga') =+    zipWith h fa fa' :*: zipWith h ga ga'++instance (Zip f, Zip g) => Zip (g :.: f) where+  zipWith = inComp2 . zipWith . zipWith++instance Zip f => Zip (Rec1 f) where+  zipWith f (Rec1 a) (Rec1 b) = Rec1 (zipWith f a b)++instance Zip f => Zip (M1 i c f) where+  zipWith f (M1 a) (M1 b) = M1 (zipWith f a b)++-- | Add post- and pre-processing+(<--) :: (b -> b') -> (a' -> a) -> ((a -> b) -> (a' -> b'))+(h <-- f) g = h . g . f++-- | Apply a unary function within the 'Comp1' constructor.+inComp :: (g (f a) -> g' (f' a')) -> ((g :.: f) a -> (g' :.: f') a')+inComp = Comp1 <-- unComp1++-- | Apply a binary function within the 'Comp1' constructor.+inComp2 :: (  g (f a)   -> g' (f' a')     -> g'' (f'' a''))+        -> ((g :.: f) a -> (g' :.: f') a' -> (g'' :.: f'') a'')+inComp2 = inComp <-- unComp1+ class (Keyed f, Zip f) => ZipWithKey f where   zipWithKey :: (Key f -> a -> b -> c) -> f a -> f b -> f c   zipWithKey f = zap . mapWithKey f@@ -149,6 +278,33 @@ instance ZipWithKey Tree where   zipWithKey f (Node a as) (Node b bs) = f Seq.empty a b `Node` zipWithKey (zipWithKey . fmap f . flip (|>)) as bs +instance ZipWithKey (Tagged a) where+  zipWithKey f = zipWith  (f ())++instance ZipWithKey Proxy where+  zipWithKey _ _ _ = Proxy++instance ZipWithKey U1 where+  zipWithKey _ _ _ = U1++instance ZipWithKey V1 where+  zipWithKey _ u v = u `seq` v `seq` undefined++instance ZipWithKey Par1 where+  zipWithKey f (Par1 a) (Par1 b) = Par1 (f () a b)++instance ZipWithKey f => ZipWithKey (Rec1 f) where+  zipWithKey f (Rec1 a) (Rec1 b) = Rec1 (zipWithKey f a b)++instance ZipWithKey f => ZipWithKey (M1 i c f) where+  zipWithKey f (M1 a) (M1 b) = M1 (zipWithKey f a b)++instance (ZipWithKey f, ZipWithKey g) => ZipWithKey (f :*: g) where+  zipWithKey f (as :*: bs) (cs :*: ds) = zipWithKey (f . Left) as cs :*: zipWithKey (f . Right) bs ds++instance (ZipWithKey f, ZipWithKey g) => ZipWithKey (g :.: f) where+  zipWithKey f (Comp1 xs) (Comp1 ys) = Comp1 $ zipWithKey (\a -> zipWithKey (\b -> f (a,b))) xs ys+ infixl 4 <#$>  (<#$>) :: Keyed f => (Key f -> a -> b) -> f a -> f b@@ -169,11 +325,41 @@       EmptyL -> a       k Seq.:< ks -> index (index as k) ks +instance Indexable (Tagged a) where+  index (Tagged a) () = a++instance Indexable Proxy where+  index Proxy = absurd+ instance Indexable Tree where   index (Node a as) key = case viewl key of       EmptyL -> a       k Seq.:< ks -> index (index as k) ks +instance Indexable U1 where+  index U1 = absurd++instance Indexable Par1 where+  index (Par1 a) () = a++instance Indexable f => Indexable (Rec1 f) where+  index (Rec1 f) a = index f a++instance Indexable f => Indexable (M1 i c f) where+  index (M1 f) a = index f a++instance Indexable (K1 i c) where+  index _ = absurd++instance (Indexable g, Indexable f) =>+         Indexable (f :*: g) where+  index (fa :*: _) (Left  fk) = fa ! fk+  index (_ :*: ga) (Right gk) = ga ! gk++instance (Indexable g, Indexable f) =>+         Indexable (g :.: f) where+  index (Comp1 gfa) (gk,fk) = gfa ! gk ! fk+ (!) :: Indexable f => f a -> Key f -> a (!) = index @@ -187,6 +373,12 @@     EmptyL -> Just a     k Seq.:< ks -> lookup k as >>= lookup ks +instance Lookup (Tagged a) where+  lookup () (Tagged a) = Just a++instance Lookup Proxy where+  lookup _ _ = Nothing+ instance Lookup Tree where   lookup key (Node a as) = case viewl key of     EmptyL -> Just a@@ -200,7 +392,27 @@     k Seq.:< ks -> lookup k as >>= lookup ks     _ -> Nothing +instance Lookup U1 where+  lookup _ _ = Nothing +instance Lookup Par1 where+  lookup = lookupDefault++instance Lookup f => Lookup (Rec1 f) where+  lookup k (Rec1 f) = lookup k f++instance Lookup f => Lookup (M1 i c f) where+  lookup k (M1 f) = lookup k f++instance Lookup (K1 i c) where+  lookup _ _ = Nothing++instance (Indexable g, Indexable f) => Lookup (f :*: g) where+  lookup = lookupDefault++instance (Indexable g, Indexable f) => Lookup (g :.: f) where+  lookup = lookupDefault+ lookupDefault :: Indexable f => Key f -> f a -> Maybe a lookupDefault k t = Just (index t k) @@ -230,6 +442,52 @@     k Seq.:< ks -> a   `Node` adjust (adjust f ks) k as     _           -> f a `Node` as +instance Adjustable (Tagged a) where+  adjust f _ (Tagged a) = Tagged (f a)+  replace _ a _ = Tagged a++instance Adjustable Proxy where+  adjust _ _ _ = Proxy+  replace _ _ _ = Proxy++instance Adjustable U1 where+  adjust _ _ _ = U1+  replace _ _ _ = U1++instance Adjustable Par1 where+  adjust h () = fmap h+  replace _ a _ = Par1 a++instance Adjustable f => Adjustable (Rec1 f) where+  adjust f k (Rec1 a) = Rec1 (adjust f k a)+  replace k a (Rec1 b) = Rec1 (replace k a b)++instance Adjustable f => Adjustable (M1 i c f) where+  adjust f k (M1 a) = M1 (adjust f k a)+  replace k a (M1 b) = M1 (replace k a b)++instance Adjustable (K1 i c) where+  adjust _ _ x = x+  replace _ _ x = x++instance (Adjustable f, Adjustable g) => Adjustable (f :+: g) where+  adjust h (Left a) (L1 fa) = L1 (adjust h a fa)+  adjust h (Right b) (R1 fb) = R1 (adjust h b fb)+  adjust _ _ x = x+  replace (Left a) v (L1 fa) = L1 (replace a v fa)+  replace (Right b) v (R1 fb) = R1 (replace b v fb)+  replace _ _ x = x++instance (Adjustable f, Adjustable g) => Adjustable (f :*: g) where+  adjust h (Left  fk) (fa :*: ga) = adjust h fk fa :*: ga+  adjust h (Right gk) (fa :*: ga) = fa :*: adjust h gk ga+  replace (Left  fk) a (fa :*: ga) = replace fk a fa :*: ga+  replace (Right gk) a (fa :*: ga) = fa :*: replace gk a ga++instance (Adjustable f, Adjustable g) => Adjustable (g :.: f) where+  adjust h (gk,fk) = inComp (adjust (adjust h fk) gk)+  replace (gk,fk) a = inComp (adjust (replace fk a) gk)+ -- * FoldableWithKey  class Foldable t => FoldableWithKey t where@@ -245,6 +503,10 @@   foldlWithKey :: (b -> Key t -> a -> b) -> b -> t a -> b   foldlWithKey f z t = appEndo (getDual (foldMapWithKey (\k a -> Dual (Endo (\b -> f b k a))) t)) z +#if __GLASGOW_HASKELL__ >= 708+  {-# MINIMAL foldMapWithKey | foldrWithKey #-}+#endif+ instance FoldableWithKey f => FoldableWithKey (Free f) where   foldMapWithKey f (Pure a) = f Seq.empty a   foldMapWithKey f (Free as) = foldMapWithKey (foldMapWithKey . fmap f . flip (|>)) as@@ -252,9 +514,40 @@ instance FoldableWithKey f => FoldableWithKey (Cofree f) where   foldMapWithKey f (a :< as) = f Seq.empty a `mappend` foldMapWithKey (foldMapWithKey . fmap f . flip (|>)) as +instance FoldableWithKey (Tagged a) where+  foldMapWithKey f (Tagged a) = f () a++instance FoldableWithKey Proxy where+  foldMapWithKey _ _ = mempty+ instance FoldableWithKey Tree where   foldMapWithKey f (Node a as) = f Seq.empty a `mappend` foldMapWithKey (foldMapWithKey . fmap f . flip (|>)) as +instance FoldableWithKey Par1 where+  foldMapWithKey f (Par1 a) = f () a++instance (FoldableWithKey f, FoldableWithKey g) => FoldableWithKey (f :*: g) where+  foldMapWithKey f (a :*: b) = foldMapWithKey (f . Left) a `mappend` foldMapWithKey (f . Right) b++instance (FoldableWithKey f, FoldableWithKey g) => FoldableWithKey (f :+: g) where+  foldMapWithKey f (L1 a) = foldMapWithKey (f . Left) a+  foldMapWithKey f (R1 a) = foldMapWithKey (f . Right) a++instance FoldableWithKey U1 where+  foldMapWithKey _ _ = mempty++instance FoldableWithKey V1 where+  foldMapWithKey _ v = v `seq` undefined++instance FoldableWithKey (K1 i c) where+  foldMapWithKey _ _ = mempty++instance FoldableWithKey f => FoldableWithKey (M1 i c f) where+  foldMapWithKey f (M1 a) = foldMapWithKey f a++instance FoldableWithKey f => FoldableWithKey (Rec1 f) where+  foldMapWithKey f (Rec1 a) = foldMapWithKey f a+ foldrWithKey' :: FoldableWithKey t => (Key t -> a -> b -> b) -> b -> t a -> b foldrWithKey' f z0 xs = foldlWithKey f' id xs z0   where f' k key x z = k $! f key x z@@ -327,6 +620,28 @@   foldMapWithKey1 f (Pure a) = f Seq.empty a   foldMapWithKey1 f (Free as) = foldMapWithKey1 (foldMapWithKey1 . fmap f . flip (|>)) as +instance FoldableWithKey1 (Tagged a) where+  foldMapWithKey1 f (Tagged a) = f () a++instance (FoldableWithKey1 f, FoldableWithKey1 g) => FoldableWithKey1 (f :*: g) where+  foldMapWithKey1 f (a :*: b) = foldMapWithKey1 (f . Left) a <> foldMapWithKey1 (f . Right) b++instance (FoldableWithKey1 f, FoldableWithKey1 g) => FoldableWithKey1 (f :+: g) where+  foldMapWithKey1 f (L1 a) = foldMapWithKey1 (f . Left) a+  foldMapWithKey1 f (R1 a) = foldMapWithKey1 (f . Right) a++instance FoldableWithKey1 V1 where+  foldMapWithKey1 _ v = v `seq` undefined++instance FoldableWithKey1 Par1 where+  foldMapWithKey1 f (Par1 a) = f () a++instance FoldableWithKey1 f => FoldableWithKey1 (M1 i c f) where+  foldMapWithKey1 f (M1 a) = foldMapWithKey1 f a++instance FoldableWithKey1 f => FoldableWithKey1 (Rec1 f) where+  foldMapWithKey1 f (Rec1 a) = foldMapWithKey1 f a+ newtype Act f a = Act { getAct :: f a }  instance Apply f => Semigroup (Act f a) where@@ -356,6 +671,12 @@   mapWithKeyM :: Monad m => (Key t -> a -> m b) -> t a -> m (t b)   mapWithKeyM f = unwrapMonad . traverseWithKey (fmap WrapMonad . f) +instance TraversableWithKey (Tagged a) where+  traverseWithKey f (Tagged a) = Tagged <$> f () a++instance TraversableWithKey Proxy where+  traverseWithKey _ _ = pure Proxy+ instance TraversableWithKey f => TraversableWithKey (Cofree f) where   traverseWithKey f (a :< as) = (:<) <$> f Seq.empty a <*> traverseWithKey (traverseWithKey . fmap f . flip (|>)) as @@ -366,6 +687,31 @@   traverseWithKey f (Pure a) = Pure <$> f Seq.empty a   traverseWithKey f (Free as) = Free <$> traverseWithKey (traverseWithKey . fmap f . flip (|>)) as +instance (TraversableWithKey f, TraversableWithKey g) => TraversableWithKey (f :*: g) where+  traverseWithKey f (a :*: b) = (:*:) <$> traverseWithKey (f . Left) a <*> traverseWithKey (f . Right) b++instance (TraversableWithKey f, TraversableWithKey g) => TraversableWithKey (f :+: g) where+  traverseWithKey f (L1 as) = L1 <$> traverseWithKey (f . Left) as+  traverseWithKey f (R1 bs) = R1 <$> traverseWithKey (f . Right) bs++instance TraversableWithKey Par1 where+  traverseWithKey f (Par1 a) = Par1 <$> f () a++instance TraversableWithKey U1 where+  traverseWithKey _ U1 = pure U1++instance TraversableWithKey V1 where+  traverseWithKey _ v = v `seq` undefined++instance TraversableWithKey (K1 i c) where+  traverseWithKey _ (K1 p) = pure (K1 p)++instance TraversableWithKey f => TraversableWithKey (Rec1 f) where+  traverseWithKey f (Rec1 a) = Rec1 <$> traverseWithKey f a++instance TraversableWithKey f => TraversableWithKey (M1 i c f) where+  traverseWithKey f (M1 a) = M1 <$> traverseWithKey f a+ forWithKey :: (TraversableWithKey t, Applicative f) => t a -> (Key t -> a -> f b) -> f (t b) forWithKey = flip traverseWithKey {-# INLINE forWithKey #-}@@ -432,6 +778,9 @@ class (Traversable1 t, FoldableWithKey1 t, TraversableWithKey t) => TraversableWithKey1 t where   traverseWithKey1 :: Apply f => (Key t -> a -> f b) -> t a -> f (t b) +instance TraversableWithKey1 (Tagged a) where+  traverseWithKey1 f (Tagged a) = Tagged <$> f () a+ -- instance TraversableWithKey f => TraversableWithKey1 (Cofree f) where instance TraversableWithKey1 f => TraversableWithKey1 (Cofree f) where   traverseWithKey1 f (a :< as) = (:<) <$> f Seq.empty a <.> traverseWithKey1 (traverseWithKey1 . fmap f . flip (|>)) as@@ -444,6 +793,25 @@   traverseWithKey1 f (Pure a) = Pure <$> f Seq.empty a   traverseWithKey1 f (Free as) = Free <$> traverseWithKey1 (traverseWithKey1 . fmap f . flip (|>)) as +instance TraversableWithKey1 Par1 where+  traverseWithKey1 f (Par1 a) = Par1 <$> f () a++instance TraversableWithKey1 f => TraversableWithKey1 (Rec1 f) where+  traverseWithKey1 f (Rec1 a) = Rec1 <$> traverseWithKey1 f a++instance TraversableWithKey1 f => TraversableWithKey1 (M1 i c f) where+  traverseWithKey1 f (M1 a) = M1 <$> traverseWithKey1 f a++instance TraversableWithKey1 V1 where+  traverseWithKey1 _ v = v `seq` undefined++instance (TraversableWithKey1 f, TraversableWithKey1 g) => TraversableWithKey1 (f :*: g) where+  traverseWithKey1 f (a :*: b) = (:*:) <$> traverseWithKey1 (f . Left) a <.> traverseWithKey1 (f . Right) b++instance (TraversableWithKey1 f, TraversableWithKey1 g) => TraversableWithKey1 (f :+: g) where+  traverseWithKey1 f (L1 as) = L1 <$> traverseWithKey1 (f . Left) as+  traverseWithKey1 f (R1 bs) = R1 <$> traverseWithKey1 (f . Right) bs+ foldMapWithKey1Default :: (TraversableWithKey1 t, Semigroup m) => (Key t -> a -> m) -> t a -> m foldMapWithKey1Default f = getConst . traverseWithKey1 (\k -> Const . f k) {-# INLINE foldMapWithKey1Default #-}@@ -662,8 +1030,33 @@   adjust _ _ [] = []   adjust f n (x:xs) = n' `seq` x : adjust f n' xs where n' = n - 1 +type instance Key ZipList = Int +instance Zip ZipList where+  zip       (ZipList xs) (ZipList ys) = ZipList (zip xs ys)+  zipWith f (ZipList xs) (ZipList ys) = ZipList (zipWith f xs ys) +instance ZipWithKey ZipList where+  zipWithKey f (ZipList xs) (ZipList ys) = ZipList (zipWithKey f xs ys)++instance Keyed ZipList where+  mapWithKey f = ZipList . mapWithKey f . getZipList++instance FoldableWithKey ZipList where+  foldrWithKey f z = foldrWithKey f z . getZipList++instance TraversableWithKey ZipList where+  traverseWithKey f = fmap ZipList . traverseWithKey f . getZipList++instance Indexable ZipList where+  index (ZipList xs) i = index xs i++instance Lookup ZipList where+  lookup i = lookup i . getZipList++instance Adjustable ZipList where+  adjust f i = ZipList . adjust f i . getZipList+ instance Zip NonEmpty where   zipWith = NonEmpty.zipWith @@ -778,19 +1171,47 @@   adjust f i arr  = arr Array.// [(i, f (arr Array.! i))]   replace i b arr = arr Array.// [(i, b)] -type instance Key (Functor.Sum f g) = (Key f, Key g)+type instance Key (Functor.Sum f g) = Either (Key f) (Key g) +instance (Keyed f, Keyed g) => Keyed (Functor.Sum f g) where+  mapWithKey f (Functor.InL a) = Functor.InL (mapWithKey (f . Left)  a)+  mapWithKey f (Functor.InR b) = Functor.InR (mapWithKey (f . Right) b)+ instance (Indexable f, Indexable g) => Indexable (Functor.Sum f g) where-  index (Functor.InL a) (x,_) = index a x-  index (Functor.InR b) (_,y) = index b y+  index (Functor.InL a) (Left  x) = index a x+  index (Functor.InL _) (Right _) = error "InL indexed with a Right key"+  index (Functor.InR b) (Right y) = index b y+  index (Functor.InR _) (Left  _) = error "InR indexed with a Left key"  instance (Lookup f, Lookup g) => Lookup (Functor.Sum f g) where-  lookup (x, _) (Functor.InL a) = lookup x a-  lookup (_, y) (Functor.InR b) = lookup y b+  lookup (Left  x) (Functor.InL a) = lookup x a+  lookup (Right y) (Functor.InR b) = lookup y b+  lookup _         _               = Nothing  instance (Adjustable f, Adjustable g) => Adjustable (Functor.Sum f g) where-  adjust f (x,_) (Functor.InL a) = Functor.InL (adjust f x a)-  adjust f (_,y) (Functor.InR b) = Functor.InR (adjust f y b)+  adjust f (Left  x) (Functor.InL a) = Functor.InL (adjust f x a)+  adjust f (Right y) (Functor.InR b) = Functor.InR (adjust f y b)+  adjust _ _         x               = x++  replace (Left  x) v (Functor.InL a) = Functor.InL (replace x v a)+  replace (Right y) v (Functor.InR b) = Functor.InR (replace y v b)+  replace _         _ x               = x++instance (FoldableWithKey f, FoldableWithKey g) => FoldableWithKey (Functor.Sum f g) where+  foldMapWithKey f (Functor.InL a) = foldMapWithKey (f . Left)  a+  foldMapWithKey f (Functor.InR b) = foldMapWithKey (f . Right) b++instance (FoldableWithKey1 f, FoldableWithKey1 g) => FoldableWithKey1 (Functor.Sum f g) where+  foldMapWithKey1 f (Functor.InL a) = foldMapWithKey1 (f . Left)  a+  foldMapWithKey1 f (Functor.InR b) = foldMapWithKey1 (f . Right) b++instance (TraversableWithKey f, TraversableWithKey g) => TraversableWithKey (Functor.Sum f g) where+  traverseWithKey f (Functor.InL a) = Functor.InL <$> traverseWithKey (f . Left)  a+  traverseWithKey f (Functor.InR b) = Functor.InR <$> traverseWithKey (f . Right) b++instance (TraversableWithKey1 f, TraversableWithKey1 g) => TraversableWithKey1 (Functor.Sum f g) where+  traverseWithKey1 f (Functor.InL a) = Functor.InL <$> traverseWithKey1 (f . Left)  a+  traverseWithKey1 f (Functor.InR b) = Functor.InR <$> traverseWithKey1 (f . Right) b  type instance Key (Product f g) = Either (Key f) (Key g)