foldable1-classes-compat (empty) → 0.1

raw patch · 9 files changed

+1345/−0 lines, 9 filesdep +QuickCheckdep +basedep +base-orphanssetup-changed

Dependencies added: QuickCheck, base, base-orphans, bifunctor-classes-compat, containers, criterion, deepseq, foldable1-classes-compat, generic-deriving, ghc-prim, quickcheck-instances, semigroups, tagged, test-framework, test-framework-quickcheck2, transformers, transformers-compat

Files

CHANGELOG.markdown +6/−0
LICENSE +31/−0
README.markdown +24/−0
Setup.hs +2/−0
bench/Bench.hs +178/−0
foldable1-classes-compat.cabal +148/−0
src/Data/Bifoldable1.hs +64/−0
src/Data/Foldable1.hs +653/−0
test/Tests.hs +239/−0

+ CHANGELOG.markdown view

@@ -0,0 +1,6 @@+# Revision history for foldable1-classes-compat++## 0.1 -- 2023-02-24++* Backport the `Foldable1` and `Bifoldable1` type classes that were introduced+  in `base-4.18.0.0` (GHC 9.6).

+ LICENSE view

@@ -0,0 +1,31 @@+Copyright (c) Edward Kmett, Oleg Grenrus++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Don Stewart nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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 COPYRIGHT+OWNER 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.

+ README.markdown view

@@ -0,0 +1,24 @@+# `foldable1-classes-compat`+[![Hackage](https://img.shields.io/hackage/v/foldable1-classes-compat.svg)][Hackage: foldable1-classes-compat]+[![Hackage Dependencies](https://img.shields.io/hackage-deps/v/foldable1-classes-compat.svg)](http://packdeps.haskellers.com/reverse/foldable1-classes-compat)+[![Haskell Programming Language](https://img.shields.io/badge/language-Haskell-blue.svg)][Haskell.org]+[![BSD3 License](http://img.shields.io/badge/license-BSD3-brightgreen.svg)][tl;dr Legal: BSD3]+[![Build](https://github.com/haskell-compat/foldable1-classes-compat/workflows/Haskell-CI/badge.svg)](https://github.com/haskell-compat/foldable1-classes-compat/actions?query=workflow%3AHaskell-CI)++[Hackage: foldable1-classes-compat]:+  http://hackage.haskell.org/package/foldable1-classes-compat+  "foldable1-classes-compat package on Hackage"+[Haskell.org]:+  http://www.haskell.org+  "The Haskell Programming Language"+[tl;dr Legal: BSD3]:+  https://tldrlegal.com/license/bsd-3-clause-license-%28revised%29+  "BSD 3-Clause License (Revised)"++A compatibility package for the `Foldable1` and `Bifoldable1` type classes,+which were introduced in `base-4.18.0.0` (GHC 9.6.1). For more information, see+[this Core Libraries Committee+proposal](https://github.com/haskell/core-libraries-committee/issues/9).++`Foldable1` and `Bifoldable1` classify non-empty data structures that can be+folded to a summary value.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ bench/Bench.hs view

