{-# LANGUAGE CPP                     #-}
{-# LANGUAGE ConstrainedClassMethods #-}
{-# LANGUAGE ConstraintKinds         #-}
{-# LANGUAGE DataKinds               #-}
{-# LANGUAGE DefaultSignatures       #-}
{-# LANGUAGE FlexibleContexts        #-}
{-# LANGUAGE FlexibleInstances       #-}
{-# LANGUAGE Trustworthy             #-}
{-# LANGUAGE TypeFamilies            #-}
{-# LANGUAGE TypeOperators           #-}
{-# LANGUAGE UndecidableInstances    #-}

{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
{-# OPTIONS_GHC -Wno-unused-type-patterns #-}

-- | Reimagined approach for 'Foldable' type hierarchy. Forbids usages
-- of 'length' function and similar over 'Maybe' and other potentially unsafe
-- data types. It was proposed to use @-XTypeApplication@ for such cases.
-- But this approach is not robust enough because programmers are human and can
-- easily forget to do this. For discussion see this topic:
-- <https://www.reddit.com/r/haskell/comments/60r9hu/proposal_suggest_explicit_type_application_for/ Suggest explicit type application for Foldable length and friends>

module Universum.Container.Class
       ( -- * Foldable-like classes and methods
         ToPairs   (..)
       , FromList  (..)
       , Container (..)
       , checkingNotNull

       , flipfoldl'

       , sum
       , product

       , mapM_
       , forM_
       , traverse_
       , for_
       , sequenceA_
       , sequence_
       , asum

         -- * Others
       , One(..)
       ) where

import Data.Coerce (Coercible, coerce)
import Data.Kind (Type)
import Prelude hiding (all, and, any, elem, foldMap, foldl, foldr, mapM_, notElem, null, or, print,
                product, sequence_, sum)

import Universum.Applicative (Alternative (..), Const, ZipList (..), pass)
import Universum.Base (HasCallStack, Word8)
import Universum.Container.Reexport (HashMap, HashSet, Hashable, IntMap, IntSet, Map, Seq, Set,
                                     Vector)
import Universum.Functor (Identity)
import Universum.Monoid (All (..), Any (..), Dual, First (..), Last, Product, Sum)

import qualified GHC.Exts as Exts
import GHC.TypeLits (ErrorMessage (..), Symbol, TypeError)

import qualified Data.List.NonEmpty as NE
import Universum.List.Reexport (NonEmpty)

import qualified Data.Foldable as Foldable

import qualified Data.Sequence as SEQ

import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BSL

import qualified Data.Text as T
import qualified Data.Text.Lazy as TL

import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HashSet
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import qualified Data.Map as M
import qualified Data.Set as Set

import qualified Data.Vector as V
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Unboxed as VU

-- $setup
-- >>> import Universum.Base (even)
-- >>> import Universum.Bool (when)
-- >>> import Universum.Print (print, putTextLn)
-- >>> import Universum.String (Text)
-- >>> import qualified Data.HashMap.Strict as HashMap

----------------------------------------------------------------------------
-- ToPairs
----------------------------------------------------------------------------

{- | Type class for data types that can be converted to List of Pairs.
 You can define 'ToPairs' by just defining 'toPairs' function.

 But the following laws should be met:

@
'toPairs' m ≡ 'zip' ('keys' m) ('elems' m)
'keys'      ≡ 'map' 'fst' . 'toPairs'
'elems'     ≡ 'map' 'snd' . 'toPairs'
@

-}
class ToPairs t where
    {-# MINIMAL toPairs #-}
    -- | Type of keys of the mapping.
    type Key t :: Type
    -- | Type of value of the mapping.
    type Val t :: Type

    -- | Converts the structure to the list of the key-value pairs.
    -- >>> toPairs (HashMap.fromList [('a', "xxx"), ('b', "yyy")])
    -- [('a',"xxx"),('b',"yyy")]
    toPairs :: t -> [(Key t, Val t)]

    -- | Converts the structure to the list of the keys.
    --
    -- >>> keys (HashMap.fromList [('a', "xxx"), ('b', "yyy")])
    -- "ab"
    keys :: t -> [Key t]
    keys = ((Key t, Val t) -> Key t) -> [(Key t, Val t)] -> [Key t]
forall a b. (a -> b) -> [a] -> [b]
map (Key t, Val t) -> Key t
forall a b. (a, b) -> a
fst ([(Key t, Val t)] -> [Key t])
-> (t -> [(Key t, Val t)]) -> t -> [Key t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [(Key t, Val t)]
forall t. ToPairs t => t -> [(Key t, Val t)]
toPairs
    {-# INLINE keys #-}

    -- | Converts the structure to the list of the values.
    --
    -- >>> elems (HashMap.fromList [('a', "xxx"), ('b', "yyy")])
    -- ["xxx","yyy"]
    elems :: t -> [Val t]
    elems = ((Key t, Val t) -> Val t) -> [(Key t, Val t)] -> [Val t]
forall a b. (a -> b) -> [a] -> [b]
map (Key t, Val t) -> Val t
forall a b. (a, b) -> b
snd ([(Key t, Val t)] -> [Val t])
-> (t -> [(Key t, Val t)]) -> t -> [Val t]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [(Key t, Val t)]
forall t. ToPairs t => t -> [(Key t, Val t)]
toPairs
    {-# INLINE elems #-}

-- Instances

instance ToPairs (HashMap k v) where
    type Key (HashMap k v) = k
    type Val (HashMap k v) = v
    toPairs :: HashMap k v -> [(Key (HashMap k v), Val (HashMap k v))]
toPairs = HashMap k v -> [(Key (HashMap k v), Val (HashMap k v))]
forall k v. HashMap k v -> [(k, v)]
HM.toList
    {-# INLINE toPairs #-}
    keys :: HashMap k v -> [Key (HashMap k v)]
keys    = HashMap k v -> [Key (HashMap k v)]
forall k v. HashMap k v -> [k]
HM.keys
    {-# INLINE keys #-}
    elems :: HashMap k v -> [Val (HashMap k v)]
elems   = HashMap k v -> [Val (HashMap k v)]
forall k v. HashMap k v -> [v]
HM.elems
    {-# INLINE elems #-}

instance ToPairs (IntMap v) where
    type Key (IntMap v) = Int
    type Val (IntMap v) = v
    toPairs :: IntMap v -> [(Key (IntMap v), Val (IntMap v))]
toPairs = IntMap v -> [(Key (IntMap v), Val (IntMap v))]
forall a. IntMap a -> [(Key, a)]
IM.toList
    {-# INLINE toPairs #-}
    keys :: IntMap v -> [Key (IntMap v)]
keys    = IntMap v -> [Key (IntMap v)]
forall a. IntMap a -> [Key]
IM.keys
    {-# INLINE keys #-}
    elems :: IntMap v -> [Val (IntMap v)]
elems   = IntMap v -> [Val (IntMap v)]
forall a. IntMap a -> [a]
IM.elems
    {-# INLINE elems #-}

instance ToPairs (Map k v) where
    type Key (Map k v) = k
    type Val (Map k v) = v
    toPairs :: Map k v -> [(Key (Map k v), Val (Map k v))]
toPairs = Map k v -> [(Key (Map k v), Val (Map k v))]
forall k a. Map k a -> [(k, a)]
M.toList
    {-# INLINE toPairs #-}
    keys :: Map k v -> [Key (Map k v)]
keys    = Map k v -> [Key (Map k v)]
forall k a. Map k a -> [k]
M.keys
    {-# INLINE keys #-}
    elems :: Map k v -> [Val (Map k v)]
elems   = Map k v -> [Val (Map k v)]
forall k a. Map k a -> [a]
M.elems
    {-# INLINE elems #-}

instance ToPairs [(k, v)] where
    type Key [(k, v)] = k
    type Val [(k, v)] = v
    toPairs :: [(k, v)] -> [(Key [(k, v)], Val [(k, v)])]
toPairs = [(k, v)] -> [(Key [(k, v)], Val [(k, v)])]
forall a. a -> a
id
    {-# INLINE toPairs #-}

instance ToPairs (NonEmpty (k, v)) where
    type Key (NonEmpty (k, v)) = k
    type Val (NonEmpty (k, v)) = v
    toPairs :: NonEmpty (k, v) -> [(Key (NonEmpty (k, v)), Val (NonEmpty (k, v)))]
toPairs = NonEmpty (k, v) -> [(Key (NonEmpty (k, v)), Val (NonEmpty (k, v)))]
forall a. NonEmpty a -> [a]
NE.toList
    {-# INLINE toPairs #-}

----------------------------------------------------------------------------
-- FromList
----------------------------------------------------------------------------

-- | Type class for data types that can be constructed from a list.
class FromList l where
  type ListElement l :: Type
  type ListElement l = Exts.Item l

  type FromListC l :: Exts.Constraint
  type FromListC l = ()

  {- | Make a value from list.

  For simple types like '[]' and 'Set':

  @
  'toList' . 'fromList' ≡ id
  'fromList' . 'toList' ≡ id
  @

  For map-like types:

  @
  'toPairs' . 'fromList' ≡ id
  'fromList' . 'toPairs' ≡ id
  @

  -}
  fromList :: FromListC l => [ListElement l] -> l
  default fromList
    :: (Exts.IsList l, Exts.Item l ~ a, ListElement l ~ a)
    => [ListElement l] -> l
  fromList = [ListElement l] -> l
forall l. IsList l => [Item l] -> l
Exts.fromList

instance FromList [a]
instance FromList (Vector a)
instance FromList (Seq a)
instance FromList (ZipList a) where
    type ListElement (ZipList a) = a
    fromList :: [ListElement (ZipList a)] -> ZipList a
fromList = [ListElement (ZipList a)] -> ZipList a
forall a. [a] -> ZipList a
ZipList
instance FromList (NonEmpty a) where
    type FromListC (NonEmpty a) = HasCallStack
    fromList :: [ListElement (NonEmpty a)] -> NonEmpty a
fromList [ListElement (NonEmpty a)]
l = case [ListElement (NonEmpty a)]
l of
      []     -> [Char] -> NonEmpty a
forall a. HasCallStack => [Char] -> a
error [Char]
"empty list"
      ListElement (NonEmpty a)
x : [ListElement (NonEmpty a)]
xs -> a
ListElement (NonEmpty a)
x a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
NE.:| [a]
[ListElement (NonEmpty a)]
xs

instance FromList IntSet
instance Ord a => FromList (Set a)
instance (Eq k, Hashable k) => FromList (HashMap k v)
instance FromList (IntMap v)
instance Ord k => FromList (Map k v)

instance FromList T.Text
instance FromList TL.Text
instance FromList BS.ByteString where
    type ListElement BS.ByteString = Word8
    fromList :: [ListElement ByteString] -> ByteString
fromList = [Word8] -> ByteString
[ListElement ByteString] -> ByteString
BS.pack
instance FromList BSL.ByteString where
    type ListElement BSL.ByteString = Word8
    fromList :: [ListElement ByteString] -> ByteString
fromList = [Word8] -> ByteString
[ListElement ByteString] -> ByteString
BSL.pack

----------------------------------------------------------------------------
-- Containers (e.g. tuples and Maybe aren't containers)
----------------------------------------------------------------------------

-- | Default implementation of 'Element' associated type family.
type family ElementDefault (t :: Type) :: Type where
    ElementDefault (_ a) = a

-- | Very similar to 'Foldable' but also allows instances for monomorphic types
-- like 'Text' but forbids instances for 'Maybe' and similar. This class is used as
-- a replacement for 'Foldable' type class. It solves the following problems:
--
-- 1. 'length', 'foldr' and other functions work on more types for which it makes sense.
-- 2. You can't accidentally use 'length' on polymorphic 'Foldable' (like list),
--    replace list with 'Maybe' and then debug error for two days.
-- 3. More efficient implementaions of functions for polymorphic types (like 'elem' for 'Set').
--
-- The drawbacks:
--
-- 1. Type signatures of polymorphic functions look more scary.
-- 2. Orphan instances are involved if you want to use 'foldr' (and similar) on types from libraries.
class Container t where
    -- | Type of element for some container. Implemented as an asscociated type family because
    -- some containers are monomorphic over element type (like 'T.Text', 'IntSet', etc.)
    -- so we can't implement nice interface using old higher-kinded types
    -- approach. Implementing this as an associated type family instead of
    -- top-level family gives you more control over element types.
    type Element t :: Type
    type Element t = ElementDefault t

    -- | Convert container to list of elements.
    --
    -- >>> toList @Text "aba"
    -- "aba"
    -- >>> :t toList @Text "aba"
    -- toList @Text "aba" :: [Char]
    toList :: t -> [Element t]
    default toList :: (Foldable f, t ~ f a, Element t ~ a) => t -> [Element t]
    toList = t -> [Element t]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList
    {-# INLINE toList #-}

    -- | Checks whether container is empty.
    --
    -- >>> null @Text ""
    -- True
    -- >>> null @Text "aba"
    -- False
    null :: t -> Bool
    default null :: (Foldable f, t ~ f a) => t -> Bool
    null = t -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Foldable.null
    {-# INLINE null #-}

    foldr :: (Element t -> b -> b) -> b -> t -> b
    default foldr :: (Foldable f, t ~ f a, Element t ~ a) => (Element t -> b -> b) -> b -> t -> b
    foldr = (Element t -> b -> b) -> b -> t -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Foldable.foldr
    {-# INLINE foldr #-}

    foldl :: (b -> Element t -> b) -> b -> t -> b
    default foldl :: (Foldable f, t ~ f a, Element t ~ a) => (b -> Element t -> b) -> b -> t -> b
    foldl = (b -> Element t -> b) -> b -> t -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl
    {-# INLINE foldl #-}

    foldl' :: (b -> Element t -> b) -> b -> t -> b
    default foldl' :: (Foldable f, t ~ f a, Element t ~ a) => (b -> Element t -> b) -> b -> t -> b
    foldl' = (b -> Element t -> b) -> b -> t -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl'
    {-# INLINE foldl' #-}

    length :: t -> Int
    default length :: (Foldable f, t ~ f a) => t -> Int
    length = t -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
Foldable.length
    {-# INLINE length #-}

    elem :: Eq (Element t) => Element t -> t -> Bool
    default elem :: ( Foldable f
                    , t ~ f a
                    , Element t ~ a
                    , Eq a
                    ) => Element t -> t -> Bool
    elem = Element t -> t -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Foldable.elem
    {-# INLINE elem #-}

    foldMap :: Monoid m => (Element t -> m) -> t -> m
    foldMap Element t -> m
f = (Element t -> m -> m) -> m -> t -> m
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr (m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (m -> m -> m) -> (Element t -> m) -> Element t -> m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element t -> m
f) m
forall a. Monoid a => a
mempty
    {-# INLINE foldMap #-}

    fold :: Monoid (Element t) => t -> Element t
    fold = (Element t -> Element t) -> t -> Element t
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Element t -> Element t
forall a. a -> a
id
    {-# INLINE fold #-}

    foldr' :: (Element t -> b -> b) -> b -> t -> b
    foldr' Element t -> b -> b
f b
z0 t
xs = ((b -> b) -> Element t -> b -> b) -> (b -> b) -> t -> b -> b
forall t b. Container t => (b -> Element t -> b) -> b -> t -> b
foldl (b -> b) -> Element t -> b -> b
f' b -> b
forall a. a -> a
id t
xs b
z0
      where f' :: (b -> b) -> Element t -> b -> b
f' b -> b
k Element t
x b
z = b -> b
k (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$! Element t -> b -> b
f Element t
x b
z
    {-# INLINE foldr' #-}

    notElem :: Eq (Element t) => Element t -> t -> Bool
    notElem Element t
x = Bool -> Bool
not (Bool -> Bool) -> (t -> Bool) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element t -> t -> Bool
forall t. (Container t, Eq (Element t)) => Element t -> t -> Bool
elem Element t
x
    {-# INLINE notElem #-}

    all :: (Element t -> Bool) -> t -> Bool
    all Element t -> Bool
p = All -> Bool
getAll (All -> Bool) -> (t -> All) -> t -> Bool
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (Element t -> All) -> t -> All
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap (Bool -> All
All (Bool -> All) -> (Element t -> Bool) -> Element t -> All
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Element t -> Bool
p)
    any :: (Element t -> Bool) -> t -> Bool
    any Element t -> Bool
p = Any -> Bool
getAny (Any -> Bool) -> (t -> Any) -> t -> Bool
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (Element t -> Any) -> t -> Any
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap (Bool -> Any
Any (Bool -> Any) -> (Element t -> Bool) -> Element t -> Any
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. Element t -> Bool
p)
    {-# INLINE all #-}
    {-# INLINE any #-}

    and :: (Element t ~ Bool) => t -> Bool
    and = All -> Bool
getAll (All -> Bool) -> (t -> All) -> t -> Bool
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (Element t -> All) -> t -> All
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Bool -> All
Element t -> All
All
    or :: (Element t ~ Bool) => t -> Bool
    or = Any -> Bool
getAny (Any -> Bool) -> (t -> Any) -> t -> Bool
forall b c a. Coercible b c => (b -> c) -> (a -> b) -> a -> c
#. (Element t -> Any) -> t -> Any
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap Bool -> Any
Element t -> Any
Any
    {-# INLINE and #-}
    {-# INLINE or #-}

    find :: (Element t -> Bool) -> t -> Maybe (Element t)
    find Element t -> Bool
p = First (Element t) -> Maybe (Element t)
forall a. First a -> Maybe a
getFirst (First (Element t) -> Maybe (Element t))
-> (t -> First (Element t)) -> t -> Maybe (Element t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element t -> First (Element t)) -> t -> First (Element t)
forall t m. (Container t, Monoid m) => (Element t -> m) -> t -> m
foldMap (\ Element t
x -> Maybe (Element t) -> First (Element t)
forall a. Maybe a -> First a
First (if Element t -> Bool
p Element t
x then Element t -> Maybe (Element t)
forall a. a -> Maybe a
Just Element t
x else Maybe (Element t)
forall a. Maybe a
Nothing))
    {-# INLINE find #-}

    safeHead :: t -> Maybe (Element t)
    safeHead = (Element t -> Maybe (Element t) -> Maybe (Element t))
-> Maybe (Element t) -> t -> Maybe (Element t)
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr (\Element t
x Maybe (Element t)
_ -> Element t -> Maybe (Element t)
forall a. a -> Maybe a
Just Element t
x) Maybe (Element t)
forall a. Maybe a
Nothing
    {-# INLINE safeHead #-}

    safeMaximum :: Ord (Element t) => t -> Maybe (Element t)
    default safeMaximum
      :: (Foldable f, t ~ f a, Element t ~ a, Ord (Element t))
      => t -> Maybe (Element t)
    safeMaximum = (f a -> Element (f a)) -> f a -> Maybe (Element (f a))
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull f a -> Element (f a)
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Foldable.maximum
    {-# INLINE safeMaximum #-}

    safeMinimum :: Ord (Element t) => t -> Maybe (Element t)
    default safeMinimum
      :: (Foldable f, t ~ f a, Element t ~ a, Ord (Element t))
      => t -> Maybe (Element t)
    safeMinimum = (f a -> Element (f a)) -> f a -> Maybe (Element (f a))
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull f a -> Element (f a)
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
Foldable.minimum
    {-# INLINE safeMinimum #-}

    safeFoldr1 :: (Element t -> Element t -> Element t) -> t -> Maybe (Element t)
    safeFoldr1 Element t -> Element t -> Element t
f t
xs = (Element t -> Maybe (Element t) -> Maybe (Element t))
-> Maybe (Element t) -> t -> Maybe (Element t)
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr Element t -> Maybe (Element t) -> Maybe (Element t)
mf Maybe (Element t)
forall a. Maybe a
Nothing t
xs
      where
        mf :: Element t -> Maybe (Element t) -> Maybe (Element t)
mf Element t
x Maybe (Element t)
m = Element t -> Maybe (Element t)
forall a. a -> Maybe a
Just (case Maybe (Element t)
m of
                           Maybe (Element t)
Nothing -> Element t
x
                           Just Element t
y  -> Element t -> Element t -> Element t
f Element t
x Element t
y)
    {-# INLINE safeFoldr1 #-}

    safeFoldl1 :: (Element t -> Element t -> Element t) -> t -> Maybe (Element t)
    safeFoldl1 Element t -> Element t -> Element t
f t
xs = (Maybe (Element t) -> Element t -> Maybe (Element t))
-> Maybe (Element t) -> t -> Maybe (Element t)
forall t b. Container t => (b -> Element t -> b) -> b -> t -> b
foldl Maybe (Element t) -> Element t -> Maybe (Element t)
mf Maybe (Element t)
forall a. Maybe a
Nothing t
xs
      where
        mf :: Maybe (Element t) -> Element t -> Maybe (Element t)
mf Maybe (Element t)
m Element t
y = Element t -> Maybe (Element t)
forall a. a -> Maybe a
Just (case Maybe (Element t)
m of
                           Maybe (Element t)
Nothing -> Element t
y
                           Just Element t
x  -> Element t -> Element t -> Element t
f Element t
x Element t
y)
    {-# INLINE safeFoldl1 #-}

-- | Helper for lifting operations which require container to be not empty.
checkingNotNull :: Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull :: (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull t -> Element t
f t
t
  | t -> Bool
forall t. Container t => t -> Bool
null t
t = Maybe (Element t)
forall a. Maybe a
Nothing
  | Bool
otherwise = Element t -> Maybe (Element t)
forall a. a -> Maybe a
Just (Element t -> Maybe (Element t)) -> Element t -> Maybe (Element t)
forall a b. (a -> b) -> a -> b
$ t -> Element t
f t
t
{-# INLINE checkingNotNull #-}

----------------------------------------------------------------------------
-- Instances for monomorphic containers
----------------------------------------------------------------------------

instance Container T.Text where
    type Element T.Text = Char
    toList :: Text -> [Element Text]
toList = Text -> [Char]
Text -> [Element Text]
T.unpack
    {-# INLINE toList #-}
    null :: Text -> Bool
null = Text -> Bool
T.null
    {-# INLINE null #-}
    foldr :: (Element Text -> b -> b) -> b -> Text -> b
foldr = (Element Text -> b -> b) -> b -> Text -> b
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr
    {-# INLINE foldr #-}
    foldl :: (b -> Element Text -> b) -> b -> Text -> b
foldl = (b -> Element Text -> b) -> b -> Text -> b
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl
    {-# INLINE foldl #-}
    foldl' :: (b -> Element Text -> b) -> b -> Text -> b
foldl' = (b -> Element Text -> b) -> b -> Text -> b
forall a. (a -> Char -> a) -> a -> Text -> a
T.foldl'
    {-# INLINE foldl' #-}
    safeFoldr1 :: (Element Text -> Element Text -> Element Text)
-> Text -> Maybe (Element Text)
safeFoldr1 Element Text -> Element Text -> Element Text
f = (Text -> Element Text) -> Text -> Maybe (Element Text)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ((Char -> Char -> Char) -> Text -> Char
T.foldr1 Char -> Char -> Char
Element Text -> Element Text -> Element Text
f)
    {-# INLINE safeFoldr1 #-}
    safeFoldl1 :: (Element Text -> Element Text -> Element Text)
-> Text -> Maybe (Element Text)
safeFoldl1 Element Text -> Element Text -> Element Text
f = (Text -> Element Text) -> Text -> Maybe (Element Text)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ((Char -> Char -> Char) -> Text -> Char
T.foldl1 Char -> Char -> Char
Element Text -> Element Text -> Element Text
f)
    {-# INLINE safeFoldl1 #-}
    length :: Text -> Key
length = Text -> Key
T.length
    {-# INLINE length #-}
    elem :: Element Text -> Text -> Bool
elem Element Text
c = Text -> Text -> Bool
T.isInfixOf (Char -> Text
T.singleton Char
Element Text
c)  -- there are rewrite rules for this
    {-# INLINE elem #-}
    safeMaximum :: Text -> Maybe (Element Text)
safeMaximum = (Text -> Element Text) -> Text -> Maybe (Element Text)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull Text -> Char
Text -> Element Text
T.maximum
    {-# INLINE safeMaximum #-}
    safeMinimum :: Text -> Maybe (Element Text)
safeMinimum = (Text -> Element Text) -> Text -> Maybe (Element Text)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull Text -> Char
Text -> Element Text
T.minimum
    {-# INLINE safeMinimum #-}
    all :: (Element Text -> Bool) -> Text -> Bool
all = (Char -> Bool) -> Text -> Bool
(Element Text -> Bool) -> Text -> Bool
T.all
    {-# INLINE all #-}
    any :: (Element Text -> Bool) -> Text -> Bool
any = (Char -> Bool) -> Text -> Bool
(Element Text -> Bool) -> Text -> Bool
T.any
    {-# INLINE any #-}
    find :: (Element Text -> Bool) -> Text -> Maybe (Element Text)
find = (Char -> Bool) -> Text -> Maybe Char
(Element Text -> Bool) -> Text -> Maybe (Element Text)
T.find
    {-# INLINE find #-}
    safeHead :: Text -> Maybe (Element Text)
safeHead = ((Char, Text) -> Char) -> Maybe (Char, Text) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, Text) -> Char
forall a b. (a, b) -> a
fst (Maybe (Char, Text) -> Maybe Char)
-> (Text -> Maybe (Char, Text)) -> Text -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
T.uncons
    {-# INLINE safeHead #-}

instance Container TL.Text where
    type Element TL.Text = Char
    toList :: Text -> [Element Text]
toList = Text -> [Char]
Text -> [Element Text]
TL.unpack
    {-# INLINE toList #-}
    null :: Text -> Bool
null = Text -> Bool
TL.null
    {-# INLINE null #-}
    foldr :: (Element Text -> b -> b) -> b -> Text -> b
foldr = (Element Text -> b -> b) -> b -> Text -> b
forall a. (Char -> a -> a) -> a -> Text -> a
TL.foldr
    {-# INLINE foldr #-}
    foldl :: (b -> Element Text -> b) -> b -> Text -> b
foldl = (b -> Element Text -> b) -> b -> Text -> b
forall a. (a -> Char -> a) -> a -> Text -> a
TL.foldl
    {-# INLINE foldl #-}
    foldl' :: (b -> Element Text -> b) -> b -> Text -> b
foldl' = (b -> Element Text -> b) -> b -> Text -> b
forall a. (a -> Char -> a) -> a -> Text -> a
TL.foldl'
    {-# INLINE foldl' #-}
    safeFoldr1 :: (Element Text -> Element Text -> Element Text)
-> Text -> Maybe (Element Text)
safeFoldr1 Element Text -> Element Text -> Element Text
f = (Text -> Element Text) -> Text -> Maybe (Element Text)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ((Char -> Char -> Char) -> Text -> Char
TL.foldr1 Char -> Char -> Char
Element Text -> Element Text -> Element Text
f)
    {-# INLINE safeFoldr1 #-}
    safeFoldl1 :: (Element Text -> Element Text -> Element Text)
-> Text -> Maybe (Element Text)
safeFoldl1 Element Text -> Element Text -> Element Text
f = (Text -> Element Text) -> Text -> Maybe (Element Text)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ((Char -> Char -> Char) -> Text -> Char
TL.foldl1 Char -> Char -> Char
Element Text -> Element Text -> Element Text
f)
    {-# INLINE safeFoldl1 #-}
    length :: Text -> Key
length = Int64 -> Key
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Key) -> (Text -> Int64) -> Text -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64
TL.length
    {-# INLINE length #-}
    -- will be okay thanks to rewrite rules
    elem :: Element Text -> Text -> Bool
elem Element Text
c Text
s = Text -> Text -> Bool
TL.isInfixOf (Char -> Text
TL.singleton Char
Element Text
c) Text
s
    {-# INLINE elem #-}
    safeMaximum :: Text -> Maybe (Element Text)
safeMaximum = (Text -> Element Text) -> Text -> Maybe (Element Text)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull Text -> Char
Text -> Element Text
TL.maximum
    {-# INLINE safeMaximum #-}
    safeMinimum :: Text -> Maybe (Element Text)
safeMinimum = (Text -> Element Text) -> Text -> Maybe (Element Text)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull Text -> Char
Text -> Element Text
TL.minimum
    {-# INLINE safeMinimum #-}
    all :: (Element Text -> Bool) -> Text -> Bool
all = (Char -> Bool) -> Text -> Bool
(Element Text -> Bool) -> Text -> Bool
TL.all
    {-# INLINE all #-}
    any :: (Element Text -> Bool) -> Text -> Bool
any = (Char -> Bool) -> Text -> Bool
(Element Text -> Bool) -> Text -> Bool
TL.any
    {-# INLINE any #-}
    find :: (Element Text -> Bool) -> Text -> Maybe (Element Text)
find = (Char -> Bool) -> Text -> Maybe Char
(Element Text -> Bool) -> Text -> Maybe (Element Text)
TL.find
    {-# INLINE find #-}
    safeHead :: Text -> Maybe (Element Text)
safeHead = ((Char, Text) -> Char) -> Maybe (Char, Text) -> Maybe Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Char, Text) -> Char
forall a b. (a, b) -> a
fst (Maybe (Char, Text) -> Maybe Char)
-> (Text -> Maybe (Char, Text)) -> Text -> Maybe Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
TL.uncons
    {-# INLINE safeHead #-}

instance Container BS.ByteString where
    type Element BS.ByteString = Word8
    toList :: ByteString -> [Element ByteString]
toList = ByteString -> [Word8]
ByteString -> [Element ByteString]
BS.unpack
    {-# INLINE toList #-}
    null :: ByteString -> Bool
null = ByteString -> Bool
BS.null
    {-# INLINE null #-}
    foldr :: (Element ByteString -> b -> b) -> b -> ByteString -> b
foldr = (Element ByteString -> b -> b) -> b -> ByteString -> b
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BS.foldr
    {-# INLINE foldr #-}
    foldl :: (b -> Element ByteString -> b) -> b -> ByteString -> b
foldl = (b -> Element ByteString -> b) -> b -> ByteString -> b
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl
    {-# INLINE foldl #-}
    foldl' :: (b -> Element ByteString -> b) -> b -> ByteString -> b
foldl' = (b -> Element ByteString -> b) -> b -> ByteString -> b
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl'
    {-# INLINE foldl' #-}
    safeFoldr1 :: (Element ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
safeFoldr1 Element ByteString -> Element ByteString -> Element ByteString
f = (ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ((Word8 -> Word8 -> Word8) -> ByteString -> Word8
BS.foldr1 Word8 -> Word8 -> Word8
Element ByteString -> Element ByteString -> Element ByteString
f)
    {-# INLINE safeFoldr1 #-}
    safeFoldl1 :: (Element ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
safeFoldl1 Element ByteString -> Element ByteString -> Element ByteString
f = (ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ((Word8 -> Word8 -> Word8) -> ByteString -> Word8
BS.foldl1 Word8 -> Word8 -> Word8
Element ByteString -> Element ByteString -> Element ByteString
f)
    {-# INLINE safeFoldl1 #-}
    length :: ByteString -> Key
length = ByteString -> Key
BS.length
    {-# INLINE length #-}
    elem :: Element ByteString -> ByteString -> Bool
elem = Word8 -> ByteString -> Bool
Element ByteString -> ByteString -> Bool
BS.elem
    {-# INLINE elem #-}
    notElem :: Element ByteString -> ByteString -> Bool
notElem = Word8 -> ByteString -> Bool
Element ByteString -> ByteString -> Bool
BS.notElem
    {-# INLINE notElem #-}
    safeMaximum :: ByteString -> Maybe (Element ByteString)
safeMaximum = (ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ByteString -> Word8
ByteString -> Element ByteString
BS.maximum
    {-# INLINE safeMaximum #-}
    safeMinimum :: ByteString -> Maybe (Element ByteString)
safeMinimum = (ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ByteString -> Word8
ByteString -> Element ByteString
BS.minimum
    {-# INLINE safeMinimum #-}
    all :: (Element ByteString -> Bool) -> ByteString -> Bool
all = (Word8 -> Bool) -> ByteString -> Bool
(Element ByteString -> Bool) -> ByteString -> Bool
BS.all
    {-# INLINE all #-}
    any :: (Element ByteString -> Bool) -> ByteString -> Bool
any = (Word8 -> Bool) -> ByteString -> Bool
(Element ByteString -> Bool) -> ByteString -> Bool
BS.any
    {-# INLINE any #-}
    find :: (Element ByteString -> Bool)
-> ByteString -> Maybe (Element ByteString)
find = (Word8 -> Bool) -> ByteString -> Maybe Word8
(Element ByteString -> Bool)
-> ByteString -> Maybe (Element ByteString)
BS.find
    {-# INLINE find #-}
    safeHead :: ByteString -> Maybe (Element ByteString)
safeHead = ((Word8, ByteString) -> Word8)
-> Maybe (Word8, ByteString) -> Maybe Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8, ByteString) -> Word8
forall a b. (a, b) -> a
fst (Maybe (Word8, ByteString) -> Maybe Word8)
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> Maybe Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Word8, ByteString)
BS.uncons
    {-# INLINE safeHead #-}

instance Container BSL.ByteString where
    type Element BSL.ByteString = Word8
    toList :: ByteString -> [Element ByteString]
toList = ByteString -> [Word8]
ByteString -> [Element ByteString]
BSL.unpack
    {-# INLINE toList #-}
    null :: ByteString -> Bool
null = ByteString -> Bool
BSL.null
    {-# INLINE null #-}
    foldr :: (Element ByteString -> b -> b) -> b -> ByteString -> b
foldr = (Element ByteString -> b -> b) -> b -> ByteString -> b
forall a. (Word8 -> a -> a) -> a -> ByteString -> a
BSL.foldr
    {-# INLINE foldr #-}
    foldl :: (b -> Element ByteString -> b) -> b -> ByteString -> b
foldl = (b -> Element ByteString -> b) -> b -> ByteString -> b
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BSL.foldl
    {-# INLINE foldl #-}
    foldl' :: (b -> Element ByteString -> b) -> b -> ByteString -> b
foldl' = (b -> Element ByteString -> b) -> b -> ByteString -> b
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BSL.foldl'
    {-# INLINE foldl' #-}
    safeFoldr1 :: (Element ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
safeFoldr1 Element ByteString -> Element ByteString -> Element ByteString
f = (ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ((Word8 -> Word8 -> Word8) -> ByteString -> Word8
BSL.foldr1 Word8 -> Word8 -> Word8
Element ByteString -> Element ByteString -> Element ByteString
f)
    {-# INLINE safeFoldr1 #-}
    safeFoldl1 :: (Element ByteString -> Element ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
safeFoldl1 Element ByteString -> Element ByteString -> Element ByteString
f = (ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ((Word8 -> Word8 -> Word8) -> ByteString -> Word8
BSL.foldl1 Word8 -> Word8 -> Word8
Element ByteString -> Element ByteString -> Element ByteString
f)
    {-# INLINE safeFoldl1 #-}
    length :: ByteString -> Key
length = Int64 -> Key
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Key) -> (ByteString -> Int64) -> ByteString -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
BSL.length
    {-# INLINE length #-}
    elem :: Element ByteString -> ByteString -> Bool
elem = Word8 -> ByteString -> Bool
Element ByteString -> ByteString -> Bool
BSL.elem
    {-# INLINE elem #-}
    notElem :: Element ByteString -> ByteString -> Bool
notElem = Word8 -> ByteString -> Bool
Element ByteString -> ByteString -> Bool
BSL.notElem
    {-# INLINE notElem #-}
    safeMaximum :: ByteString -> Maybe (Element ByteString)
safeMaximum = (ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ByteString -> Word8
ByteString -> Element ByteString
BSL.maximum
    {-# INLINE safeMaximum #-}
    safeMinimum :: ByteString -> Maybe (Element ByteString)
safeMinimum = (ByteString -> Element ByteString)
-> ByteString -> Maybe (Element ByteString)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull ByteString -> Word8
ByteString -> Element ByteString
BSL.minimum
    {-# INLINE safeMinimum #-}
    all :: (Element ByteString -> Bool) -> ByteString -> Bool
all = (Word8 -> Bool) -> ByteString -> Bool
(Element ByteString -> Bool) -> ByteString -> Bool
BSL.all
    {-# INLINE all #-}
    any :: (Element ByteString -> Bool) -> ByteString -> Bool
any = (Word8 -> Bool) -> ByteString -> Bool
(Element ByteString -> Bool) -> ByteString -> Bool
BSL.any
    {-# INLINE any #-}
    find :: (Element ByteString -> Bool)
-> ByteString -> Maybe (Element ByteString)
find = (Word8 -> Bool) -> ByteString -> Maybe Word8
(Element ByteString -> Bool)
-> ByteString -> Maybe (Element ByteString)
BSL.find
    {-# INLINE find #-}
    safeHead :: ByteString -> Maybe (Element ByteString)
safeHead = ((Word8, ByteString) -> Word8)
-> Maybe (Word8, ByteString) -> Maybe Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8, ByteString) -> Word8
forall a b. (a, b) -> a
fst (Maybe (Word8, ByteString) -> Maybe Word8)
-> (ByteString -> Maybe (Word8, ByteString))
-> ByteString
-> Maybe Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Word8, ByteString)
BSL.uncons
    {-# INLINE safeHead #-}

instance Container IntSet where
    type Element IntSet = Int
    toList :: IntSet -> [Element IntSet]
toList = IntSet -> [Key]
IntSet -> [Element IntSet]
IS.toList
    {-# INLINE toList #-}
    null :: IntSet -> Bool
null = IntSet -> Bool
IS.null
    {-# INLINE null #-}
    foldr :: (Element IntSet -> b -> b) -> b -> IntSet -> b
foldr = (Element IntSet -> b -> b) -> b -> IntSet -> b
forall b. (Key -> b -> b) -> b -> IntSet -> b
IS.foldr
    {-# INLINE foldr #-}
    foldl :: (b -> Element IntSet -> b) -> b -> IntSet -> b
foldl = (b -> Element IntSet -> b) -> b -> IntSet -> b
forall a. (a -> Key -> a) -> a -> IntSet -> a
IS.foldl
    {-# INLINE foldl #-}
    foldl' :: (b -> Element IntSet -> b) -> b -> IntSet -> b
foldl' = (b -> Element IntSet -> b) -> b -> IntSet -> b
forall a. (a -> Key -> a) -> a -> IntSet -> a
IS.foldl'
    {-# INLINE foldl' #-}
    length :: IntSet -> Key
length = IntSet -> Key
IS.size
    {-# INLINE length #-}
    elem :: Element IntSet -> IntSet -> Bool
elem = Key -> IntSet -> Bool
Element IntSet -> IntSet -> Bool
IS.member
    {-# INLINE elem #-}
    safeMaximum :: IntSet -> Maybe (Element IntSet)
safeMaximum = (IntSet -> Element IntSet) -> IntSet -> Maybe (Element IntSet)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull IntSet -> Key
IntSet -> Element IntSet
IS.findMax
    {-# INLINE safeMaximum #-}
    safeMinimum :: IntSet -> Maybe (Element IntSet)
safeMinimum = (IntSet -> Element IntSet) -> IntSet -> Maybe (Element IntSet)
forall t. Container t => (t -> Element t) -> t -> Maybe (Element t)
checkingNotNull IntSet -> Key
IntSet -> Element IntSet
IS.findMin
    {-# INLINE safeMinimum #-}
    safeHead :: IntSet -> Maybe (Element IntSet)
safeHead = ((Key, IntSet) -> Key) -> Maybe (Key, IntSet) -> Maybe Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Key, IntSet) -> Key
forall a b. (a, b) -> a
fst (Maybe (Key, IntSet) -> Maybe Key)
-> (IntSet -> Maybe (Key, IntSet)) -> IntSet -> Maybe Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntSet -> Maybe (Key, IntSet)
IS.minView
    {-# INLINE safeHead #-}

----------------------------------------------------------------------------
-- Efficient instances
----------------------------------------------------------------------------

instance Ord v => Container (Set v) where
    elem :: Element (Set v) -> Set v -> Bool
elem = Element (Set v) -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member
    {-# INLINE elem #-}
    notElem :: Element (Set v) -> Set v -> Bool
notElem = Element (Set v) -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.notMember
    {-# INLINE notElem #-}

instance (Eq v, Hashable v) => Container (HashSet v) where
    elem :: Element (HashSet v) -> HashSet v -> Bool
elem = Element (HashSet v) -> HashSet v -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HashSet.member
    {-# INLINE elem #-}

----------------------------------------------------------------------------
-- Boilerplate instances (duplicate Foldable)
----------------------------------------------------------------------------

-- Basic types
instance Container [a]
instance Container (Const a b)

-- Algebraic types
instance Container (Dual a)
instance Container (First a)
instance Container (Last a)
instance Container (Product a)
instance Container (Sum a)
instance Container (NonEmpty a)
instance Container (ZipList a)

-- Containers
instance Container (HashMap k v)
instance Container (IntMap v)
instance Container (Map k v)
instance Container (Seq a)
instance Container (Vector a)

----------------------------------------------------------------------------
-- Derivative functions
----------------------------------------------------------------------------

-- TODO: I should put different strings for different versions but I'm too lazy to do it...

{- | Similar to 'foldl'' but takes a function with its arguments flipped.

>>> flipfoldl' (/) 5 [2,3] :: Rational
15 % 2

-}
flipfoldl' :: (Container t, Element t ~ a) => (a -> b -> b) -> b -> t -> b
flipfoldl' :: (a -> b -> b) -> b -> t -> b
flipfoldl' a -> b -> b
f = (b -> Element t -> b) -> b -> t -> b
forall t b. Container t => (b -> Element t -> b) -> b -> t -> b
foldl' ((a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> b -> b
f)
{-# INLINE flipfoldl' #-}

-- | Stricter version of 'Prelude.sum'.
--
-- >>> sum [1..10]
-- 55
-- >>> sum (Just 3)
-- ...
--     • Do not use 'Foldable' methods on Maybe
--       Suggestions:
--           Instead of
--               for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()
--           use
--               whenJust  :: Applicative f => Maybe a    -> (a -> f ()) -> f ()
--               whenRight :: Applicative f => Either l r -> (r -> f ()) -> f ()
-- ...
--           Instead of
--               fold :: (Foldable t, Monoid m) => t m -> m
--           use
--               maybeToMonoid :: Monoid m => Maybe m -> m
-- ...
sum :: (Container t, Num (Element t)) => t -> Element t
sum :: t -> Element t
sum = (Element t -> Element t -> Element t)
-> Element t -> t -> Element t
forall t b. Container t => (b -> Element t -> b) -> b -> t -> b
foldl' Element t -> Element t -> Element t
forall a. Num a => a -> a -> a
(+) Element t
0

-- | Stricter version of 'Prelude.product'.
--
-- >>> product [1..10]
-- 3628800
-- >>> product (Right 3)
-- ...
--     • Do not use 'Foldable' methods on Either
--       Suggestions:
--           Instead of
--               for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()
--           use
--               whenJust  :: Applicative f => Maybe a    -> (a -> f ()) -> f ()
--               whenRight :: Applicative f => Either l r -> (r -> f ()) -> f ()
-- ...
--           Instead of
--               fold :: (Foldable t, Monoid m) => t m -> m
--           use
--               maybeToMonoid :: Monoid m => Maybe m -> m
-- ...
product :: (Container t, Num (Element t)) => t -> Element t
product :: t -> Element t
product = (Element t -> Element t -> Element t)
-> Element t -> t -> Element t
forall t b. Container t => (b -> Element t -> b) -> b -> t -> b
foldl' Element t -> Element t -> Element t
forall a. Num a => a -> a -> a
(*) Element t
1

{- | Constrained to 'Container' version of 'Data.Foldable.traverse_'.

>>> traverse_ putTextLn ["foo", "bar"]
foo
bar

-}
traverse_
    :: (Container t, Applicative f)
    => (Element t -> f b) -> t -> f ()
traverse_ :: (Element t -> f b) -> t -> f ()
traverse_ Element t -> f b
f = (Element t -> f () -> f ()) -> f () -> t -> f ()
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr (f b -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) (f b -> f () -> f ())
-> (Element t -> f b) -> Element t -> f () -> f ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element t -> f b
f) f ()
forall (f :: * -> *). Applicative f => f ()
pass

{- | Constrained to 'Container' version of 'Data.Foldable.for_'.

>>> for_ [1 .. 5 :: Int] $ \i -> when (even i) (print i)
2
4

-}
for_
    :: (Container t, Applicative f)
    => t -> (Element t -> f b) -> f ()
for_ :: t -> (Element t -> f b) -> f ()
for_ = ((Element t -> f b) -> t -> f ())
-> t -> (Element t -> f b) -> f ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Element t -> f b) -> t -> f ()
forall t (f :: * -> *) b.
(Container t, Applicative f) =>
(Element t -> f b) -> t -> f ()
traverse_
{-# INLINE for_ #-}

{- | Constrained to 'Container' version of 'Data.Foldable.mapM_'.

>>> mapM_ print [True, False]
True
False

-}
mapM_
    :: (Container t, Monad m)
    => (Element t -> m b) -> t -> m ()
mapM_ :: (Element t -> m b) -> t -> m ()
mapM_ Element t -> m b
f= (Element t -> m () -> m ()) -> m () -> t -> m ()
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr (m b -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) (m b -> m () -> m ())
-> (Element t -> m b) -> Element t -> m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element t -> m b
f) m ()
forall (f :: * -> *). Applicative f => f ()
pass

{- | Constrained to 'Container' version of 'Data.Foldable.forM_'.

>>> forM_ [True, False] print
True
False

-}
forM_
    :: (Container t, Monad m)
    => t -> (Element t -> m b) -> m ()
forM_ :: t -> (Element t -> m b) -> m ()
forM_ = ((Element t -> m b) -> t -> m ())
-> t -> (Element t -> m b) -> m ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Element t -> m b) -> t -> m ()
forall t (m :: * -> *) b.
(Container t, Monad m) =>
(Element t -> m b) -> t -> m ()
mapM_
{-# INLINE forM_ #-}

{- | Constrained to 'Container' version of 'Data.Foldable.sequenceA_'.

>>> sequenceA_ [putTextLn "foo", print True]
foo
True

-}
sequenceA_
    :: (Container t, Applicative f, Element t ~ f a)
    => t -> f ()
sequenceA_ :: t -> f ()
sequenceA_ = (Element t -> f () -> f ()) -> f () -> t -> f ()
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr Element t -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>) f ()
forall (f :: * -> *). Applicative f => f ()
pass

{- | Constrained to 'Container' version of 'Data.Foldable.sequence_'.

>>> sequence_ [putTextLn "foo", print True]
foo
True

-}
sequence_
    :: (Container t, Monad m, Element t ~ m a)
    => t -> m ()
sequence_ :: t -> m ()
sequence_ = (Element t -> m () -> m ()) -> m () -> t -> m ()
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr Element t -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
(>>) m ()
forall (f :: * -> *). Applicative f => f ()
pass

{- | Constrained to 'Container' version of 'Data.Foldable.asum'.

>>> asum [Nothing, Just [False, True], Nothing, Just [True]]
Just [False,True]

-}
asum
    :: (Container t, Alternative f, Element t ~ f a)
    => t -> f a
asum :: t -> f a
asum = (Element t -> f a -> f a) -> f a -> t -> f a
forall t b. Container t => (Element t -> b -> b) -> b -> t -> b
foldr Element t -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) f a
forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE asum #-}

----------------------------------------------------------------------------
-- Disallowed instances
----------------------------------------------------------------------------

type family DisallowInstance (z :: Symbol) :: ErrorMessage where
    DisallowInstance z  = Text "Do not use 'Foldable' methods on " :<>: Text z
        :$$: Text "Suggestions:"
        :$$: Text "    Instead of"
        :$$: Text "        for_ :: (Foldable t, Applicative f) => t a -> (a -> f b) -> f ()"
        :$$: Text "    use"
        :$$: Text "        whenJust  :: Applicative f => Maybe a    -> (a -> f ()) -> f ()"
        :$$: Text "        whenRight :: Applicative f => Either l r -> (r -> f ()) -> f ()"
        :$$: Text ""
        :$$: Text "    Instead of"
        :$$: Text "        fold :: (Foldable t, Monoid m) => t m -> m"
        :$$: Text "    use"
        :$$: Text "        maybeToMonoid :: Monoid m => Maybe m -> m"
        :$$: Text ""

instance TypeError (DisallowInstance "tuple")    => Container (a, b)
instance TypeError (DisallowInstance "Maybe")    => Container (Maybe a)
instance TypeError (DisallowInstance "Either")   => Container (Either a b)
instance TypeError (DisallowInstance "Identity") => Container (Identity a)

----------------------------------------------------------------------------
-- One
----------------------------------------------------------------------------

-- | Type class for types that can be created from one element. @singleton@
-- is lone name for this function. Also constructions of different type differ:
-- @:[]@ for lists, two arguments for Maps. Also some data types are monomorphic.
--
-- >>> one True :: [Bool]
-- [True]
-- >>> one 'a' :: Text
-- "a"
-- >>> one (3, "hello") :: HashMap Int String
-- fromList [(3,"hello")]
class One x where
    type OneItem x
    -- | Create a list, map, 'Text', etc from a single element.
    one :: OneItem x -> x

-- Lists

instance One [a] where
    type OneItem [a] = a
    one :: OneItem [a] -> [a]
one = (a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[])
    {-# INLINE one #-}

instance One (NE.NonEmpty a) where
    type OneItem (NE.NonEmpty a) = a
    one :: OneItem (NonEmpty a) -> NonEmpty a
one = (a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
NE.:|[])
    {-# INLINE one #-}

instance One (SEQ.Seq a) where
    type OneItem (SEQ.Seq a) = a
    one :: OneItem (Seq a) -> Seq a
one = (Seq a
forall a. Seq a
SEQ.empty Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
SEQ.|>)
    {-# INLINE one #-}

-- Monomorphic sequences

instance One T.Text where
    type OneItem T.Text = Char
    one :: OneItem Text -> Text
one = Char -> Text
OneItem Text -> Text
T.singleton
    {-# INLINE one #-}

instance One TL.Text where
    type OneItem TL.Text = Char
    one :: OneItem Text -> Text
one = Char -> Text
OneItem Text -> Text
TL.singleton
    {-# INLINE one #-}

instance One BS.ByteString where
    type OneItem BS.ByteString = Word8
    one :: OneItem ByteString -> ByteString
one = Word8 -> ByteString
OneItem ByteString -> ByteString
BS.singleton
    {-# INLINE one #-}

instance One BSL.ByteString where
    type OneItem BSL.ByteString = Word8
    one :: OneItem ByteString -> ByteString
one = Word8 -> ByteString
OneItem ByteString -> ByteString
BSL.singleton
    {-# INLINE one #-}

-- Maps

instance One (M.Map k v) where
    type OneItem (M.Map k v) = (k, v)
    one :: OneItem (Map k v) -> Map k v
one = (k -> v -> Map k v) -> (k, v) -> Map k v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> v -> Map k v
forall k a. k -> a -> Map k a
M.singleton
    {-# INLINE one #-}

instance Hashable k => One (HM.HashMap k v) where
    type OneItem (HM.HashMap k v) = (k, v)
    one :: OneItem (HashMap k v) -> HashMap k v
one = (k -> v -> HashMap k v) -> (k, v) -> HashMap k v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry k -> v -> HashMap k v
forall k v. Hashable k => k -> v -> HashMap k v
HM.singleton
    {-# INLINE one #-}

instance One (IM.IntMap v) where
    type OneItem (IM.IntMap v) = (Int, v)
    one :: OneItem (IntMap v) -> IntMap v
one = (Key -> v -> IntMap v) -> (Key, v) -> IntMap v
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Key -> v -> IntMap v
forall a. Key -> a -> IntMap a
IM.singleton
    {-# INLINE one #-}

-- Sets

instance One (Set v) where
    type OneItem (Set v) = v
    one :: OneItem (Set v) -> Set v
one = OneItem (Set v) -> Set v
forall a. a -> Set a
Set.singleton
    {-# INLINE one #-}

instance Hashable v => One (HashSet v) where
    type OneItem (HashSet v) = v
    one :: OneItem (HashSet v) -> HashSet v
one = OneItem (HashSet v) -> HashSet v
forall a. Hashable a => a -> HashSet a
HashSet.singleton
    {-# INLINE one #-}

instance One IntSet where
    type OneItem IntSet = Int
    one :: OneItem IntSet -> IntSet
one = Key -> IntSet
OneItem IntSet -> IntSet
IS.singleton
    {-# INLINE one #-}

-- Vectors

instance One (Vector a) where
    type OneItem (Vector a) = a
    one :: OneItem (Vector a) -> Vector a
one = OneItem (Vector a) -> Vector a
forall a. a -> Vector a
V.singleton
    {-# INLINE one #-}

instance VU.Unbox a => One (VU.Vector a) where
    type OneItem (VU.Vector a) = a
    one :: OneItem (Vector a) -> Vector a
one = OneItem (Vector a) -> Vector a
forall a. Unbox a => a -> Vector a
VU.singleton
    {-# INLINE one #-}

instance VP.Prim a => One (VP.Vector a) where
    type OneItem (VP.Vector a) = a
    one :: OneItem (Vector a) -> Vector a
one = OneItem (Vector a) -> Vector a
forall a. Prim a => a -> Vector a
VP.singleton
    {-# INLINE one #-}

instance VS.Storable a => One (VS.Vector a) where
    type OneItem (VS.Vector a) = a
    one :: OneItem (Vector a) -> Vector a
one = OneItem (Vector a) -> Vector a
forall a. Storable a => a -> Vector a
VS.singleton
    {-# INLINE one #-}

----------------------------------------------------------------------------
-- Utils
----------------------------------------------------------------------------

(#.) :: Coercible b c => (b -> c) -> (a -> b) -> (a -> c)
#. :: (b -> c) -> (a -> b) -> a -> c
(#.) b -> c
_f = (a -> b) -> a -> c
coerce
{-# INLINE (#.) #-}