-- |
-- Module      : Basement.Foldable
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : portable
--
-- A mono-morphic re-thinking of the Foldable class
--

{-# LANGUAGE CPP                   #-}

#if MIN_VERSION_base(4,9,0)
{-# LANGUAGE DataKinds     #-}
{-# LANGUAGE TypeOperators #-}
#endif

#if __GLASGOW_HASKELL__ >= 904
{-# LANGUAGE UndecidableInstances #-}
#endif

module Foundation.Collection.Foldable
    ( Foldable(..)
    , Fold1able(..)
    ) where

import           Basement.Compat.Base
import           Foundation.Collection.Element
import           Basement.NonEmpty
import           Basement.Nat
import qualified Data.List
import qualified Basement.UArray as UV
import qualified Basement.Block as BLK
import qualified Basement.BoxedArray as BA

#if MIN_VERSION_base(4,9,0)
import qualified Basement.Sized.List as LN
import qualified Basement.Sized.Block as BLKN
#endif

-- | Give the ability to fold a collection on itself
class Foldable collection where
    -- | 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.
    --
    -- Note that Foundation only provides `foldl'`, a strict version of `foldl` because
    -- the lazy version is seldom useful.

    -- | Left-associative fold of a structure with strict application of the operator.
    foldl' :: (a -> Element collection -> a) -> a -> collection -> a

    -- | Right-associative fold of a structure.
    --
    -- > foldr f z [x1, x2, ..., xn] == x1 `f` (x2 `f` ... (xn `f` z)...)
    foldr :: (Element collection -> a -> a) -> a -> collection -> a

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

-- | Fold1's. Like folds, but they assume to operate on a NonEmpty collection.
class Foldable f => Fold1able f where
    -- | Left associative strict fold.
    foldl1' :: (Element f -> Element f -> Element f) -> NonEmpty f -> Element f
    -- | Right associative lazy fold.
    foldr1  :: (Element f -> Element f -> Element f) -> NonEmpty f -> Element f
    -- | Right associative strict fold.
    --foldr1' :: (Element f -> Element f -> Element f) -> NonEmpty f -> Element f
    --foldr1' f xs = foldl f' id . getNonEmpty
    --  where f' k x z = k $! f x z


----------------------------
-- Foldable instances
----------------------------

instance Foldable [a] where
    foldr :: (Element [a] -> a -> a) -> a -> [a] -> a
foldr = (Element [a] -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Data.List.foldr
    foldl' :: (a -> Element [a] -> a) -> a -> [a] -> a
foldl' = (a -> Element [a] -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Data.List.foldl'

instance UV.PrimType ty => Foldable (UV.UArray ty) where
    foldr :: (Element (UArray ty) -> a -> a) -> a -> UArray ty -> a
foldr = (Element (UArray ty) -> a -> a) -> a -> UArray ty -> a
forall ty a. PrimType ty => (ty -> a -> a) -> a -> UArray ty -> a
UV.foldr
    foldl' :: (a -> Element (UArray ty) -> a) -> a -> UArray ty -> a
foldl' = (a -> Element (UArray ty) -> a) -> a -> UArray ty -> a
forall ty a. PrimType ty => (a -> ty -> a) -> a -> UArray ty -> a
UV.foldl'
instance Foldable (BA.Array ty) where
    foldr :: (Element (Array ty) -> a -> a) -> a -> Array ty -> a
foldr = (Element (Array ty) -> a -> a) -> a -> Array ty -> a
forall ty a. (ty -> a -> a) -> a -> Array ty -> a
BA.foldr
    foldl' :: (a -> Element (Array ty) -> a) -> a -> Array ty -> a
foldl' = (a -> Element (Array ty) -> a) -> a -> Array ty -> a
forall a ty. (a -> ty -> a) -> a -> Array ty -> a
BA.foldl'
instance UV.PrimType ty => Foldable (BLK.Block ty) where
    foldr :: (Element (Block ty) -> a -> a) -> a -> Block ty -> a
foldr = (Element (Block ty) -> a -> a) -> a -> Block ty -> a
forall ty a. PrimType ty => (ty -> a -> a) -> a -> Block ty -> a
BLK.foldr
    foldl' :: (a -> Element (Block ty) -> a) -> a -> Block ty -> a
foldl' = (a -> Element (Block ty) -> a) -> a -> Block ty -> a
forall ty a. PrimType ty => (a -> ty -> a) -> a -> Block ty -> a
BLK.foldl'

#if MIN_VERSION_base(4,9,0)
instance Foldable (LN.ListN n a) where
    foldr :: (Element (ListN n a) -> a -> a) -> a -> ListN n a -> a
foldr = (Element (ListN n a) -> a -> a) -> a -> ListN n a -> a
forall a b (n :: Nat). (a -> b -> b) -> b -> ListN n a -> b
LN.foldr
    foldl' :: (a -> Element (ListN n a) -> a) -> a -> ListN n a -> a
foldl' = (a -> Element (ListN n a) -> a) -> a -> ListN n a -> a
forall b a (n :: Nat). (b -> a -> b) -> b -> ListN n a -> b
LN.foldl'
instance UV.PrimType ty => Foldable (BLKN.BlockN n ty) where
    foldr :: (Element (BlockN n ty) -> a -> a) -> a -> BlockN n ty -> a
foldr = (Element (BlockN n ty) -> a -> a) -> a -> BlockN n ty -> a
forall ty a (n :: Nat).
PrimType ty =>
(ty -> a -> a) -> a -> BlockN n ty -> a
BLKN.foldr
    foldl' :: (a -> Element (BlockN n ty) -> a) -> a -> BlockN n ty -> a
foldl' = (a -> Element (BlockN n ty) -> a) -> a -> BlockN n ty -> a
forall ty a (n :: Nat).
PrimType ty =>
(a -> ty -> a) -> a -> BlockN n ty -> a
BLKN.foldl'
#endif

----------------------------
-- Fold1able instances
----------------------------

instance Fold1able [a] where
    foldr1 :: (Element [a] -> Element [a] -> Element [a])
-> NonEmpty [a] -> Element [a]
foldr1  Element [a] -> Element [a] -> Element [a]
f = (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Data.List.foldr1  a -> a -> a
Element [a] -> Element [a] -> Element [a]
f ([a] -> a) -> (NonEmpty [a] -> [a]) -> NonEmpty [a] -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty [a] -> [a]
forall a. NonEmpty a -> a
getNonEmpty
    foldl1' :: (Element [a] -> Element [a] -> Element [a])
-> NonEmpty [a] -> Element [a]
foldl1' Element [a] -> Element [a] -> Element [a]
f = (a -> a -> a) -> [a] -> a
forall a. (a -> a -> a) -> [a] -> a
Data.List.foldl1' a -> a -> a
Element [a] -> Element [a] -> Element [a]
f ([a] -> a) -> (NonEmpty [a] -> [a]) -> NonEmpty [a] -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty [a] -> [a]
forall a. NonEmpty a -> a
getNonEmpty

instance UV.PrimType ty => Fold1able (UV.UArray ty) where
    foldr1 :: (Element (UArray ty) -> Element (UArray ty) -> Element (UArray ty))
-> NonEmpty (UArray ty) -> Element (UArray ty)
foldr1 = (Element (UArray ty) -> Element (UArray ty) -> Element (UArray ty))
-> NonEmpty (UArray ty) -> Element (UArray ty)
forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
UV.foldr1
    foldl1' :: (Element (UArray ty) -> Element (UArray ty) -> Element (UArray ty))
-> NonEmpty (UArray ty) -> Element (UArray ty)
foldl1' = (Element (UArray ty) -> Element (UArray ty) -> Element (UArray ty))
-> NonEmpty (UArray ty) -> Element (UArray ty)
forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (UArray ty) -> ty
UV.foldl1'
instance Fold1able (BA.Array ty) where
    foldr1 :: (Element (Array ty) -> Element (Array ty) -> Element (Array ty))
-> NonEmpty (Array ty) -> Element (Array ty)
foldr1  = (Element (Array ty) -> Element (Array ty) -> Element (Array ty))
-> NonEmpty (Array ty) -> Element (Array ty)
forall ty. (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty
BA.foldr1
    foldl1' :: (Element (Array ty) -> Element (Array ty) -> Element (Array ty))
-> NonEmpty (Array ty) -> Element (Array ty)
foldl1' = (Element (Array ty) -> Element (Array ty) -> Element (Array ty))
-> NonEmpty (Array ty) -> Element (Array ty)
forall ty. (ty -> ty -> ty) -> NonEmpty (Array ty) -> ty
BA.foldl1'
instance UV.PrimType ty => Fold1able (BLK.Block ty) where
    foldr1 :: (Element (Block ty) -> Element (Block ty) -> Element (Block ty))
-> NonEmpty (Block ty) -> Element (Block ty)
foldr1  = (Element (Block ty) -> Element (Block ty) -> Element (Block ty))
-> NonEmpty (Block ty) -> Element (Block ty)
forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
BLK.foldr1
    foldl1' :: (Element (Block ty) -> Element (Block ty) -> Element (Block ty))
-> NonEmpty (Block ty) -> Element (Block ty)
foldl1' = (Element (Block ty) -> Element (Block ty) -> Element (Block ty))
-> NonEmpty (Block ty) -> Element (Block ty)
forall ty.
PrimType ty =>
(ty -> ty -> ty) -> NonEmpty (Block ty) -> ty
BLK.foldl1'

#if MIN_VERSION_base(4,9,0)
instance (1 <= n) => Fold1able (LN.ListN n a) where
    foldr1 :: (Element (ListN n a) -> Element (ListN n a) -> Element (ListN n a))
-> NonEmpty (ListN n a) -> Element (ListN n a)
foldr1  Element (ListN n a) -> Element (ListN n a) -> Element (ListN n a)
f = (a -> a -> a) -> ListN n a -> a
forall (n :: Nat) a. (1 <= n) => (a -> a -> a) -> ListN n a -> a
LN.foldr1  a -> a -> a
Element (ListN n a) -> Element (ListN n a) -> Element (ListN n a)
f (ListN n a -> a)
-> (NonEmpty (ListN n a) -> ListN n a) -> NonEmpty (ListN n a) -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty (ListN n a) -> ListN n a
forall a. NonEmpty a -> a
getNonEmpty
    foldl1' :: (Element (ListN n a) -> Element (ListN n a) -> Element (ListN n a))
-> NonEmpty (ListN n a) -> Element (ListN n a)
foldl1' Element (ListN n a) -> Element (ListN n a) -> Element (ListN n a)
f = (a -> a -> a) -> ListN n a -> a
forall (n :: Nat) a. (1 <= n) => (a -> a -> a) -> ListN n a -> a
LN.foldl1' a -> a -> a
Element (ListN n a) -> Element (ListN n a) -> Element (ListN n a)
f (ListN n a -> a)
-> (NonEmpty (ListN n a) -> ListN n a) -> NonEmpty (ListN n a) -> a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. NonEmpty (ListN n a) -> ListN n a
forall a. NonEmpty a -> a
getNonEmpty
#endif