    {-# LANGUAGE CPP
                ,MultiParamTypeClasses
                ,FunctionalDependencies
                ,FlexibleInstances #-}

    {-
    Copyright (C) 2007 John Goerzen <jgoerzen@complete.org>

    All rights reserved.

    For license and copyright information, see the file COPYRIGHT
    -}

    {- |
       Module     : Data.ListLike.FoldableLL
       Copyright  : Copyright (C) 2007 John Goerzen
       License    : BSD3

       Maintainer : David Fox <dsf@seereason.com>, Andreas Abel
       Stability  : stable
       Portability: portable

    Generic tools for data structures that can be folded.

    Written by John Goerzen, jgoerzen\@complete.org

    -}
    module Data.ListLike.FoldableLL
        (-- * FoldableLL Class
         FoldableLL(..),
         -- * Utilities
         fold, foldMap, foldM, sequence_, mapM_
        ) where
    import Prelude hiding (foldl, foldr, foldr1, sequence_, mapM_, foldMap)
    import qualified Data.Foldable as F
    import Data.Maybe
    import qualified Data.List as L

    {- | This is the primary class for structures that are to be considered
    foldable.  A minimum complete definition provides 'foldl' and 'foldr'.

    Instances of 'FoldableLL' can be folded, and can be many and varied.

    These functions are used heavily in "Data.ListLike". -}
    class FoldableLL full item | full -> item where
        {- | Left-associative fold -}
        foldl :: (a -> item -> a) -> a -> full -> a

        {- | Strict version of 'foldl'. -}
        foldl' :: (a -> item -> a) -> a -> full -> a
        -- This implementation from Data.Foldable
        foldl' a -> item -> a
    f a
    a full
    xs = (item -> (a -> a) -> a -> a) -> (a -> a) -> full -> a -> a
    forall b. (item -> b -> b) -> b -> full -> b
    forall full item b.
    FoldableLL full item =>
    (item -> b -> b) -> b -> full -> b
    foldr item -> (a -> a) -> a -> a
    forall {b}. item -> (a -> b) -> a -> b
    f' a -> a
    forall a. a -> a
    id full
    xs a
    a
            where f' :: item -> (a -> b) -> a -> b
    f' item
    x a -> b
    k a
    z = a -> b
    k (a -> b) -> a -> b
    forall a b. (a -> b) -> a -> b
    $! a -> item -> a
    f a
    z item
    x

        -- | A variant of 'foldl' with no base case.  Requires at least 1
        -- list element.
        foldl1 :: (item -> item -> item) -> full -> item
        -- This implementation from Data.Foldable
        foldl1 item -> item -> item
    f full
    xs = item -> Maybe item -> item
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> item
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "fold1: empty structure")
                        ((Maybe item -> item -> Maybe item)
    -> Maybe item -> full -> Maybe item
    forall a. (a -> item -> a) -> a -> full -> a
    forall full item a.
    FoldableLL full item =>
    (a -> item -> a) -> a -> full -> a
    foldl Maybe item -> item -> Maybe item
    mf Maybe item
    forall a. Maybe a
    Nothing full
    xs)
               where mf :: Maybe item -> item -> Maybe item
    mf Maybe item
    Nothing item
    y = item -> Maybe item
    forall a. a -> Maybe a
    Just item
    y
                     mf (Just item
    x) item
    y = item -> Maybe item
    forall a. a -> Maybe a
    Just (item -> item -> item
    f item
    x item
    y)
        {- | Right-associative fold -}
        foldr :: (item -> b -> b) -> b -> full -> b

        -- | Strict version of 'foldr'
        foldr' :: (item -> b -> b) -> b -> full -> b
        -- This implementation from Data.Foldable
        foldr' item -> b -> b
    f b
    a full
    xs = ((b -> b) -> item -> b -> b) -> (b -> b) -> full -> b -> b
    forall a. (a -> item -> a) -> a -> full -> a
    forall full item a.
    FoldableLL full item =>
    (a -> item -> a) -> a -> full -> a
    foldl (b -> b) -> item -> b -> b
    forall {b}. (b -> b) -> item -> b -> b
    f' b -> b
    forall a. a -> a
    id full
    xs b
    a
            where f' :: (b -> b) -> item -> b -> b
    f' b -> b
    k item
    x b
    z = b -> b
    k (b -> b) -> b -> b
    forall a b. (a -> b) -> a -> b
    $! item -> b -> b
    f item
    x b
    z

        -- | Like 'foldr', but with no starting value
        foldr1 :: (item -> item -> item) -> full -> item
        -- This implementation from Data.Foldable
        foldr1 item -> item -> item
    f full
    xs = item -> Maybe item -> item
    forall a. a -> Maybe a -> a
    fromMaybe ([Char] -> item
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "foldr1: empty structure")
                        ((item -> Maybe item -> Maybe item)
    -> Maybe item -> full -> Maybe item
    forall b. (item -> b -> b) -> b -> full -> b
    forall full item b.
    FoldableLL full item =>
    (item -> b -> b) -> b -> full -> b
    foldr item -> Maybe item -> Maybe item
    mf Maybe item
    forall a. Maybe a
    Nothing full
    xs)
               where mf :: item -> Maybe item -> Maybe item
    mf item
    x Maybe item
    Nothing = item -> Maybe item
    forall a. a -> Maybe a
    Just item
    x
                     mf item
    x (Just item
    y) = item -> Maybe item
    forall a. a -> Maybe a
    Just (item -> item -> item
    f item
    x item
    y)

    {- | Combine the elements of a structure using a monoid.
         @'fold' = 'foldMap' id@ -}
    fold :: (FoldableLL full item, Monoid item) => full -> item
    fold :: forall full item.
    (FoldableLL full item, Monoid item) =>
    full -> item
    fold = (item -> item) -> full -> item
    forall full item m.
    (FoldableLL full item, Monoid m) =>
    (item -> m) -> full -> m
    foldMap item -> item
    forall a. a -> a
    id

    {- | Map each element to a monoid, then combine the results -}
    foldMap :: (FoldableLL full item, Monoid m) => (item -> m) -> full -> m
    foldMap :: forall full item m.
    (FoldableLL full item, Monoid m) =>
    (item -> m) -> full -> m
    foldMap item -> m
    f = (item -> m -> m) -> m -> full -> m
    forall b. (item -> b -> b) -> b -> full -> b
    forall full item b.
    FoldableLL full item =>
    (item -> b -> b) -> b -> full -> b
    foldr (m -> m -> m
    forall a. Monoid a => a -> a -> a
    mappend (m -> m -> m) -> (item -> m) -> item -> m -> m
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . item -> m
    f) m
    forall a. Monoid a => a
    mempty

    instance FoldableLL [a] a where
        foldl :: forall a. (a -> a -> a) -> a -> [a] -> a
    foldl = (a -> a -> a) -> a -> [a] -> a
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    L.foldl
        foldl1 :: (a -> a -> a) -> [a] -> a
    foldl1 = (a -> a -> a) -> [a] -> a
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    L.foldl1
        foldl' :: forall a. (a -> a -> a) -> a -> [a] -> a
    foldl' = (a -> a -> a) -> a -> [a] -> a
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    L.foldl'
        foldr :: forall b. (a -> b -> b) -> b -> [a] -> b
    foldr = (a -> b -> b) -> b -> [a] -> b
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    L.foldr
        foldr1 :: (a -> a -> a) -> [a] -> a
    foldr1 = (a -> a -> a) -> [a] -> a
    forall a. (a -> a -> a) -> [a] -> a
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    L.foldr1
        foldr' :: forall b. (a -> b -> b) -> b -> [a] -> b
    foldr' = (a -> b -> b) -> b -> [a] -> b
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    F.foldr'
    {-
    instance (F.Foldable f) => FoldableLL (f a) a where
        foldl = F.foldl
        foldl1 = F.foldl1
        foldl' = F.foldl'
        foldr = F.foldr
        foldr1 = F.foldr1
        foldr' = F.foldr'
    -}

    -- Based on http://stackoverflow.com/a/12881193/1333025
    {- | Monadic version of left fold, similar to 'Control.Monad.foldM'. -}
    foldM :: (Monad m, FoldableLL full item) => (a -> item -> m a) -> a -> full -> m a
    foldM :: forall (m :: * -> *) full item a.
    (Monad m, FoldableLL full item) =>
    (a -> item -> m a) -> a -> full -> m a
    foldM a -> item -> m a
    f a
    z full
    xs = (item -> (a -> m a) -> a -> m a) -> (a -> m a) -> full -> a -> m a
    forall b. (item -> b -> b) -> b -> full -> b
    forall full item b.
    FoldableLL full item =>
    (item -> b -> b) -> b -> full -> b
    foldr (\item
    x a -> m a
    rest a
    a -> a -> item -> m a
    f a
    a item
    x m a -> (a -> m a) -> m a
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= a -> m a
    rest) a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return full
    xs a
    z

    {- | A map in monad space, discarding results. -}
    mapM_ :: (Monad m, FoldableLL full item) => (item -> m b) -> full -> m ()
    mapM_ :: forall (m :: * -> *) full item b.
    (Monad m, FoldableLL full item) =>
    (item -> m b) -> full -> m ()
    mapM_ item -> m b
    func = (item -> m () -> m ()) -> m () -> full -> m ()
    forall b. (item -> b -> b) -> b -> full -> b
    forall full item b.
    FoldableLL full item =>
    (item -> b -> b) -> b -> full -> b
    foldr (m b -> m () -> m ()
    forall a b. m a -> m b -> m b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    (>>) (m b -> m () -> m ()) -> (item -> m b) -> item -> m () -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . item -> m b
    func) (() -> m ()
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    {- | Evaluate each action, ignoring the results.
       Same as @'mapM_' 'id'@. -}
    sequence_ :: (Monad m, FoldableLL full (m item)) => full -> m ()
    sequence_ :: forall (m :: * -> *) full item.
    (Monad m, FoldableLL full (m item)) =>
    full -> m ()
    sequence_ = (m item -> m item) -> full -> m ()
    forall (m :: * -> *) full item b.
    (Monad m, FoldableLL full item) =>
    (item -> m b) -> full -> m ()
    mapM_ m item -> m item
    forall a. a -> a
    id