packages feed

indexed-traversable-instances (empty) → 0.1

raw patch · 7 files changed

+501/−0 lines, 7 filesdep +QuickCheckdep +basedep +containers

Dependencies added: QuickCheck, base, containers, criterion, indexed-traversable, indexed-traversable-instances, quickcheck-instances, tagged, tasty, tasty-quickcheck, transformers, unordered-containers, vector

Files

+ Changelog.md view
@@ -0,0 +1,3 @@+# 0.1 [2020-12-15]++- Split out and combine this package functionality from `lens` and `optics`
+ LICENSE view
@@ -0,0 +1,26 @@+Copyright 2012-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.
+ bench/folds.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveFunctor    #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes       #-}+module Main (main) where++import Criterion.Main (bench, bgroup, defaultMain, nf)++import qualified Data.Foldable     as F+import qualified Data.HashMap.Lazy as HM+import qualified Data.Map          as Map+import qualified Data.Sequence     as Seq+import qualified Data.Vector       as V++import Data.Foldable.WithIndex+import Data.Functor.WithIndex.Instances ()++main :: IO ()+main = defaultMain+  [ bgroup "vector"+    [ bgroup "itoList"+      [ bench "native"     $ nf (V.toList . V.indexed) v+      , bench "itoList"    $ nf itoList v+      ]+    ]+#if MIN_VERSION_containers(0,5,0)+  , bgroup "sequence"+    [ bgroup "itoList"+      [ bench "native"     $ nf (F.toList . Seq.mapWithIndex (,)) s+      , bench "itoList"    $ nf itoList s+      ]+    ]+#endif+  , bgroup "list"+    [ bgroup "itoList"+      [ bench "native"     $ nf (zip [(0::Int)..]) l+      , bench "itoList"    $ nf itoList l+      ]+    ]+  , bgroup "map"+    [  bgroup "itoList"+      [ bench "native"     $ nf Map.toList m+      , bench "itoList"    $ nf itoList m+      ]+    ]+  , bgroup "hashmap"+    [ bgroup "itoList"+      [ bench "native"     $ nf HM.toList h+      , bench "itoList"    $ nf itoList h+      ]+    ]+  ]++l :: [Int]+l = [0..10000]+{-# NOINLINE l #-}++h :: HM.HashMap Int Int+h = HM.fromList $ zip l l+{-# NOINLINE h #-}++m :: Map.Map Int Int+m = Map.fromList $ zip l l+{-# NOINLINE m #-}++s :: Seq.Seq Int+s = Seq.fromList l+{-# NOINLINE s #-}++v :: V.Vector Int+v = V.fromList l+{-# NOINLINE v #-}
+ bench/traversals.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE CPP              #-}+{-# LANGUAGE DeriveFunctor    #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes       #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Main (main) where++import Criterion.Main (bench, bgroup, defaultMain, nf)++import qualified Data.HashMap.Lazy as HM+import qualified Data.Map          as Map+import qualified Data.Sequence     as Seq+import qualified Data.Vector       as V++import Data.Functor.WithIndex           (imap)+import Data.Functor.WithIndex.Instances ()+import Data.Traversable.WithIndex       (imapDefault)++main :: IO ()+main = defaultMain+  [ bgroup "vector"+    [ bgroup "imap"+      [ bench "native"   $ nf (V.imap           (\i x -> x + i + 100)) v+      , bench "imap"     $ nf (imap             (\i x -> x + i + 100)) v+      , bench "default"  $ nf (imapDefault      (\i x -> x + i + 100)) v+      ]+    ]+#if MIN_VERSION_containers(0,5,0)+  , bgroup "sequence"+    [  bgroup "imap"+      [ bench "native"   $ nf (Seq.mapWithIndex (\i x -> x + i + 100)) s+      , bench "imap"     $ nf (imap             (\i x -> x + i + 100)) s+      , bench "default"  $ nf (imapDefault      (\i x -> x + i + 100)) s+      ]+    ]+#endif+  , bgroup "list"+    [ bgroup "imap"+      [ bench "native"   $ nf (zipWith          (\i x -> x + i + 100) [0..]) l+      , bench "imap"     $ nf (imap             (\i x -> x + i + 100))       l+      , bench "default"  $ nf (imapDefault      (\i x -> x + i + 100))       l+      ]+    ]+  , bgroup "map"+    [ bgroup "imap"+      [ bench "native"   $ nf (Map.mapWithKey   (\i x -> x + i + 100)) m+      , bench "imap"     $ nf (imap             (\i x -> x + i + 100)) m+      , bench "default"  $ nf (imapDefault      (\i x -> x + i + 100)) m+      ]+    ]+  , bgroup "hashmap"+    [ bgroup "imap"+      [ bench "native"   $ nf (HM.mapWithKey    (\i x -> x + i + 100)) h+      , bench "imap"     $ nf (imap             (\i x -> x + i + 100)) h+      , bench "default"  $ nf (imapDefault      (\i x -> x + i + 100)) h+      ]+    ]+  ]++l :: [Int]+l = [0..10000]+{-# NOINLINE l #-}++h :: HM.HashMap Int Int+h = HM.fromList $ zip l l+{-# NOINLINE h #-}++m :: Map.Map Int Int+m = Map.fromList $ zip l l+{-# NOINLINE m #-}++s :: Seq.Seq Int+s = Seq.fromList l+{-# NOINLINE s #-}++v :: V.Vector Int+v = V.fromList l+{-# NOINLINE v #-}
+ indexed-traversable-instances.cabal view
@@ -0,0 +1,104 @@+cabal-version:      1.12+name:               indexed-traversable-instances+version:            0.1+build-type:         Simple+license:            BSD2+license-file:       LICENSE+category:           Data+maintainer:         Oleg Grenrus <oleg.grenrus@iki.fi>+author:             Edward Kmett+synopsis:+  More instances of FunctorWithIndex, FoldableWithIndex, TraversableWithIndex++description:+  This package provides extra instances for type-classes in the [indexed-traversable](https://hackage.haskell.org/package/indexed-traversable) package.+  .+  The intention is to keep this package minimal;+  it provides instances that formely existed in @lens@ or @optics-extra@.+  We recommend putting other instances directly into their defining packages.+  The @indexed-traversable@ package is light, having only GHC boot libraries+  as its dependencies.++extra-source-files: Changelog.md+tested-with:+  GHC ==7.4.2+   || ==7.6.3+   || ==7.8.4+   || ==7.10.3+   || ==8.0.2+   || ==8.2.2+   || ==8.4.4+   || ==8.6.5+   || ==8.8.4+   || ==8.10.2++source-repository head+  type:     git+  location: https://github.com/haskellari/indexed-traversable+  subdir:   indexed-traversable-instances++library+  default-language: Haskell2010+  ghc-options:      -Wall+  hs-source-dirs:   src+  build-depends:+      base                  >=4.5      && <4.16+    , indexed-traversable   >=0.1      && <0.2+    , tagged                >=0.8.6    && <0.9+    , unordered-containers  >=0.2.8.0  && <0.3+    , vector                >=0.12.1.2 && <0.13++  exposed-modules:  Data.Functor.WithIndex.Instances++test-suite indexed-tests+  type:             exitcode-stdio-1.0+  default-language: Haskell2010+  ghc-options:      -Wall+  hs-source-dirs:   tests+  main-is:          main.hs+  build-depends:+      base+    , containers+    , indexed-traversable+    , indexed-traversable-instances+    , transformers+    , unordered-containers+    , vector++  build-depends:+      QuickCheck            >=2.14.2   && <2.15+    , quickcheck-instances  >=0.3.25.1 && <0.4+    , tasty                 >=1.2.3    && <1.5+    , tasty-quickcheck      >=0.10.1.1 && <0.11++benchmark folds+  type:             exitcode-stdio-1.0+  main-is:          folds.hs+  default-language: Haskell2010+  hs-source-dirs:   bench+  ghc-options:      -Wall+  build-depends:+      base+    , containers+    , indexed-traversable+    , indexed-traversable-instances+    , unordered-containers+    , vector++  build-depends:    criterion >=1.5.9.0 && <1.6++benchmark traversals+  type:             exitcode-stdio-1.0+  main-is:          traversals.hs+  default-language: Haskell2010+  hs-source-dirs:   bench+  ghc-options:      -Wall+  build-depends:+      base+    , containers+    , indexed-traversable+    , indexed-traversable-instances+    , unordered-containers+    , vector++  build-depends:    criterion >=1.5.9.0 && <1.6
+ src/Data/Functor/WithIndex/Instances.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE BangPatterns           #-}+{-# LANGUAGE CPP                    #-}+{-# LANGUAGE FlexibleInstances      #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances   #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++#if __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy            #-}+#endif++#if __GLASGOW_HASKELL__ >= 706+{-# LANGUAGE PolyKinds              #-}+#endif+-- | Extra instances for 'FunctorWithIndex', 'FoldableWithIndex',+-- and 'TraversableWithIndex' type classes.+module Data.Functor.WithIndex.Instances () where++import Prelude (Int, flip, (.))++import Control.Applicative ((<$>))+import Data.HashMap.Lazy   (HashMap)+import Data.Tagged         (Tagged (..))+import Data.Vector         (Vector)++import qualified Data.HashMap.Lazy as HM+import qualified Data.Vector       as V++import Data.Foldable.WithIndex+import Data.Functor.WithIndex+import Data.Traversable.WithIndex++-------------------------------------------------------------------------------+-- tagged+-------------------------------------------------------------------------------++instance FunctorWithIndex () (Tagged a) where+  imap f (Tagged a) = Tagged (f () a)+  {-# INLINE imap #-}++instance FoldableWithIndex () (Tagged a) where+  ifoldMap f (Tagged a) = f () a+  {-# INLINE ifoldMap #-}++instance TraversableWithIndex () (Tagged a) where+  itraverse f (Tagged a) = Tagged <$> f () a+  {-# INLINE itraverse #-}++-------------------------------------------------------------------------------+-- vector+-------------------------------------------------------------------------------++instance FunctorWithIndex Int Vector where+  imap = V.imap+  {-# INLINE imap #-}+instance FoldableWithIndex Int Vector where+  ifoldr = V.ifoldr+  {-# INLINE ifoldr #-}+  ifoldl = V.ifoldl . flip+  {-# INLINE ifoldl #-}+  ifoldr' = V.ifoldr'+  {-# INLINE ifoldr' #-}+  ifoldl' = V.ifoldl' . flip+  {-# INLINE ifoldl' #-}+instance TraversableWithIndex Int Vector where+  itraverse f v =+    let !n = V.length v in V.fromListN n <$> itraverse f (V.toList v)+  {-# INLINE itraverse #-}++-------------------------------------------------------------------------------+-- unordered-containers+-------------------------------------------------------------------------------++instance FunctorWithIndex k (HashMap k) where+  imap = HM.mapWithKey+  {-# INLINE imap #-}+instance FoldableWithIndex k (HashMap k) where+  ifoldr  = HM.foldrWithKey+  ifoldl' = HM.foldlWithKey' . flip+  {-# INLINE ifoldr #-}+  {-# INLINE ifoldl' #-}+instance TraversableWithIndex k (HashMap k) where+  itraverse = HM.traverseWithKey+  {-# INLINE itraverse #-}
+ tests/main.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE RankNTypes          #-}+{-# LANGUAGE ScopedTypeVariables #-}+module Main (main) where++import Control.Applicative   (Const (..))+import Data.Foldable         (toList)+import Data.Functor.Identity (Identity (..))+import Data.Monoid           (Endo (..), Monoid (..))+import Test.QuickCheck+       (Arbitrary, CoArbitrary, Fun, Function, Property, applyFun, (===))+import Test.QuickCheck.Poly  (A, B)+import Test.Tasty            (TestTree, defaultMain, testGroup)+import Test.Tasty.QuickCheck (testProperty)++import qualified Data.HashMap.Lazy as HM+import qualified Data.Map          as Map+import qualified Data.Sequence     as Seq+import qualified Data.Vector       as V++#if MIN_VERSION_containers(0,6,3)+-- traverseWithKey and Foldable broken before+import qualified Data.IntMap as IntMap+#endif++import Data.Functor.WithIndex.Instances ()+import Test.QuickCheck.Instances ()++import Data.Foldable.WithIndex+import Data.Functor.WithIndex+import Data.Traversable.WithIndex++#if MIN_VERSION_base(4,7,0)+import Data.Typeable (Typeable, typeRep)+#else+import Data.Typeable (TypeRep, Typeable1, typeOf1)++#define Typeable Typeable1++typeRep :: forall f i. Typeable1 f => Tests i f -> TypeRep+typeRep _ = typeOf1 (undefined :: f Int)+#endif++-------------------------------------------------------------------------------+-- Main+-------------------------------------------------------------------------------++main :: IO ()+main = defaultMain $ testGroup "tests"+    [ battery $ mkT $ zipWith const [0 ..]+    , battery $ mkT (Map.keys :: forall a. Map.Map I a -> [I])+    , battery $ mkT (HM.keys :: forall a. HM.HashMap I a -> [I])+    , battery $ mkT (zipWith const [0 ..] . toList :: forall a. Seq.Seq a -> [Int])+    , battery $ mkT $ zipWith const [0 ..] . V.toList+#if MIN_VERSION_containers(0,6,3)+    , battery $ mkT IntMap.keys+#endif+    ]++-------------------------------------------------------------------------------+-- Test battery+-------------------------------------------------------------------------------++data Tests i f = T+    { indices :: forall a. f a -> [i]+    }++mkT :: FunctorWithIndex i f => (forall a. f a -> [i]) -> Tests i f+mkT = T++type I = Int++battery+    :: forall f i. (Typeable f, TraversableWithIndex i f+        , Arbitrary (f A), Show (f A)+        , Show (f B), Eq (f B)+        , Function i, CoArbitrary i, Show i, Eq i+        )+    => Tests i f+    -> TestTree+battery t = testGroup name+    [ testProperty "imapDefault" $+        let prop :: Fun (i, A) B -> f A -> Property+            prop f' xs = imap f xs === imapDefault f xs where+                f i a = applyFun f' (i, a)++        in prop++    , testProperty "ifoldMapDefault" $+        let prop :: Fun (i, A) [B] -> f A -> Property+            prop f' xs = ifoldMap f xs === ifoldMapDefault f xs where+                f i a = applyFun f' (i, a)++        in prop++    , testProperty "ifoldrDefault" $+        let prop :: Fun (i, A, B) B -> B -> f A -> Property+            prop f' b xs = ifoldr f b xs === ifoldrDefault f b xs where+                f i x y = applyFun f' (i, x, y)++        in prop++    , testProperty "ifoldl'Default" $+        let prop :: Fun (i, B, A) B -> B -> f A -> Property+            prop f' b xs = ifoldl' f b xs === ifoldl'Default f b xs where+                f i x y = applyFun f' (i, x, y)++        in prop++    , testProperty "toList" $+        let prop :: f A -> Property+            prop xs = toList xs === map snd (itoList xs)++        in prop++    , testProperty "indices" $+        let prop :: f A -> Property+            prop xs = indices t xs === map fst (itoList xs)++        in prop+    ]+  where+    name = show (typeRep t)++-------------------------------------------------------------------------------+-- Defaults+-------------------------------------------------------------------------------++ifoldrDefault :: FoldableWithIndex i f => (i -> a -> b -> b) -> b -> f a -> b+ifoldrDefault f z t = appEndo (ifoldMap (\i -> Endo . f i) t) z++ifoldl'Default :: FoldableWithIndex i f => (i -> b -> a -> b) -> b -> f a -> b+ifoldl'Default f z0 xs = ifoldr f' id xs z0+    where f' i x k z = k $! f i z x