{-# 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 : John Lato <jwlato@gmail.com>
   Stability  : provisional
   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 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 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 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 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 :: 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 :: (item -> m) -> full -> m
foldMap item -> m
f = (item -> m -> m) -> m -> full -> m
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 :: (a -> a -> a) -> a -> [a] -> a
foldl = (a -> a -> a) -> a -> [a] -> a
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 (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
L.foldl1
    foldl' :: (a -> a -> a) -> a -> [a] -> a
foldl' = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
L.foldl'
    foldr :: (a -> b -> b) -> b -> [a] -> b
foldr = (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 (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
L.foldr1
    foldr' :: (a -> b -> b) -> b -> [a] -> b
foldr' = (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 :: (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 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 (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m a
rest) 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_ :: (item -> m b) -> full -> m ()
mapM_ item -> m b
func = (item -> m () -> m ()) -> m () -> full -> m ()
forall full item b.
FoldableLL full item =>
(item -> b -> b) -> b -> full -> b
foldr (m b -> m () -> m ()
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 (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_ :: 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