    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE DefaultSignatures #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE InstanceSigs #-}
    {-# LANGUAGE PolyKinds #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE StandaloneDeriving #-}
    {-# LANGUAGE TemplateHaskell #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE TypeOperators #-}
    {-# LANGUAGE UndecidableInstances #-}
    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Singletons.Prelude.Foldable
    -- Copyright   :  (C) 2018 Ryan Scott
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  Ryan Scott
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- Defines the promoted and singled versions of the 'Foldable' type class.
    --
    ----------------------------------------------------------------------------

    module Data.Singletons.Prelude.Foldable (
      PFoldable(..), SFoldable(..),

      FoldrM, sFoldrM,
      FoldlM, sFoldlM,

      Traverse_, sTraverse_,
      For_, sFor_,
      SequenceA_, sSequenceA_,
      Asum, sAsum,

      MapM_, sMapM_,
      ForM_, sForM_,
      Sequence_, sSequence_,
      Msum, sMsum,

      Concat, sConcat,
      ConcatMap, sConcatMap,
      And, sAnd,
      Or, sOr,
      Any, sAny,
      All, sAll,
      MaximumBy, sMaximumBy,
      MinimumBy, sMinimumBy,

      NotElem, sNotElem,
      Find, sFind,

      -- * Defunctionalization symbols
      FoldSym0, FoldSym1,
      FoldMapSym0, FoldMapSym1, FoldMapSym2,
      FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3,
      Foldr'Sym0, Foldr'Sym1, Foldr'Sym2, Foldr'Sym3,
      FoldlSym0, FoldlSym1, FoldlSym2, FoldlSym3,
      Foldl'Sym0, Foldl'Sym1, Foldl'Sym2, Foldl'Sym3,
      Foldr1Sym0, Foldr1Sym1, Foldr1Sym2,
      Foldl1Sym0, Foldl1Sym1, Foldl1Sym2,
      ToListSym0, ToListSym1,
      NullSym0, NullSym1,
      LengthSym0, LengthSym1,
      ElemSym0, ElemSym1, ElemSym2,
      MaximumSym0, MaximumSym1,
      MinimumSym0, MinimumSym1,
      SumSym0, SumSym1,
      ProductSym0, ProductSym1,

      FoldrMSym0, FoldrMSym1, FoldrMSym2, FoldrMSym3,
      FoldlMSym0, FoldlMSym1, FoldlMSym2, FoldlMSym3,

      Traverse_Sym0, Traverse_Sym1, Traverse_Sym2,
      For_Sym0, For_Sym1, For_Sym2,
      SequenceA_Sym0, SequenceA_Sym1,
      AsumSym0, AsumSym1,

      MapM_Sym0, MapM_Sym1, MapM_Sym2,
      ForM_Sym0, ForM_Sym1, ForM_Sym2,
      Sequence_Sym0, Sequence_Sym1,
      MsumSym0, MsumSym1,

      ConcatSym0, ConcatSym1,
      ConcatMapSym0, ConcatMapSym1, ConcatMapSym2,
      AndSym0, AndSym1,
      OrSym0, OrSym1,
      AnySym0, AnySym1, AnySym2,
      AllSym0, AllSym1, AllSym2,
      MaximumBySym0, MaximumBySym1, MaximumBySym2,
      MinimumBySym0, MinimumBySym1, MinimumBySym2,

      NotElemSym0, NotElemSym1, NotElemSym2,
      FindSym0, FindSym1, FindSym2
      ) where

    import Control.Applicative
    import Control.Monad
    import Data.Kind
    import Data.List.NonEmpty (NonEmpty(..))
    import Data.Monoid hiding (All(..), Any(..), Endo(..), Product(..), Sum(..))
    import qualified Data.Monoid as Monoid (All(..), Any(..), Product(..), Sum(..))
    import Data.Singletons.Internal
    import Data.Singletons.Prelude.Base
      hiding (Foldr, FoldrSym0, FoldrSym1, FoldrSym2, FoldrSym3, sFoldr)
    import Data.Singletons.Prelude.Bool
    import Data.Singletons.Prelude.Either
    import Data.Singletons.Prelude.Eq
    import Data.Singletons.Prelude.Instances (Sing(..), type (:@#@$))
    import Data.Singletons.Prelude.List.Internal.Disambiguation
    import Data.Singletons.Prelude.Maybe
    import Data.Singletons.Prelude.Monad.Internal
    import Data.Singletons.Prelude.Monoid
      hiding ( AllSym0,     AllSym1
             , AnySym0,     AnySym1
             , ProductSym0, ProductSym1
             , SumSym0,     SumSym1 )
    import Data.Singletons.Prelude.Num
    import Data.Singletons.Prelude.Ord
      hiding ( Max, MaxSym0, MaxSym1, MaxSym2, sMax
             , Min, MinSym0, MinSym1, MinSym2, sMin )
    import Data.Singletons.Prelude.Semigroup.Internal
      hiding ( AllSym0(..),     AllSym1,     SAll
             , AnySym0(..),     AnySym1,     SAny
             , FirstSym0,       FirstSym1,   SFirst
             , LastSym0,        LastSym1,    SLast
             , ProductSym0(..), ProductSym1, SProduct
             , SumSym0(..),     SumSym1,     SSum )
    import Data.Singletons.Promote
    import Data.Singletons.Single
    import Data.Singletons.TypeLits.Internal

    newtype Endo a = Endo (a ~> a)
    data instance Sing :: forall a. Endo a -> Type where
      SEndo :: Sing x -> Sing ('Endo x)
    data EndoSym0 :: forall a. (a ~> a) ~> Endo a
    type instance Apply EndoSym0 x = 'Endo x

    $(singletonsOnly [d|
      instance Semigroup (Endo a) where
              Endo x <> Endo y = Endo (x . y)

      instance Monoid (Endo a) where
              mempty = Endo id
      |])

    newtype MaxInternal a = MaxInternal (Maybe a)
    data instance Sing :: forall a. MaxInternal a -> Type where
      SMaxInternal :: Sing x -> Sing ('MaxInternal x)
    $(genDefunSymbols [''MaxInternal])

    newtype MinInternal a = MinInternal (Maybe a)
    data instance Sing :: forall a. MinInternal a -> Type where
      SMinInternal :: Sing x -> Sing ('MinInternal x)
    $(genDefunSymbols [''MinInternal])

    $(singletonsOnly [d|
      instance Ord a => Semigroup (MaxInternal a) where
          m <> MaxInternal Nothing = m
          MaxInternal Nothing <> n = n
          (MaxInternal m@(Just x)) <> (MaxInternal n@(Just y))
            = if x >= y then MaxInternal m else MaxInternal n

      instance Ord a => Monoid (MaxInternal a) where
          mempty = MaxInternal Nothing

      instance Ord a => Semigroup (MinInternal a) where
          m <> MinInternal Nothing = m
          MinInternal Nothing <> n = n
          (MinInternal m@(Just x)) <> (MinInternal n@(Just y))
            = if x <= y then MinInternal m else MinInternal n

      instance Ord a => Monoid (MinInternal a) where
          mempty = MinInternal Nothing
      |])

    $(singletonsOnly [d|
      -- -| Data structures that can be folded.
      --
      -- For example, given a data type
      --
      -- > data Tree a = Empty | Leaf a | Node (Tree a) a (Tree a)
      --
      -- a suitable instance would be
      --
      -- > instance Foldable Tree where
      -- >    foldMap f Empty = mempty
      -- >    foldMap f (Leaf x) = f x
      -- >    foldMap f (Node l k r) = foldMap f l `mappend` f k `mappend` foldMap f r
      --
      -- This is suitable even for abstract types, as the monoid is assumed
      -- to satisfy the monoid laws.  Alternatively, one could define @foldr@:
      --
      -- > instance Foldable Tree where
      -- >    foldr f z Empty = z
      -- >    foldr f z (Leaf x) = f x z
      -- >    foldr f z (Node l k r) = foldr f (f k (foldr f z r)) l
      --
      -- @Foldable@ instances are expected to satisfy the following laws:
      --
      -- > foldr f z t = appEndo (foldMap (Endo . f) t ) z
      --
      -- > foldl f z t = appEndo (getDual (foldMap (Dual . Endo . flip f) t)) z
      --
      -- > fold = foldMap id
      --
      -- > length = getSum . foldMap (Sum . const  1)
      --
      -- @sum@, @product@, @maximum@, and @minimum@ should all be essentially
      -- equivalent to @foldMap@ forms, such as
      --
      -- > sum = getSum . foldMap Sum
      --
      -- but may be less defined.
      --
      -- If the type is also a 'Functor' instance, it should satisfy
      --
      -- > foldMap f = fold . fmap f
      --
      -- which implies that
      --
      -- > foldMap f . fmap g = foldMap (f . g)

      class Foldable (t :: Type -> Type) where
          -- {-# MINIMAL foldMap | foldr #-}

          -- -| Combine the elements of a structure using a monoid.
          fold :: Monoid m => t m -> m
          fold = foldMap id

          -- -| Map each element of the structure to a monoid,
          -- and combine the results.
          foldMap :: Monoid m => (a -> m) -> t a -> m
          foldMap f = foldr (mappend . f) mempty

          -- -| Right-associative fold of a structure.
          --
          -- In the case of lists, 'foldr', when applied to a binary operator, a
          -- starting value (typically the right-identity of the operator), and a
          -- list, reduces the list using the binary operator, from right to left:
          --
          -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)
          --
          -- Note that, since the head of the resulting expression is produced by
          -- an application of the operator to the first element of the list,
          -- 'foldr' can produce a terminating expression from an infinite list.
          --
          -- For a general 'Foldable' structure this should be semantically identical
          -- to,
          --
          -- @foldr f z = 'List.foldr' f z . 'toList'@
          --
          foldr :: (a -> b -> b) -> b -> t a -> b
          foldr f z t = case foldMap (Endo . f) t of
                          Endo g -> g z

          -- -| Right-associative fold of a structure, but with strict application of
          -- the operator.
          --
          foldr' :: (a -> b -> b) -> b -> t a -> b
          foldr' f z0 xs = foldl f' id xs z0
            where f' k x z = k $! f x z

          -- -| Left-associative fold of a structure.
          --
          -- In the case of lists, 'foldl', when applied to a binary
          -- operator, a starting value (typically the left-identity of the operator),
          -- and a list, reduces the list using the binary operator, from left to
          -- right:
          --
          -- > foldl f z [x1, x2, ..., xn] == (...((z `f` 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 'foldl'' will
          -- diverge if given an infinite list.
          --
          -- Also note that if you want an efficient left-fold, you probably want to
          -- use 'foldl'' instead of 'foldl'. The reason for this is that latter does
          -- not force the "inner" results (e.g. @z `f` x1@ in the above example)
          -- before applying them to the operator (e.g. to @(`f` x2)@). This results
          -- in a thunk chain @O(n)@ elements long, which then must be evaluated from
          -- the outside-in.
          --
          -- For a general 'Foldable' structure this should be semantically identical
          -- to,
          --
          -- @foldl f z = 'List.foldl' f z . 'toList'@
          --
          foldl :: (b -> a -> b) -> b -> t a -> b
          foldl f z t = case foldMap (Dual . Endo . flip f) t of
                          Dual (Endo g) -> g z
          -- There's no point mucking around with coercions here,
          -- because flip forces us to build a new function anyway.

          -- -| 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 'Foldable' structure this should be semantically identical
          -- to,
          --
          -- @foldl f z = 'List.foldl'' f z . 'toList'@
          --
          foldl' :: (b -> a -> b) -> b -> t a -> b
          foldl' f z0 xs = foldr f' id xs z0
            where f' x k z = k $! f z x

          -- -| A variant of 'foldr' that has no base case,
          -- and thus may only be applied to non-empty structures.
          --
          -- @'foldr1' f = 'List.foldr1' f . 'toList'@
          foldr1 :: (a -> a -> a) -> t a -> a
          foldr1 f xs = fromMaybe (errorWithoutStackTrace "foldr1: empty structure")
                          (foldr mf Nothing xs)
            where
              mf x m = Just (case m of
                               Nothing -> x
                               Just y  -> f x y)

          -- -| A variant of 'foldl' that has no base case,
          -- and thus may only be applied to non-empty structures.
          --
          -- @'foldl1' f = 'List.foldl1' f . 'toList'@
          foldl1 :: (a -> a -> a) -> t a -> a
          foldl1 f xs = fromMaybe (errorWithoutStackTrace "foldl1: empty structure")
                          (foldl mf Nothing xs)
            where
              mf m y = Just (case m of
                               Nothing -> y
                               Just x  -> f x y)

          -- -| List of elements of a structure, from left to right.
          toList :: t a -> [a]
          toList = foldr (:) []

          -- -| Test whether the structure is empty. The default implementation is
          -- optimized for structures that are similar to cons-lists, because there
          -- is no general way to do better.
          null :: t a -> Bool
          null = foldr (\_ _ -> False) True

          -- -| Returns the size/length of a finite structure as an 'Int'.  The
          -- default implementation is optimized for structures that are similar to
          -- cons-lists, because there is no general way to do better.
          length :: t a -> Nat
          length = foldl' (\c _ -> c+1) 0

          -- -| Does the element occur in the structure?
          elem :: Eq a => a -> t a -> Bool
          elem = any . (==)

          -- -| The largest element of a non-empty structure.
          maximum :: forall a . Ord a => t a -> a
          maximum x =
            case foldMap (MaxInternal . Just) x of
              MaxInternal y -> fromMaybe (errorWithoutStackTrace "maximum: empty structure") y

          -- -| The least element of a non-empty structure.
          minimum :: forall a . Ord a => t a -> a
          minimum x =
            case foldMap (MinInternal . Just) x of
              MinInternal y -> fromMaybe (errorWithoutStackTrace "minimum: empty structure") y

          -- -| The 'sum' function computes the sum of the numbers of a structure.
          sum :: Num a => t a -> a
          sum x = case foldMap sum_ x of
                    Monoid.Sum y -> y

          -- -| The 'product' function computes the product of the numbers of a
          -- structure.
          product :: Num a => t a -> a
          product x = case foldMap product_ x of
                        Monoid.Product y -> y

      -- instances for Prelude types

      instance Foldable Maybe where
          foldMap = maybe_ mempty

          foldr _ z Nothing = z
          foldr f z (Just x) = f x z

          foldl _ z Nothing = z
          foldl f z (Just x) = f z x

      instance Foldable [] where
          elem    = listelem
          foldl   = listfoldl
          foldl'  = listfoldl'
          foldl1  = listfoldl1
          foldr   = listfoldr
          foldr1  = listfoldr1
          length  = listlength
          maximum = listmaximum
          minimum = listminimum
          null    = listnull
          product = listproduct
          sum     = listsum
          toList  = id

      instance Foldable NonEmpty where
        foldr f z (a :| as) = f a (listfoldr f z as)
        foldl f z (a :| as) = listfoldl f (f z a) as
        foldl1 f (a :| as) = listfoldl f a as

        -- GHC isn't clever enough to transform the default definition
        -- into anything like this, so we'd end up shuffling a bunch of
        -- Maybes around.
        foldr1 f (p :| ps) = foldr go id ps p
          where
            go x r prev = f prev (r x)

        -- We used to say
        --
        --   length (_ :| as) = 1 + length as
        --
        -- but the default definition is better, counting from 1.
        --
        -- The default definition also works great for null and foldl'.
        -- As usual for cons lists, foldr' is basically hopeless.

        foldMap f (a :| as) = f a `mappend` foldMap f as
        fold (m :| ms) = m `mappend` fold ms
        toList (a :| as) = a : as

      instance Foldable (Either a) where
          foldMap _ (Left _) = mempty
          foldMap f (Right y) = f y

          foldr _ z (Left _) = z
          foldr f z (Right y) = f y z

          length (Left _)  = 0
          length (Right _) = 1

          null             = isLeft

      instance Foldable Dual where
          foldMap f (Dual x)  = f x

          elem x (Dual y)     = x == y
          foldl f z (Dual x)  = f z x
          foldl' f z (Dual x) = f z x
          foldl1 _ (Dual x)   = x
          foldr f z (Dual x)  = f x z
          foldr'              = foldr
          foldr1 _ (Dual x)   = x
          length _            = 1
          maximum (Dual x)    = x
          minimum (Dual x)    = x
          null _              = False
          product (Dual x)    = x
          sum (Dual x)        = x
          toList (Dual x)     = [x]

      instance Foldable Monoid.Sum where
          foldMap f (Monoid.Sum x)  = f x

          elem x (Monoid.Sum y)     = x == y
          foldl f z (Monoid.Sum x)  = f z x
          foldl' f z (Monoid.Sum x) = f z x
          foldl1 _ (Monoid.Sum x)   = x
          foldr f z (Monoid.Sum x)  = f x z
          foldr'                    = foldr
          foldr1 _ (Monoid.Sum x)   = x
          length _                  = 1
          maximum (Monoid.Sum x)    = x
          minimum (Monoid.Sum x)    = x
          null _                    = False
          product (Monoid.Sum x)    = x
          sum (Monoid.Sum x)        = x
          toList (Monoid.Sum x)     = [x]

      instance Foldable Monoid.Product where
          foldMap f (Monoid.Product x)  = f x

          elem x (Monoid.Product y)     = x == y
          foldl f z (Monoid.Product x)  = f z x
          foldl' f z (Monoid.Product x) = f z x
          foldl1 _ (Monoid.Product x)   = x
          foldr f z (Monoid.Product x)  = f x z
          foldr'              = foldr
          foldr1 _ (Monoid.Product x)   = x
          length _            = 1
          maximum (Monoid.Product x)    = x
          minimum (Monoid.Product x)    = x
          null _              = False
          product (Monoid.Product x)    = x
          sum (Monoid.Product x)        = x
          toList (Monoid.Product x)     = [x]

      -- -| Monadic fold over the elements of a structure,
      -- associating to the right, i.e. from right to left.
      foldrM :: (Foldable t, Monad m) => (a -> b -> m b) -> b -> t a -> m b
      foldrM f z0 xs = foldl f' return xs z0
        where f' k x z = f x z >>= k

      -- -| Monadic fold over the elements of a structure,
      -- associating to the left, i.e. from left to right.
      foldlM :: (Foldable t, Monad m) => (b -> a -> m b) -> b -> t a -> m b
      foldlM f z0 xs = foldr f' return xs z0
        where f' x k z = f z x >>= k

      -- -| Map each element of a structure to an action, evaluate these
      -- actions from left to right, and ignore the results. For a version
      -- that doesn't ignore the results see 'Data.Traversable.traverse'.
      traverse_ :: (Foldable t, Applicative f) => (a -> f b) -> t a -> f ()
      traverse_ f = foldr ((*>) . f) (pure ())

      -- -| 'for_' is 'traverse_' with its arguments flipped. For a version
      -- that doesn't ignore the results see 'Data.Traversable.for'.
      --
      -- >>> for_ [1..4] print
      -- 1
      -- 2
      -- 3
      -- 4
      for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()
      for_ = flip traverse_

      -- -| Map each element of a structure to a monadic action, evaluate
      -- these actions from left to right, and ignore the results. For a
      -- version that doesn't ignore the results see
      -- 'Data.Traversable.mapM'.
      --
      -- As of base 4.8.0.0, 'mapM_' is just 'traverse_', specialized to
      -- 'Monad'.
      mapM_ :: (Foldable t, Monad m) => (a -> m b) -> t a -> m ()
      mapM_ f= foldr ((>>) . f) (return ())

      -- -| 'forM_' is 'mapM_' with its arguments flipped. For a version that
      -- doesn't ignore the results see 'Data.Traversable.forM'.
      --
      -- As of base 4.8.0.0, 'forM_' is just 'for_', specialized to 'Monad'.
      forM_ :: (Foldable t, Monad m) => t a -> (a -> m b) -> m ()
      forM_ = flip mapM_

      -- -| Evaluate each action in the structure from left to right, and
      -- ignore the results. For a version that doesn't ignore the results
      -- see 'Data.Traversable.sequenceA'.
      sequenceA_ :: (Foldable t, Applicative f) => t (f a) -> f ()
      sequenceA_ = foldr (*>) (pure ())

      -- -| Evaluate each monadic action in the structure from left to right,
      -- and ignore the results. For a version that doesn't ignore the
      -- results see 'Data.Traversable.sequence'.
      --
      -- As of base 4.8.0.0, 'sequence_' is just 'sequenceA_', specialized
      -- to 'Monad'.
      sequence_ :: (Foldable t, Monad m) => t (m a) -> m ()
      sequence_ = foldr (>>) (return ())

      -- -| The sum of a collection of actions, generalizing 'concat'.
      --
      -- asum [Just "Hello", Nothing, Just "World"]
      -- Just "Hello"
      asum :: (Foldable t, Alternative f) => t (f a) -> f a
      asum = foldr (<|>) empty

      -- -| The sum of a collection of actions, generalizing 'concat'.
      -- As of base 4.8.0.0, 'msum' is just 'asum', specialized to 'MonadPlus'.
      msum :: (Foldable t, MonadPlus m) => t (m a) -> m a
      msum = asum

      -- -| The concatenation of all the elements of a container of lists.
      concat :: Foldable t => t [a] -> [a]
      concat xs = foldr (\x y -> foldr (:) y x) [] xs

      -- -| Map a function over all the elements of a container and concatenate
      -- the resulting lists.
      concatMap :: Foldable t => (a -> [b]) -> t a -> [b]
      concatMap f xs = foldr (\x b -> foldr (:) b (f x)) [] xs

      -- These use foldr rather than foldMap to avoid repeated concatenation.

      -- -| 'and' returns the conjunction of a container of Bools.  For the
      -- result to be 'True', the container must be finite; 'False', however,
      -- results from a 'False' value finitely far from the left end.
      and :: Foldable t => t Bool -> Bool
      and x = case foldMap all_ x of
                Monoid.All y -> y

      -- -| 'or' returns the disjunction of a container of Bools.  For the
      -- result to be 'False', the container must be finite; 'True', however,
      -- results from a 'True' value finitely far from the left end.
      or :: Foldable t => t Bool -> Bool
      or x = case foldMap any_ x of
               Monoid.Any y -> y

      -- -| Determines whether any element of the structure satisfies the predicate.
      any :: Foldable t => (a -> Bool) -> t a -> Bool
      any p x = case foldMap (any_ . p) x of
                  Monoid.Any y -> y

      -- -| Determines whether all elements of the structure satisfy the predicate.
      all :: Foldable t => (a -> Bool) -> t a -> Bool
      all p x = case foldMap (all_ . p) x of
                  Monoid.All y -> y

      -- -| The largest element of a non-empty structure with respect to the
      -- given comparison function.

      -- See Note [maximumBy/minimumBy space usage]
      maximumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
      maximumBy cmp = foldl1 max'
        where max' x y = case cmp x y of
                              GT -> x
                              LT -> y
                              EQ -> y

      -- -| The least element of a non-empty structure with respect to the
      -- given comparison function.

      -- See Note [maximumBy/minimumBy space usage]
      minimumBy :: Foldable t => (a -> a -> Ordering) -> t a -> a
      minimumBy cmp = foldl1 min'
        where min' x y = case cmp x y of
                              GT -> y
                              LT -> x
                              EQ -> x

      -- -| 'notElem' is the negation of 'elem'.
      notElem :: (Foldable t, Eq a) => a -> t a -> Bool
      notElem x = not . elem x

      -- -| The 'find' function takes a predicate and a structure and returns
      -- the leftmost element of the structure matching the predicate, or
      -- 'Nothing' if there is no such element.
      find :: Foldable t => (a -> Bool) -> t a -> Maybe a
      find p y = case foldMap (\ x -> First (if p x then Just x else Nothing)) y of
                   First z -> z
      |])

    $(singletonsOnly [d|
      -- instances for Prelude types (part 2)

      deriving instance Foldable ((,) a)
      deriving instance Foldable First
      deriving instance Foldable Last
      |])