diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.markdown
@@ -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).
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -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.
diff --git a/README.markdown b/README.markdown
new file mode 100644
--- /dev/null
+++ b/README.markdown
@@ -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.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/bench/Bench.hs b/bench/Bench.hs
new file mode 100644
--- /dev/null
+++ b/bench/Bench.hs
@@ -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
diff --git a/foldable1-classes-compat.cabal b/foldable1-classes-compat.cabal
new file mode 100644
--- /dev/null
+++ b/foldable1-classes-compat.cabal
@@ -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
diff --git a/src/Data/Bifoldable1.hs b/src/Data/Bifoldable1.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Bifoldable1.hs
@@ -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
diff --git a/src/Data/Foldable1.hs b/src/Data/Foldable1.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/Foldable1.hs
@@ -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
diff --git a/test/Tests.hs b/test/Tests.hs
new file mode 100644
--- /dev/null
+++ b/test/Tests.hs
@@ -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 []