@@ -0,0 +1,178 @@+{-# LANGUAGE CPP            #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor  #-}++#if MIN_VERSION_base(4,18,0)+# define HAS_FOLDABLE1_CONTAINERS MIN_VERSION_containers(0,6,7)+#else+# define HAS_FOLDABLE1_CONTAINERS 1+#endif++module Main (main) where++import Prelude hiding (foldl1, head, last, maximum)++import Control.DeepSeq    (NFData (..))+import Criterion.Main+import qualified Data.Foldable as F (Foldable)+import Data.Foldable1+import Data.List.NonEmpty (NonEmpty (..))+import Data.Semigroup     (Min (..))++#if HAS_FOLDABLE1_CONTAINERS+import Data.Tree          (Tree (..))+#endif++input :: NonEmpty Int+input = 1 :| take 10000000 [2 .. ]++#if HAS_FOLDABLE1_CONTAINERS+tree :: Tree Int+tree = go 7 0 where+    go :: Int -> Int -> Tree Int+    go n x+        | n <= 0    = Node x []+        | otherwise = Node x [ go (pred n) (x * 10 + x') | x' <- [0 .. 9] ]+#endif++main :: IO ()+main = defaultMain+    -- NonEmpty left folds+    [ env (return input) $ \ne -> bgroup "NonEmpty-vanilla"+        [ bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) ne+        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) ne+        , bench "foldl1' min"       $ whnf (foldl1' min) ne+        , bench "foldl1 min"        $ whnf (foldl1 min) ne+        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) ne+        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) ne+        ]+    , env (return $ NE1 input) $ \ne -> bgroup "NonEmpty-foldMap1"+        [ bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) ne+        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) ne+        , bench "foldl1' min"       $ whnf (foldl1' min) ne+        , bench "foldl1 min"        $ whnf (foldl1 min) ne+        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) ne+        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) ne+        ]+    , env (return $ NE3 input) $ \ne -> bgroup "NonEmpty-foldrMap1"+        [ bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) ne+        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) ne+        , bench "foldl1' min"       $ whnf (foldl1' min) ne+        , bench "foldl1 min"        $ whnf (foldl1 min) ne+        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) ne+        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) ne+        ]++#if HAS_FOLDABLE1_CONTAINERS+    -- Trees+    , env (return tree) $ \tr -> bgroup "Tree-vanilla"+        [ bench "head" $ whnf head tr+        , bench "last" $ whnf last tr+        , bench "maximum" $ whnf maximum tr+        , bench "maximum'" $ whnf (foldl1' max) tr++        , bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) tr+        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) tr+        , bench "foldl1' min"       $ whnf (foldl1' min) tr+        , bench "foldl1 min"        $ whnf (foldl1 min) tr+        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) tr+        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) tr+        ]+    , env (return $ Tree1 tree) $ \tr -> bgroup "Tree-foldMap1"+        [ bench "head" $ whnf head tr+        , bench "last" $ whnf last tr+        , bench "maximum" $ whnf maximum tr+        , bench "maximum'" $ whnf (foldl1' max) tr++        , bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) tr+        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) tr+        , bench "foldl1' min"       $ whnf (foldl1' min) tr+        , bench "foldl1 min"        $ whnf (foldl1 min) tr+        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) tr+        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) tr+        ]+    , env (return $ Tree3 tree) $ \tr -> bgroup "Tree-foldr1Map"+        [ bench "head" $ whnf head tr+        , bench "last" $ whnf last tr+        , bench "maximum" $ whnf maximum tr+        , bench "maximum'" $ whnf (foldl1' max) tr++        , bench "foldMap1 Min"      $ whnf (getMin . foldMap1 Min) tr+        , bench "foldMap1' Min"     $ whnf (getMin . foldMap1' Min) tr+        , bench "foldl1' min"       $ whnf (foldl1' min) tr+        , bench "foldl1 min"        $ whnf (foldl1 min) tr+        , bench "foldlMap1' id min" $ whnf (foldlMap1' id min) tr+        , bench "foldlMap1 id min"  $ whnf (foldlMap1 id min) tr+        ]+#endif+    ]++-------------------------------------------------------------------------------+-- NonEmpty variants+-------------------------------------------------------------------------------++-- Using foldMap1 only+newtype NE1 a = NE1 (NonEmpty a)+  deriving (Functor, F.Foldable)++instance NFData a => NFData (NE1 a) where+    rnf (NE1 xs) = rnf xs++instance Foldable1 NE1 where+    foldMap1 f (NE1 xs) = foldMap1 f xs++-- Using toNonEmpty+-- newtype NE2 a = NE2 (NonEmpty a)+--   deriving (Functor, F.Foldable)+--+-- instance NFData a => NFData (NE2 a) where+--     rnf (NE2 xs) = rnf xs+--+-- instance Foldable1 NE2 where+--     toNonEmpty (NE2 xs) = toNonEmpty xs++-- Using to foldrMap1+newtype NE3 a = NE3 (NonEmpty a)+  deriving (Functor, F.Foldable)++instance NFData a => NFData (NE3 a) where+    rnf (NE3 xs) = rnf xs++instance Foldable1 NE3 where+    foldrMap1 g f (NE3 xs) = foldrMap1 g f xs++#if HAS_FOLDABLE1_CONTAINERS+-------------------------------------------------------------------------------+-- Tree variants+-------------------------------------------------------------------------------++-- Using foldMap1 only+newtype Tree1 a = Tree1 (Tree a)+  deriving (Functor, F.Foldable)++instance NFData a => NFData (Tree1 a) where+    rnf (Tree1 xs) = rnf xs++instance Foldable1 Tree1 where+    foldMap1 f (Tree1 xs) = foldMap1 f xs++-- Using toNonEmpty+-- newtype Tree2 a = Tree2 (Tree a)+--   deriving (Functor, F.Foldable)+--+-- instance NFData a => NFData (Tree2 a) where+--     rnf (Tree2 xs) = rnf xs+--+-- instance Foldable1 Tree2 where+--     toNonEmpty (Tree2 xs) = toNonEmpty xs++-- Using to foldrMap1+newtype Tree3 a = Tree3 (Tree a)+  deriving (Functor, F.Foldable)++instance NFData a => NFData (Tree3 a) where+    rnf (Tree3 xs) = rnf xs++instance Foldable1 Tree3 where+    foldrMap1 f g (Tree3 xs) = foldrMap1 f g xs+#endif

+ foldable1-classes-compat.cabal view

@@ -0,0 +1,148 @@+cabal-version: >=1.10+name:          foldable1-classes-compat+version:       0.1+synopsis:+  Compatibility package for the Foldable1 and Bifoldable1 type classes++description:+  A compatibility package for the @Foldable1@ and @Bifoldable1@ type classes,+  which were introduced in @base-4.18.0.0@ (GHC 9.6.1). For more information,+  see <https://github.com/haskell/core-libraries-committee/issues/9 this Core+  Libraries Committee proposal>.+  .+  @Foldable1@ and @Bifoldable1@ classify non-empty data structures that can be+  folded to a summary value.++license:       BSD3+maintainer:    Ryan Scott <ryan.gl.scott@gmail.com>+author:        Edward Kmett, Oleg Grenrus+homepage:      https://github.com/haskell-compat/foldable1-classes-compat+bug-reports:   https://github.com/haskell-compat/foldable1-classes-compat/issues+category:      Data, Compatibility+license-file:  LICENSE+build-type:    Simple+extra-source-files:+  CHANGELOG.markdown+  README.markdown+tested-with:+  GHC ==7.0.4+   || ==7.2.2+   || ==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.7+   || ==9.0.2+   || ==9.2.5+   || ==9.4.4+   || ==9.6.1++-- , GHCJS ==8.4++source-repository head+  type:     git+  location: https://github.com/haskell-compat/foldable1-classes-compat.git++flag tagged+  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.++  default:     True+  manual:      True++library+  default-language: Haskell2010+  ghc-options:      -Wall+  build-depends:    base >=4.3 && <4.19++  if !impl(ghc >= 9.6)+    hs-source-dirs: src+    build-depends:+        containers    >=0.4 && <0.7+      , transformers  >=0.3 && <0.7+    exposed-modules:+      Data.Foldable1+      Data.Bifoldable1++  if !impl(ghc >=8.6)+    build-depends: base-orphans >=0.8.1 && <0.9++  if !impl(ghc >=8.2)+    build-depends: bifunctor-classes-compat >=0.1 && <0.2++  if !impl(ghc >=8.0)+    build-depends:+        semigroups           >=0.18.5 && <0.20+      , transformers-compat  >=0.6    && <0.8++  if !impl(ghc >= 7.2)+    build-depends: generic-deriving >=1.14 && <1.15++  if flag(tagged)+    build-depends: tagged >=0.4.4 && <1++  if impl(ghc >= 9.0)+    build-depends: ghc-prim >= 0.7 && <0.11+  else+    if !impl(ghc >=7.6)+      build-depends: ghc-prim++test-suite test+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  ghc-options:      -Wall+  hs-source-dirs:   test+  main-is:          Tests.hs++  -- because of quickcheck-instances+  if !impl(ghc >=7.4)+    buildable: False++  build-depends:+      base+    , containers+    , foldable1-classes-compat+    , transformers++  if !impl(ghc >=8.0)+    build-depends:+        semigroups+      , transformers-compat++  build-depends:+      QuickCheck                  >=2.13.2  && <2.15+    , quickcheck-instances        >=0.3.27  && <0.4+    , test-framework              >=0.8.2.0 && <0.9+    , test-framework-quickcheck2  >=0.3.0.5 && <0.4++benchmark bench+  default-language: Haskell2010+  type:             exitcode-stdio-1.0+  ghc-options:      -Wall+  hs-source-dirs:   bench+  main-is:          Bench.hs++  if !impl(ghc >=7.6)+    buildable: False++  build-depends:+      base+    , containers+    , foldable1-classes-compat+    , transformers++  if !impl(ghc >=8.0)+    build-depends:+        semigroups+      , transformers-compat++  build-depends:+      criterion  >=1.5.6.1 && <1.7+    , deepseq    >=1.3     && <1.5

+ src/Data/Bifoldable1.hs view

@@ -0,0 +1,64 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# LANGUAGE TypeOperators     #-}++#if __GLASGOW_HASKELL__ >= 708+{-# LANGUAGE Safe              #-}+#elif __GLASGOW_HASKELL__ >= 702+{-# LANGUAGE Trustworthy       #-}+#endif+module Data.Bifoldable1 where++import Control.Applicative (Const (..))+import Data.Bifoldable     (Bifoldable (..))+import Data.Semigroup      (Arg (..), Semigroup (..))+import Prelude             (Either (..), id)++#ifdef MIN_VERSION_tagged+import Data.Tagged (Tagged (..))+#endif++#if !MIN_VERSION_base(4,12,0)+import Data.Orphans ()+#endif++class Bifoldable t => Bifoldable1 t where+     bifold1 :: Semigroup m => t m m -> m+     bifold1 = bifoldMap1 id id+     {-# INLINE bifold1 #-}++     bifoldMap1 :: Semigroup m => (a -> m) -> (b -> m) -> t a b -> m++instance Bifoldable1 Arg where+    bifoldMap1 f g (Arg a b) = f a <> g b++instance Bifoldable1 Either where+    bifoldMap1 f _ (Left a) = f a+    bifoldMap1 _ g (Right b) = g b+    {-# INLINE bifoldMap1 #-}++instance Bifoldable1 (,) where+    bifoldMap1 f g (a, b) = f a <> g b+    {-# INLINE bifoldMap1 #-}++instance Bifoldable1 ((,,) x) where+    bifoldMap1 f g (_,a,b) = f a <> g b+    {-# INLINE bifoldMap1 #-}++instance Bifoldable1 ((,,,) x y) where+    bifoldMap1 f g (_,_,a,b) = f a <> g b+    {-# INLINE bifoldMap1 #-}++instance Bifoldable1 ((,,,,) x y z) where+    bifoldMap1 f g (_,_,_,a,b) = f a <> g b+    {-# INLINE bifoldMap1 #-}++instance Bifoldable1 Const where+    bifoldMap1 f _ (Const a) = f a+    {-# INLINE bifoldMap1 #-}++#ifdef MIN_VERSION_tagged+instance Bifoldable1 Tagged where+    bifoldMap1 _ g (Tagged b) = g b+    {-# INLINE bifoldMap1 #-}+#endif

+ src/Data/Foldable1.hs view

@@ -0,0 +1,653 @@+{-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NoImplicitPrelude          #-}+{-# LANGUAGE ScopedTypeVariables        #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TypeOperators              #-}++#if __GLASGOW_HASKELL__ >=706+{-# LANGUAGE PolyKinds #-}+#endif++#if __GLASGOW_HASKELL__ >=702+{-# LANGUAGE Trustworthy                #-}+#endif++-- | A class of non-empty data structures that can be folded to a summary value.+module Data.Foldable1 (+    Foldable1(..),+    foldr1, foldr1',+    foldl1, foldl1',+    intercalate1,+    foldrM1,+    foldlM1,+    foldrMapM1,+    foldlMapM1,+    maximumBy,+    minimumBy,+    ) where++import Data.Foldable      (Foldable, foldlM, foldr)+import Data.List          (foldl, foldl')+import Data.List.NonEmpty (NonEmpty (..))+import Data.Semigroup+       (Dual (..), First (..), Last (..), Max (..), Min (..), Product (..),+       Semigroup (..), Sum (..))+import Prelude+       (Maybe (..), Monad (..), Ord, Ordering (..), id, seq, ($!), ($), (.),+       (=<<), flip, const, error)++import qualified Data.List.NonEmpty as NE++#if MIN_VERSION_base(4,4,0)+import Data.Complex (Complex (..))+import GHC.Generics+       (M1 (..), Par1 (..), Rec1 (..), V1, (:*:) (..), (:+:) (..), (:.:) (..))+#else+import Generics.Deriving+       (M1 (..), Par1 (..), Rec1 (..), V1, (:*:) (..), (:+:) (..), (:.:) (..))+#endif++#if MIN_VERSION_base(4,6,0)+import Data.Ord (Down (..))+#endif++#if MIN_VERSION_base(4,8,0)+import qualified Data.Monoid as Mon+#endif++#if !MIN_VERSION_base(4,12,0)+import Data.Orphans ()+#endif++#ifdef MIN_VERSION_tagged+import Data.Tagged (Tagged (..))+#endif++#ifdef MIN_VERSION_ghc_prim+#if MIN_VERSION_ghc_prim(0,7,0)+import GHC.Tuple (Solo (..))+#endif+#endif++-- Instances+import Control.Applicative.Backwards (Backwards (..))+import Control.Applicative.Lift      (Lift (..))+import Control.Monad.Trans.Identity  (IdentityT (..))+import Data.Functor.Compose          (Compose (..))+import Data.Functor.Identity         (Identity (..))+import Data.Functor.Reverse          (Reverse (..))+import Data.Tree                     (Tree (..))++import qualified Data.Functor.Product as Functor+import qualified Data.Functor.Sum     as Functor++-- coerce+#if __GLASGOW_HASKELL__ <708+import Unsafe.Coerce (unsafeCoerce)+#else+import Data.Coerce (Coercible, coerce)+#endif++-- $setup+-- >>> import Prelude hiding (foldr1, foldl1, head, last, minimum, maximum)++-------------------------------------------------------------------------------+-- Foldable1 type class+-------------------------------------------------------------------------------++-- | Non-empty data structures that can be folded.+class Foldable t => Foldable1 t where+#if __GLASGOW_HASKELL__ >= 708+    {-# MINIMAL foldMap1 | foldrMap1 #-}+#endif++    -- At some point during design it was possible to define this class using+    -- only 'toNonEmpty'. But it seems a bad idea in general.+    --+    -- So currently we require either foldMap1 or foldrMap1+    --+    -- * foldMap1 defined using foldrMap1+    -- * foldrMap1 defined using foldMap1+    --+    -- One can alsays define instance using following pattern:+    --+    --     toNonEmpty = ...+    --     foldMap f     = foldMap f     . toNonEmpty+    --     foldrMap1 f g = foldrMap1 f g . toNonEmpty++    -- | Combine the elements of a structure using a semigroup.+    fold1 :: Semigroup m => t m -> m+    fold1 = foldMap1 id++    -- | Map each element of the structure to a semigroup,+    -- and combine the results.+    --+    -- >>> foldMap1 Sum (1 :| [2, 3, 4])+    -- Sum {getSum = 10}+    --+    foldMap1 :: Semigroup m => (a -> m) -> t a -> m+    foldMap1 f = foldrMap1 f (\a m -> f a <> m)++    -- | A variant of 'foldMap1' that is strict in the accumulator.+    --+    -- >>> foldMap1' Sum (1 :| [2, 3, 4])+    -- Sum {getSum = 10}+    --+    foldMap1' :: Semigroup m => (a -> m) -> t a -> m+    foldMap1' f = foldlMap1' f (\m a -> m <> f a)++    -- | List of elements of a structure, from left to right.+    --+    -- >>> toNonEmpty (Identity 2)+    -- 2 :| []+    --+    toNonEmpty :: t a -> NonEmpty a+    toNonEmpty = runNonEmptyDList . foldMap1 singleton++    -- | The largest element of a non-empty structure.+    --+    -- >>> maximum (32 :| [64, 8, 128, 16])+    -- 128+    --+    maximum :: Ord a => t a -> a+    maximum = getMax #. foldMap1' Max++    -- | The least element of a non-empty structure.+    --+    -- >>> minimum (32 :| [64, 8, 128, 16])+    -- 8+    --+    minimum :: Ord a => t a -> a+    minimum = getMin #. foldMap1' Min++    -- | The first element of a non-empty structure.+    --+    -- >>> head (1 :| [2, 3, 4])+    -- 1+    --+    head :: t a -> a+    head = getFirst #. foldMap1 First++    -- | The last element of a non-empty structure.+    --+    -- >>> last (1 :| [2, 3, 4])+    -- 4+    --+    last :: t a -> a+    last = getLast #. foldMap1 Last++    -- | Generalized 'foldr1'.+    foldrMap1 :: (a -> b) -> (a -> b -> b) -> t a -> b+    foldrMap1 f g xs =+        appFromMaybe (foldMap1 (FromMaybe #. h) xs) Nothing+      where+        h a Nothing  = f a+        h a (Just b) = g a b++    -- | Generalized 'foldl1''.+    foldlMap1' :: (a -> b) -> (b -> a -> b) -> t a -> b+    foldlMap1' f g xs =+        foldrMap1 f' g' xs SNothing+      where+        -- f' :: a -> SMaybe b -> b+        f' a SNothing  = f a+        f' a (SJust b) = g b a++        -- g' :: a -> (SMaybe b -> b) -> SMaybe b -> b+        g' a x SNothing  = x $! SJust (f a)+        g' a x (SJust b) = x $! SJust (g b a)++    -- | Generalized 'foldl1'.+    foldlMap1 :: (a -> b) -> (b -> a -> b) -> t a -> b+    foldlMap1 f g xs =+        appFromMaybe (getDual (foldMap1 ((Dual . FromMaybe) #. h) xs)) Nothing+      where+        h a Nothing  = f a+        h a (Just b) = g b a++    -- | Generalized 'foldr1''.+    foldrMap1' :: (a -> b) -> (a -> b -> b) -> t a -> b+    foldrMap1' f g xs =+        foldlMap1 f' g' xs SNothing+      where+        f' a SNothing  = f a+        f' a (SJust b) = g a b++        g' bb a SNothing  = bb $! SJust (f a)+        g' bb a (SJust b) = bb $! SJust (g a b)++-------------------------------------------------------------------------------+-- Combinators+-------------------------------------------------------------------------------++-- | Right-associative fold of a structure.+--+-- In the case of lists, 'foldr1', when applied to a binary operator,+-- and a list, reduces the list using the binary operator,+-- from right to left:+--+-- > foldr1 f [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn1 `f` xn )...)+--+-- Note that, since the head of the resulting expression is produced by+-- an application of the operator to the first element of the list,+-- 'foldr1' can produce a terminating expression from an infinite list.+--+-- For a general 'Foldable1' structure this should be semantically identical+-- to,+--+-- @foldr1 f = foldr1 f . 'toNonEmpty'@+--+foldr1 :: Foldable1 t => (a -> a -> a) -> t a -> a+foldr1 = foldrMap1 id+{-# INLINE foldr1 #-}++-- | Right-associative fold of a structure, but with strict application of+-- the operator.+--+foldr1' :: Foldable1 t => (a -> a -> a) -> t a -> a+foldr1' = foldrMap1' id+{-# INLINE foldr1' #-}++-- | Left-associative fold of a structure.+--+-- In the case of lists, 'foldl1', when applied to a binary+-- operator, and a list, reduces the list using the binary operator,+-- from left to right:+--+-- > foldl1 f [x1, x2, ..., xn] == (...((x1 `f` x2) `f`...) `f` xn+--+-- Note that to produce the outermost application of the operator the+-- entire input list must be traversed. This means that 'foldl1' will+-- diverge if given an infinite list.+--+-- Also note that if you want an efficient left-fold, you probably want to+-- use 'foldl1'' instead of 'foldl1'. The reason for this is that latter does+-- not force the "inner" results (e.g. @x1 \`f\` x2@ in the above example)+-- before applying them to the operator (e.g. to @(\`f\` x3)@). This results+-- in a thunk chain \(\mathcal{O}(n)\) elements long, which then must be+-- evaluated from the outside-in.+--+-- For a general 'Foldable1' structure this should be semantically identical+-- to,+--+-- @foldl1 f z = foldl1 f . 'toNonEmpty'@+--+foldl1 :: Foldable1 t => (a -> a -> a) -> t a -> a+foldl1 = foldlMap1 id+{-# INLINE foldl1 #-}++-- | Left-associative fold of a structure but with strict application of+-- the operator.+--+-- This ensures that each step of the fold is forced to weak head normal+-- form before being applied, avoiding the collection of thunks that would+-- otherwise occur. This is often what you want to strictly reduce a finite+-- list to a single, monolithic result (e.g. 'length').+--+-- For a general 'Foldable1' structure this should be semantically identical+-- to,+--+-- @foldl1' f z = foldl1 f . 'toNonEmpty'@+--+foldl1' :: Foldable1 t => (a -> a -> a) -> t a -> a+foldl1' = foldlMap1' id+{-# INLINE foldl1' #-}++-- | Insert an @m@ between each pair of @t m@.+--+-- >>> intercalate1 ", " $ "hello" :| ["how", "are", "you"]+-- "hello, how, are, you"+--+-- >>> intercalate1 ", " $ "hello" :| []+-- "hello"+--+-- >>> intercalate1 mempty $ "I" :| ["Am", "Fine", "You?"]+-- "IAmFineYou?"+--+intercalate1 :: (Foldable1 t, Semigroup m) => m -> t m -> m+intercalate1 = flip intercalateMap1 id++intercalateMap1 :: (Foldable1 t, Semigroup m) => m -> (a -> m) -> t a -> m+intercalateMap1 j f = flip joinee j . foldMap1 (JoinWith . const . f)++-- | Monadic fold over the elements of a non-empty structure,+-- associating to the right, i.e. from right to left.+foldrM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a+foldrM1 = foldrMapM1 return++-- | Map variant of 'foldrM1'.+foldrMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (a -> b -> m b) -> t a -> m b+foldrMapM1 g f = go . toNonEmpty+  where+    go (e:|es) =+      case es of+        []   -> g e+        x:xs -> f e =<< go (x:|xs)++-- | Monadic fold over the elements of a non-empty structure,+-- associating to the left, i.e. from left to right.+foldlM1 :: (Foldable1 t, Monad m) => (a -> a -> m a) -> t a -> m a+foldlM1 = foldlMapM1 return++-- | Map variant of 'foldlM1'.+foldlMapM1 :: (Foldable1 t, Monad m) => (a -> m b) -> (b -> a -> m b) -> t a -> m b+foldlMapM1 g f t = g x >>= \y -> foldlM f y xs+  where x:|xs = toNonEmpty t++-- | The largest element of a non-empty structure with respect to the+-- given comparison function.++-- See Note [maximumBy/minimumBy space usage]+maximumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a+maximumBy cmp = foldl1' max'+  where max' x y = case cmp x y of+                        GT -> x+                        _  -> y++-- | The least element of a non-empty structure with respect to the+-- given comparison function.++-- See Note [maximumBy/minimumBy space usage]+minimumBy :: Foldable1 t => (a -> a -> Ordering) -> t a -> a+minimumBy cmp = foldl1' min'+  where min' x y = case cmp x y of+                        GT -> y+                        _  -> x++-------------------------------------------------------------------------------+-- Auxiliary types+-------------------------------------------------------------------------------++-- | Used for default toNonEmpty implementation.+newtype NonEmptyDList a = NEDL { unNEDL :: [a] -> NonEmpty a }++instance Semigroup (NonEmptyDList a) where+  xs <> ys = NEDL (unNEDL xs . NE.toList . unNEDL ys)+  {-# INLINE (<>) #-}++-- | Create dlist with a single element+singleton :: a -> NonEmptyDList a+singleton = NEDL #. (:|)++-- | Convert a dlist to a non-empty list+runNonEmptyDList :: NonEmptyDList a -> NonEmpty a+runNonEmptyDList = ($ []) . unNEDL+{-# INLINE runNonEmptyDList #-}++-- | Used for foldrMap1 and foldlMap1 definitions+newtype FromMaybe b = FromMaybe { appFromMaybe :: Maybe b -> b }++instance Semigroup (FromMaybe b) where+    FromMaybe f <> FromMaybe g = FromMaybe (f . Just . g)++-- | Strict maybe, used to implement default foldlMap1' etc.+data SMaybe a = SNothing | SJust !a++-- | Used to implement intercalate1/Map+newtype JoinWith a = JoinWith {joinee :: (a -> a)}++instance Semigroup a => Semigroup (JoinWith a) where+  JoinWith a <> JoinWith b = JoinWith $ \j -> a j <> j <> b j++-------------------------------------------------------------------------------+-- Instances for misc base types+-------------------------------------------------------------------------------++instance Foldable1 NonEmpty where+    foldMap1 f (x :| xs) = go (f x) xs where+        go y [] = y+        go y (z : zs) = y <> go (f z) zs++    foldMap1' f (x :| xs) = foldl' (\m y -> m <> f y) (f x) xs++    toNonEmpty = id++    foldrMap1 g f (x :| xs) = go x xs where+        go y [] = g y+        go y (z : zs) = f y (go z zs)++    foldlMap1  g f (x :| xs) = foldl f (g x) xs+    foldlMap1' g f (x :| xs) = let gx = g x in gx `seq` foldl' f gx xs++    head = NE.head+    last = NE.last++#if MIN_VERSION_base(4,6,0)+instance Foldable1 Down where+    foldMap1 = coerce+#endif++#if MIN_VERSION_base(4,4,0)+instance Foldable1 Complex where+    foldMap1 f (x :+ y) = f x <> f y++    toNonEmpty (x :+ y) = x :| y : []+#endif++-------------------------------------------------------------------------------+-- Instances for tuples+-------------------------------------------------------------------------------++-- 3+ tuples are not Foldable/Traversable++instance Foldable1 ((,) a) where+    foldMap1 f (_, y) = f y+    toNonEmpty (_, x) = x :| []+    minimum (_, x) = x+    maximum (_, x) = x+    head (_, x) = x+    last (_, x) = x++-------------------------------------------------------------------------------+-- Monoid / Semigroup instances+-------------------------------------------------------------------------------++instance Foldable1 Dual where+    foldMap1 = coerce++instance Foldable1 Sum where+    foldMap1 = coerce++instance Foldable1 Product where+    foldMap1 = coerce++instance Foldable1 Min where+    foldMap1 = coerce++instance Foldable1 Max where+    foldMap1 = coerce++instance Foldable1 First where+    foldMap1 = coerce++instance Foldable1 Last where+    foldMap1 = coerce++#if MIN_VERSION_base(4,8,0)+deriving instance (Foldable1 f) => Foldable1 (Mon.Alt f)+#endif++#if MIN_VERSION_base(4,12,0)+deriving instance (Foldable1 f) => Foldable1 (Mon.Ap f)+#endif++-------------------------------------------------------------------------------+-- GHC.Generics instances+-------------------------------------------------------------------------------++instance Foldable1 V1 where+    foldMap1 _ x = x `seq` error "foldMap1 @V1"++instance Foldable1 Par1 where+    foldMap1 = coerce++deriving instance Foldable1 f => Foldable1 (Rec1 f)++deriving instance Foldable1 f => Foldable1 (M1 i c f)++instance (Foldable1 f, Foldable1 g) => Foldable1 (f :+: g) where+    foldMap1 f (L1 x) = foldMap1 f x+    foldMap1 f (R1 y) = foldMap1 f y++instance (Foldable1 f, Foldable1 g) => Foldable1 (f :*: g) where+    foldMap1 f (x :*: y) = foldMap1 f x <> foldMap1 f y++instance (Foldable1 f, Foldable1 g) => Foldable1 (f :.: g) where+    foldMap1 f = foldMap1 (foldMap1 f) . unComp1++-------------------------------------------------------------------------------+-- Extra instances+-------------------------------------------------------------------------------++instance Foldable1 Identity where+    foldMap1      = coerce++    foldrMap1  g _ = coerce g+    foldrMap1' g _ = coerce g+    foldlMap1  g _ = coerce g+    foldlMap1' g _ = coerce g++    toNonEmpty (Identity x) = x :| []++    last    = coerce+    head    = coerce+    minimum = coerce+    maximum = coerce++-- | It would be enough for either half of a product to be 'Foldable1'.+-- Other could be 'Foldable'.+instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Product f g) where+    foldMap1 f (Functor.Pair x y)    = foldMap1 f x <> foldMap1 f y+    foldrMap1 g f (Functor.Pair x y) = foldr f (foldrMap1 g f y) x++    head (Functor.Pair x _) = head x+    last (Functor.Pair _ y) = last y++instance (Foldable1 f, Foldable1 g) => Foldable1 (Functor.Sum f g) where+    foldMap1 f (Functor.InL x) = foldMap1 f x+    foldMap1 f (Functor.InR y) = foldMap1 f y++    foldrMap1 g f (Functor.InL x) = foldrMap1 g f x+    foldrMap1 g f (Functor.InR y) = foldrMap1 g f y++    toNonEmpty (Functor.InL x) = toNonEmpty x+    toNonEmpty (Functor.InR y) = toNonEmpty y++    head (Functor.InL x) = head x+    head (Functor.InR y) = head y+    last (Functor.InL x) = last x+    last (Functor.InR y) = last y++    minimum (Functor.InL x) = minimum x+    minimum (Functor.InR y) = minimum y+    maximum (Functor.InL x) = maximum x+    maximum (Functor.InR y) = maximum y++instance (Foldable1 f, Foldable1 g) => Foldable1 (Compose f g) where+    foldMap1 f = foldMap1 (foldMap1 f) . getCompose++    foldrMap1 f g = foldrMap1 (foldrMap1 f g) (\xs x -> foldr g x xs) . getCompose++    head = head . head . getCompose+    last = last . last . getCompose++-------------------------------------------------------------------------------+-- containers+-------------------------------------------------------------------------------++instance Foldable1 Tree where+    foldMap1 f (Node x [])       = f x+    foldMap1 f (Node x (y : ys)) = f x <> foldMap1 (foldMap1 f) (y :| ys)++    foldMap1' f = go where+        go (Node x ys) =+            foldl' (\m zs -> let gozs = go zs in gozs `seq` m <> gozs) (f x) ys++    foldlMap1 f g (Node x xs) = goForest (f x) xs where+        goForest = foldl' go+        go y (Node z zs) = goForest (g y z) zs++    foldlMap1' f g (Node x xs) = goForest (f x) xs where+        goForest !y = foldl' go y+        go !y (Node z zs) = goForest (g y z) zs++    head (Node x _) = x++-------------------------------------------------------------------------------+-- transformers+-------------------------------------------------------------------------------++instance Foldable1 f => Foldable1 (Reverse f) where+    foldMap1 f = getDual . foldMap1 (Dual . f) . getReverse++    foldrMap1  f g (Reverse xs) = foldlMap1  f (flip g) xs+    foldlMap1  f g (Reverse xs) = foldrMap1  f (flip g) xs+    foldrMap1' f g (Reverse xs) = foldlMap1' f (flip g) xs+    foldlMap1' f g (Reverse xs) = foldrMap1' f (flip g) xs++    head = last . getReverse+    last = head . getReverse++deriving instance Foldable1 f => Foldable1 (IdentityT f)++instance Foldable1 f => Foldable1 (Backwards f) where+    foldMap1 f = foldMap1 f . forwards++instance Foldable1 f => Foldable1 (Lift f) where+    foldMap1 f (Pure x)  = f x+    foldMap1 f (Other y) = foldMap1 f y++-------------------------------------------------------------------------------+-- tagged+-------------------------------------------------------------------------------++#ifdef MIN_VERSION_tagged+instance Foldable1 (Tagged b) where+    foldMap1      = coerce++    foldrMap1  g _ = coerce g+    foldrMap1' g _ = coerce g+    foldlMap1  g _ = coerce g+    foldlMap1' g _ = coerce g++    toNonEmpty x = coerce x :| []++    last    = coerce+    head    = coerce+    minimum = coerce+    maximum = coerce+#endif++-------------------------------------------------------------------------------+-- ghc-prim+-------------------------------------------------------------------------------++#ifdef MIN_VERSION_ghc_prim+#if MIN_VERSION_ghc_prim(0,7,0)+instance Foldable1 Solo where+    foldMap1 f (Solo y) = f y+    toNonEmpty (Solo x) = x :| []+    minimum (Solo x) = x+    maximum (Solo x) = x+    head (Solo x) = x+    last (Solo x) = x+#endif+#endif++-------------------------------------------------------------------------------+-- coerce shim+-------------------------------------------------------------------------------++#if __GLASGOW_HASKELL__ <708+coerce :: a -> b+coerce = unsafeCoerce++(#.) :: (b -> c) -> (a -> b) -> a -> c+(#.) _f = coerce+#else+(#.) :: Coercible b c => (b -> c) -> (a -> b) -> a -> c+(#.) _f = coerce+#endif

+ test/Tests.hs view

@@ -0,0 +1,239 @@+{-# LANGUAGE CPP                        #-}+{-# LANGUAGE DeriveFoldable             #-}+{-# LANGUAGE DeriveFunctor              #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables        #-}++#if MIN_VERSION_base(4,18,0)+# define HAS_FOLDABLE1_CONTAINERS   MIN_VERSION_containers(0,6,7)+# define HAS_FOLDABLE1_TRANSFORMERS MIN_VERSION_transformers(0,6,1)+#else+# define HAS_FOLDABLE1_CONTAINERS   1+# define HAS_FOLDABLE1_TRANSFORMERS 1+#endif++module Main (main) where++import Prelude hiding (foldl1, foldr1, head, last, maximum, minimum)++import Data.Functor.Compose                 (Compose (..))+import Data.Functor.Identity                (Identity (..))+import Data.Functor.Product                 (Product (..))+import Data.Functor.Sum                     (Sum (..))+import Data.List.NonEmpty                   (NonEmpty (..))+import Data.Semigroup+       (First (..), Last (..), Max (..), Min (..), Semigroup (..))+import Test.Framework.Providers.API         (Test, TestName, testGroup)+import Test.Framework.Providers.QuickCheck2 (testProperty)+import Test.Framework.Runners.Console       (defaultMain)+import Test.QuickCheck+       (Arbitrary, Fun, Property, Testable, applyFun, applyFun2, counterexample,+       mapSize, (===))+import Test.QuickCheck.Poly                 (A, B, OrdA)++import Test.QuickCheck.Instances ()++import qualified Data.Foldable as F         (Foldable (foldMap))+import Data.Foldable                        (toList)+import Data.Foldable1++#if HAS_FOLDABLE1_CONTAINERS+import Data.Tree                            (Tree (..))+#endif++#if HASH_FOLDABLE1_TRANSFORMERS+import Data.Functor.Reverse                 (Reverse (..))+#endif++main :: IO ()+main = defaultMain+    [ foldable1tests "NonEmpty"  (P1 :: P1 NonEmpty)+    , foldable1tests "foldMap1"  (P1 :: P1 NE1)+    , foldable1tests "foldrMap1" (P1 :: P1 NE3)+#if HAS_FOLDABLE1_CONTAINERS+    , foldable1tests "Tree"      (P1 :: P1 Tree)+#endif+    , foldable1tests "Identity"  (P1 :: P1 Identity)+    , foldable1tests "Compose"   (P1 :: P1 (Compose NonEmpty NonEmpty))+    , foldable1tests "Product"   (P1 :: P1 (Product NonEmpty NonEmpty))+#if HASH_FOLDABLE1_TRANSFORMERS+    , foldable1tests "Reverse"   (P1 :: P1 (Reverse NonEmpty))+#endif+    , foldable1tests "Sum"       (P1 :: P1 (Sum NonEmpty NonEmpty))+    ]++-------------------------------------------------------------------------------+-- tests+-------------------------------------------------------------------------------++foldable1tests+    :: forall f.+      ( Foldable1 f+      , Arbitrary (f A), Show (f A)+      , Arbitrary (f OrdA), Show (f OrdA)+      , Arbitrary (f B), Show (f B)+      , Arbitrary (f [B]), Show (f [B])+      )+    => TestName+    -> P1 f+    -> Test+foldable1tests name _p = testGroup name+    [ testProperty "foldMap1 ~= foldMap" coherentFoldMap+    , testProperty "toList . toNonEmpty ~= toList" coherentToNonEmpty++    , testProperty "foldl1 non/strict" $ smaller strictFoldl1+    , testProperty "foldr1 non/strict" $ smaller strictFoldr1+    , testProperty "foldlMap1 non/strict" $ smaller strictFoldl1Map+    , testProperty "foldrMap1 non/strict" $ smaller strictFoldr1Map++    -- test against default implementations+    , testProperty "foldMap1 default" defaultFoldMap+    , testProperty "foldrMap1 default" $ smaller defaultFoldr1Map+    , testProperty "foldlMap1 default" $ smaller defaultFoldl1Map+    , testProperty "toNonEmpty default" defaultToNonEmpty++    , testProperty "head default" defaultHead+    , testProperty "last default" defaultLast+    , testProperty "minimum default" defaultMinimum+    , testProperty "maximum default" defaultMaximum++    -- if we first convert to nonEmpty it should be the same+    , testProperty "foldMap via toNonEmpty" viaFoldMap+    , testProperty "foldr1 via toNonEmpty" $ smaller viaFoldr1+    , testProperty "foldl1 via toNonEmpty" $ smaller viaFoldl1+    , testProperty "foldr1' via toNonEmpty" $ smaller viaFoldr1'+    , testProperty "foldl1' via toNonEmpty" $ smaller viaFoldl1'+    , testProperty "head via toNonEmpty" viaHead+    , testProperty "last via toNonEmpty" viaLast+    , testProperty "minimum via toNonEmpty" viaMinimum+    , testProperty "maximum via toNonEmpty" viaMaximum+    ]+  where+    -- Things like Compose NonEmpty NonEmpty are big+    smaller :: Testable prop => prop -> Property+    smaller = mapSize (`div` 3)++    coherentFoldMap :: f A -> Fun A [B] -> Property+    coherentFoldMap xs f' = F.foldMap f xs === foldMap1 f xs where+        f = applyFun f'++    coherentToNonEmpty :: f A -> Property+    coherentToNonEmpty xs = toList (toNonEmpty xs) === toList xs++    strictFoldr1 :: f [B] -> Fun ([B], [B]) [B] -> Property+    strictFoldr1 xs g' = foldr1 g xs === foldr1' g xs where+        g = applyFun2 g'++    strictFoldl1 :: f [B] -> Fun ([B], [B]) [B] -> Property+    strictFoldl1 xs g' = foldl1 g xs === foldl1' g xs where+        g = applyFun2 g'+++    strictFoldr1Map :: f A -> Fun A B -> Fun (A, B) B -> Property+    strictFoldr1Map xs f' g' = foldrMap1 f g xs === foldrMap1' f g xs where+        f = applyFun f'+        g = applyFun2 g'++    strictFoldl1Map :: f A -> Fun A B -> Fun (B, A) B -> Property+    strictFoldl1Map xs f' g' = foldlMap1 f g xs === foldlMap1' f g xs where+        f = applyFun f'+        g = applyFun2 g'++    defaultFoldMap :: f A -> Fun A [B] -> Property+    defaultFoldMap xs f' = F.foldMap f xs === foldrMap1 f (\a m -> f a Data.Semigroup.<> m) xs where+        f = applyFun f'++    defaultFoldr1Map :: f A -> Fun A [B] -> Fun (A, [B]) [B] -> Property+    defaultFoldr1Map xs f' g'+        = counterexample ("NE: " ++ show ys)+        $ foldrMap1 f g xs === foldrMap1 f g ys+      where+        f = applyFun f'+        g = applyFun2 g'+        ys = toNonEmpty xs++    defaultFoldl1Map :: f A -> Fun A [B] -> Fun ([B], A) [B] -> Property+    defaultFoldl1Map xs f' g'+        = counterexample ("NE: " ++ show ys)+        $ foldlMap1 f g xs === foldlMap1 f g ys+      where+        f = applyFun f'+        g = applyFun2 g'+        ys = toNonEmpty xs++    defaultToNonEmpty :: f A -> Property+    defaultToNonEmpty xs = toNonEmpty xs === foldMap1 (:|[]) xs++    defaultHead :: f A -> Property+    defaultHead xs = head xs === getFirst (foldMap1 First xs)++    defaultLast :: f A -> Property+    defaultLast xs = last xs === getLast (foldMap1 Last xs)++    defaultMinimum :: f OrdA -> Property+    defaultMinimum xs = minimum xs === getMin (foldMap1 Min xs)++    defaultMaximum :: f OrdA -> Property+    defaultMaximum xs = maximum xs === getMax (foldMap1 Max xs)++    viaFoldMap :: f A -> Fun A [B] -> Property+    viaFoldMap xs f' = F.foldMap f xs === F.foldMap f (toNonEmpty xs) where+        f = applyFun f'++    viaFoldr1 :: f [B] -> Fun ([B],[B]) [B] -> Property+    viaFoldr1 xs g' = foldr1 g xs === foldr1 g (toNonEmpty xs) where+        g = applyFun2 g'++    viaFoldr1' :: f [B] -> Fun ([B],[B]) [B] -> Property+    viaFoldr1' xs g' = foldr1' g xs === foldr1' g (toNonEmpty xs) where+        g = applyFun2 g'++    viaFoldl1 :: f [B] -> Fun ([B],[B]) [B] -> Property+    viaFoldl1 xs g' = foldl1 g xs === foldl1 g (toNonEmpty xs) where+        g = applyFun2 g'++    viaFoldl1' :: f [B] -> Fun ([B],[B]) [B] -> Property+    viaFoldl1' xs g' = foldl1' g xs === foldl1' g (toNonEmpty xs) where+        g = applyFun2 g'++    viaHead :: f A -> Property+    viaHead xs = head xs === head (toNonEmpty xs)++    viaLast :: f A -> Property+    viaLast xs = last xs === last (toNonEmpty xs)++    viaMinimum :: f OrdA -> Property+    viaMinimum xs = minimum xs === minimum (toNonEmpty xs)++    viaMaximum :: f OrdA -> Property+    viaMaximum xs = maximum xs === maximum (toNonEmpty xs)++-------------------------------------------------------------------------------+-- NonEmpty variants+-------------------------------------------------------------------------------++-- Using foldMap1 to define Foldable1+newtype NE1 a = NE1 (NonEmpty a)+  deriving (Eq, Show, Functor, F.Foldable, Arbitrary)++instance Foldable1 NE1 where+    foldMap1 f (NE1 xs) = foldMap1 f xs++-- Using foldrMap1 to define Foldable1+newtype NE3 a = NE3 (NonEmpty a)+  deriving (Eq, Show, Functor, F.Foldable, Arbitrary)++instance Foldable1 NE3 where+    foldrMap1 g f (NE3 xs) = foldrMap1 g f xs++-------------------------------------------------------------------------------+-- utilities+-------------------------------------------------------------------------------++-- Proxy of right kind+data P1 f+    = P1+    | Unused (f Int)++_unused :: P1 []+_unused = Unused []