{-# LANGUAGE TupleSections, MultiParamTypeClasses #-}
module SimpleH.Foldable where

import SimpleH.Core
import SimpleH.Classes
import SimpleH.Functor
import Data.Tree

class Functor t => Foldable t where
  fold :: Monoid m => t m -> m
instance Foldable Id where fold = getId
instance Foldable (Either a) where
  fold = pure zero <|> id
instance Foldable Maybe where
  fold (Just w) = w ; fold Nothing = zero
instance Foldable ((,) a) where fold = snd
instance Foldable [] where
  fold [] = zero
  fold (x:t) = x+fold t
instance Foldable Tree where fold (Node m subs) = m + fold (map fold subs)
deriving instance Foldable Interleave
deriving instance Foldable OrdList
instance (Foldable f,Foldable g) => Foldable (Compose f g) where
  fold = getCompose >>> map fold >>> fold

newtype Sized f a = Sized { getSized :: f a }
instance (Foldable f,Semigroup (Sized f a),Monoid n,Num n) =>
         SubSemi n (Sized f a) where
  cast = size . getSized

foldMap f = fold . map f
convert = foldMap pure
concat = fold
sum = fold
size :: (Foldable f,Num n,Monoid n) => f a -> n
size c = sum (1<$c)
count = size
length :: (Num n,Monoid n) => [a] -> n
length = count

split :: (Foldable t,Monoid b,Monoid c) => t (b:+:c) -> (b,c)
split = foldMap ((,zero)<|>(zero,))
partitionEithers :: (Foldable t,Unit t,Monoid (t a),Monoid (t b))
                    => t (a:+:b) -> (t a,t b)
partitionEithers = split . map (pure|||pure)
partition p = split . map (\a -> (if p a then Left else Right) (pure a))
filter p = fst . partition p
select = filter
refuse = filter . map not

compose = runEndo . foldMap Endo

foldr :: Foldable t => (b -> a -> a) -> a -> t b -> a
foldr f e t = (runEndo . getDual) (foldMap (\b -> Dual (Endo (f b))) t) e
foldl' f e t = runEndo (foldMap (\b -> Endo (\a -> a`seq`f a b)) t) e

find :: Foldable t => (a -> Bool) -> t a -> Maybe a
find p = foldMap (filter p . Id)
or :: Foldable t => t Bool -> Bool
or = fold
and :: Foldable t => t Bool -> Bool
and = getProduct . fold . map Product
all = map and . map
any = map or . map
elem e = any (e==)