{-# LANGUAGE DataKinds #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Foldable.Square
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  sjoerd@w3future.com
--
-----------------------------------------------------------------------------
module Data.Foldable.Square where

import Data.Square
import Data.Profunctor
import Data.Functor.Compose.List
import qualified Data.Foldable as F
import Control.Applicative

-- |
-- > +--t--+
-- > |  v  |
-- > !m-@-!m
-- > |  ?  |
-- > +--?--+
--
-- `F.foldMap` as a square. Note that because `Forget` ignores its output parameter,
-- this square can have any list of functors as output type.
foldMap :: (Foldable t, Monoid m, IsFList gs) => Square '[Forget m] '[Forget m] '[t] gs
foldMap :: forall (t :: * -> *) m (gs :: [* -> *]).
(Foldable t, Monoid m, IsFList gs) =>
Square '[Forget m] '[Forget m] '[t] gs
foldMap = forall (ps :: [* -> * -> *]) (qs :: [* -> * -> *]) (fs :: [* -> *])
       (gs :: [* -> *]).
(IsPList ps, IsPList qs, IsFList fs, IsFList gs,
 Profunctor (PList qs)) =>
(forall a b.
 PlainP ps a b -> PlainP qs (PlainF fs a) (PlainF gs b))
-> Square ps qs fs gs
mkSquare (forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} r a (b :: k). Forget r a b -> a -> r
runForget)

-- | `Data.Foldable.Square.any` is `Data.Foldable.Square.foldMap` specialized to `Data.Monoid.Any`.
any :: (Foldable t, IsFList gs) => Square '[Forget Bool] '[Forget Bool] '[t] gs
any :: forall (t :: * -> *) (gs :: [* -> *]).
(Foldable t, IsFList gs) =>
Square '[Forget Bool] '[Forget Bool] '[t] gs
any = forall (ps :: [* -> * -> *]) (qs :: [* -> * -> *]) (fs :: [* -> *])
       (gs :: [* -> *]).
(IsPList ps, IsPList qs, IsFList fs, IsFList gs,
 Profunctor (PList qs)) =>
(forall a b.
 PlainP ps a b -> PlainP qs (PlainF fs a) (PlainF gs b))
-> Square ps qs fs gs
mkSquare (forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.any forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} r a (b :: k). Forget r a b -> a -> r
runForget)

-- | `Data.Foldable.Square.all` is `Data.Foldable.Square.foldMap` specialized to `Data.Monoid.All`.
all :: (Foldable t, IsFList gs) => Square '[Forget Bool] '[Forget Bool] '[t] gs
all :: forall (t :: * -> *) (gs :: [* -> *]).
(Foldable t, IsFList gs) =>
Square '[Forget Bool] '[Forget Bool] '[t] gs
all = forall (ps :: [* -> * -> *]) (qs :: [* -> * -> *]) (fs :: [* -> *])
       (gs :: [* -> *]).
(IsPList ps, IsPList qs, IsFList fs, IsFList gs,
 Profunctor (PList qs)) =>
(forall a b.
 PlainP ps a b -> PlainP qs (PlainF fs a) (PlainF gs b))
-> Square ps qs fs gs
mkSquare (forall {k} r a (b :: k). (a -> r) -> Forget r a b
Forget forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
F.all forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} r a (b :: k). Forget r a b -> a -> r
runForget)

-- |
-- > +--t--+
-- > |  v  |
-- > f>-@->f
-- > |     |
-- > +-----+
--
-- `afoldMap` is a mapping version of `F.asum`, or a generalization of `F.concatMap`.
afoldMap :: (Foldable t, Alternative f) => Square '[Star f] '[Star f] '[t] '[]
afoldMap :: forall (t :: * -> *) (f :: * -> *).
(Foldable t, Alternative f) =>
Square '[Star f] '[Star f] '[t] '[]
afoldMap = forall (ps :: [* -> * -> *]) (qs :: [* -> * -> *]) (fs :: [* -> *])
       (gs :: [* -> *]).
(IsPList ps, IsPList qs, IsFList fs, IsFList gs,
 Profunctor (PList qs)) =>
(forall a b.
 PlainP ps a b -> PlainP qs (PlainF fs a) (PlainF gs b))
-> Square ps qs fs gs
mkSquare (forall {k} (f :: k -> *) d (c :: k). (d -> f c) -> Star f d c
Star forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\a -> f b
f -> forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f) forall (f :: * -> *) a. Alternative f => f a
empty) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) d (c :: k). Star f d c -> d -> f c
runStar)