{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
{-|
Module      : Control.MapReduce.Core
Description : a map-reduce wrapper around foldl 
Copyright   : (c) Adam Conner-Sax 2019
License     : BSD-3-Clause
Maintainer  : adam_conner_sax@yahoo.com
Stability   : experimental


MapReduce as folds
This is all just wrapping around Control.Foldl so that it's easier to see the map-reduce structure
The Mapping step is broken into 2 parts:

1. unpacking, which could include "melting" or filtering,

2. assigning, which assigns a group to each unpacked item.  Could just be choosing a key column(s)

The items are then grouped by key and "reduced"

The reduce step is conceptually simpler, just requiring a function from the (key, grouped data) pair to the result.

Reduce could be as simple as combining the key with a single data row or some very complex function of the grouped data.
E.g., reduce could itself be a map-reduce on the grouped data.
Since these are folds, we can share work by using the Applicative instance of MapStep (just the Applicative instance of Control.Foldl.Fold)
and we will loop over the data only once.
The Reduce type is also Applicative so there could be work sharing there as well, especially if you
specify your reduce as a Fold.
e.g., if your @reduce :: (k -> h c -> d)@ has the form @reduce :: k -> FL.Fold c d@

We combine these steps with an "Engine", resulting in a fold from a container of @x@ to some container of @d@.
The Engine amounts to a choice of grouping algorithm (usually using @Data.Map@ or @Data.HashMap@) and a choice of result container type.
The result container type is used for the intermediate steps as well.

The goal is to make assembling a large family of common map/reduce patterns in a straightforward way.  At some level of complication, you may as
well write them by hand.  An in-between case would be writing the unpack function as a complex hand written filter
-}
module Control.MapReduce.Core
  (
    -- * Basic Types for map reduce
    -- ** Non-Monadic
    Unpack(..)
  , Assign(..)
  , Reduce(..)

  -- ** Monadic
  , UnpackM(..)
  , AssignM(..)
  , ReduceM(..)

  -- ** Non-Monadic -> Monadic
  , generalizeUnpack
  , generalizeAssign
  , generalizeReduce

  -- * Foldl helpers  
  , functionToFold
  , functionToFoldM
  , postMapM

  -- * Re-Exports
  , Fold
  , FoldM
  , fold
  , foldM
  )
where

import qualified Control.Foldl                 as FL
import           Control.Foldl                  ( Fold
                                                , FoldM
                                                , fold
                                                , foldM
                                                ) -- for re-exporting

import qualified Data.Profunctor               as P
import           Data.Profunctor                ( Profunctor )
import qualified Data.Sequence                 as S
import           Control.Arrow                  ( second )

-- | @Unpack@ is for filtering rows or "melting" them, that is doing something which turns each @x@ into several @y@.
-- Filter is a special case because it can often be done faster directly than via folding over @Maybe@
data Unpack x y where
  Filter :: (x -> Bool) -> Unpack x x -- we single out this special case because it's faster to do directly
  Unpack :: Traversable g => (x -> g y) -> Unpack x y -- we only need (Functor g, Foldable g) but if we want to generalize we need Traversable

-- helpers for turning filter functions into @a -> Maybe a@
boolToMaybe :: Bool -> a -> Maybe a
boolToMaybe :: Bool -> a -> Maybe a
boolToMaybe Bool
b a
x = if Bool
b then a -> Maybe a
forall a. a -> Maybe a
Just a
x else Maybe a
forall a. Maybe a
Nothing

ifToMaybe :: (x -> Bool) -> x -> Maybe x
ifToMaybe :: (x -> Bool) -> x -> Maybe x
ifToMaybe x -> Bool
t x
x = Bool -> x -> Maybe x
forall a. Bool -> a -> Maybe a
boolToMaybe (x -> Bool
t x
x) x
x

instance Functor (Unpack x) where
  fmap :: (a -> b) -> Unpack x a -> Unpack x b
fmap a -> b
h (Filter x -> Bool
t) = (x -> Maybe b) -> Unpack x b
forall (g :: * -> *) x y. Traversable g => (x -> g y) -> Unpack x y
Unpack ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h (Maybe a -> Maybe b) -> (x -> Maybe a) -> x -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> Bool) -> x -> Maybe x
forall x. (x -> Bool) -> x -> Maybe x
ifToMaybe x -> Bool
t)
  fmap a -> b
h (Unpack x -> g a
f) = (x -> g b) -> Unpack x b
forall (g :: * -> *) x y. Traversable g => (x -> g y) -> Unpack x y
Unpack ((a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h (g a -> g b) -> (x -> g a) -> x -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> g a
f)
  {-# INLINABLE fmap #-}

instance P.Profunctor Unpack where
  dimap :: (a -> b) -> (c -> d) -> Unpack b c -> Unpack a d
dimap a -> b
l c -> d
r (Filter b -> Bool
t) = (a -> Maybe d) -> Unpack a d
forall (g :: * -> *) x y. Traversable g => (x -> g y) -> Unpack x y
Unpack ( (c -> d) -> Maybe c -> Maybe d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
r (Maybe c -> Maybe d) -> (a -> Maybe c) -> a -> Maybe d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Bool) -> b -> Maybe b
forall x. (x -> Bool) -> x -> Maybe x
ifToMaybe b -> Bool
t (b -> Maybe b) -> (a -> b) -> a -> Maybe b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
l)
  dimap a -> b
l c -> d
r (Unpack b -> g c
f) = (a -> g d) -> Unpack a d
forall (g :: * -> *) x y. Traversable g => (x -> g y) -> Unpack x y
Unpack ( (c -> d) -> g c -> g d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
r (g c -> g d) -> (a -> g c) -> a -> g d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> g c
f (b -> g c) -> (a -> b) -> a -> g c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
l)
  {-# INLINABLE dimap #-}

-- | @UnpackM@ is for filtering or melting the input type. This version has a monadic result type to
-- accomodate unpacking that might require randomness or logging during unpacking.
-- filter is a special case since filtering can be often be done faster.  So we single it out. 
data UnpackM m x y where
  FilterM :: Monad m => (x -> m Bool) -> UnpackM m x x
  UnpackM :: (Monad m, Traversable g) => (x -> m (g y)) -> UnpackM m x y

ifToMaybeM :: Monad m => (x -> m Bool) -> x -> m (Maybe x)
ifToMaybeM :: (x -> m Bool) -> x -> m (Maybe x)
ifToMaybeM x -> m Bool
t x
x = (Bool -> Maybe x) -> m Bool -> m (Maybe x)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> x -> Maybe x
forall a. Bool -> a -> Maybe a
`boolToMaybe` x
x) (x -> m Bool
t x
x)

instance Functor (UnpackM m x) where
  fmap :: (a -> b) -> UnpackM m x a -> UnpackM m x b
fmap a -> b
h (FilterM x -> m Bool
t) = (x -> m (Maybe b)) -> UnpackM m x b
forall (m :: * -> *) (g :: * -> *) x y.
(Monad m, Traversable g) =>
(x -> m (g y)) -> UnpackM m x y
UnpackM ((Maybe a -> Maybe b) -> m (Maybe a) -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h) (m (Maybe a) -> m (Maybe b))
-> (x -> m (Maybe a)) -> x -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (x -> m Bool) -> x -> m (Maybe x)
forall (m :: * -> *) x.
Monad m =>
(x -> m Bool) -> x -> m (Maybe x)
ifToMaybeM x -> m Bool
t)
  fmap a -> b
h (UnpackM x -> m (g a)
f) = (x -> m (g b)) -> UnpackM m x b
forall (m :: * -> *) (g :: * -> *) x y.
(Monad m, Traversable g) =>
(x -> m (g y)) -> UnpackM m x y
UnpackM ((g a -> g b) -> m (g a) -> m (g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h) (m (g a) -> m (g b)) -> (x -> m (g a)) -> x -> m (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> m (g a)
f)
  {-# INLINABLE fmap #-}

instance Profunctor (UnpackM m) where
  dimap :: (a -> b) -> (c -> d) -> UnpackM m b c -> UnpackM m a d
dimap a -> b
l c -> d
r (FilterM b -> m Bool
t) = (a -> m (Maybe d)) -> UnpackM m a d
forall (m :: * -> *) (g :: * -> *) x y.
(Monad m, Traversable g) =>
(x -> m (g y)) -> UnpackM m x y
UnpackM ( (Maybe c -> Maybe d) -> m (Maybe c) -> m (Maybe d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> d) -> Maybe c -> Maybe d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
r) (m (Maybe c) -> m (Maybe d))
-> (a -> m (Maybe c)) -> a -> m (Maybe d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> m Bool) -> b -> m (Maybe b)
forall (m :: * -> *) x.
Monad m =>
(x -> m Bool) -> x -> m (Maybe x)
ifToMaybeM b -> m Bool
t (b -> m (Maybe b)) -> (a -> b) -> a -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
l)
  dimap a -> b
l c -> d
r (UnpackM b -> m (g c)
f) = (a -> m (g d)) -> UnpackM m a d
forall (m :: * -> *) (g :: * -> *) x y.
(Monad m, Traversable g) =>
(x -> m (g y)) -> UnpackM m x y
UnpackM ( (g c -> g d) -> m (g c) -> m (g d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> d) -> g c -> g d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
r) (m (g c) -> m (g d)) -> (a -> m (g c)) -> a -> m (g d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m (g c)
f (b -> m (g c)) -> (a -> b) -> a -> m (g c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
l)
  {-# INLINABLE dimap #-}

-- | lift a non-monadic Unpack to a monadic one for any monad m
generalizeUnpack :: Monad m => Unpack x y -> UnpackM m x y
generalizeUnpack :: Unpack x y -> UnpackM m x y
generalizeUnpack (Filter x -> Bool
t) = (x -> m Bool) -> UnpackM m x x
forall (m :: * -> *) x. Monad m => (x -> m Bool) -> UnpackM m x x
FilterM ((x -> m Bool) -> UnpackM m x x) -> (x -> m Bool) -> UnpackM m x x
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> (x -> Bool) -> x -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> Bool
t
generalizeUnpack (Unpack x -> g y
f) = (x -> m (g y)) -> UnpackM m x y
forall (m :: * -> *) (g :: * -> *) x y.
(Monad m, Traversable g) =>
(x -> m (g y)) -> UnpackM m x y
UnpackM ((x -> m (g y)) -> UnpackM m x y)
-> (x -> m (g y)) -> UnpackM m x y
forall a b. (a -> b) -> a -> b
$ g y -> m (g y)
forall (m :: * -> *) a. Monad m => a -> m a
return (g y -> m (g y)) -> (x -> g y) -> x -> m (g y)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. x -> g y
f
{-# INLINABLE generalizeUnpack #-}

-- | map @y@ into a @(k,c)@ pair for grouping 
data Assign k y c where
  Assign :: (y -> (k, c)) -> Assign k y c

instance Functor (Assign k y) where
  fmap :: (a -> b) -> Assign k y a -> Assign k y b
fmap a -> b
f (Assign y -> (k, a)
h) = (y -> (k, b)) -> Assign k y b
forall y k c. (y -> (k, c)) -> Assign k y c
Assign ((y -> (k, b)) -> Assign k y b) -> (y -> (k, b)) -> Assign k y b
forall a b. (a -> b) -> a -> b
$ (a -> b) -> (k, a) -> (k, b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second a -> b
f ((k, a) -> (k, b)) -> (y -> (k, a)) -> y -> (k, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. y -> (k, a)
h --(\y -> let (k,c) = g y in (k, f c))
  {-# INLINABLE fmap #-}

instance Profunctor (Assign k) where
  dimap :: (a -> b) -> (c -> d) -> Assign k b c -> Assign k a d
dimap a -> b
l c -> d
r (Assign b -> (k, c)
h) = (a -> (k, d)) -> Assign k a d
forall y k c. (y -> (k, c)) -> Assign k y c
Assign ((a -> (k, d)) -> Assign k a d) -> (a -> (k, d)) -> Assign k a d
forall a b. (a -> b) -> a -> b
$ (c -> d) -> (k, c) -> (k, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second c -> d
r ((k, c) -> (k, d)) -> (a -> (k, c)) -> a -> (k, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> (k, c)
h (b -> (k, c)) -> (a -> b) -> a -> (k, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
l --(\z -> let (k,c) = g (l z) in (k, r c))
  {-# INLINABLE dimap #-}

-- | Effectfully map @y@ into a @(k,c)@ pair for grouping 
data AssignM m k y c where
  AssignM :: Monad m => (y -> m (k, c)) -> AssignM m k y c

instance Functor (AssignM m k y) where
  fmap :: (a -> b) -> AssignM m k y a -> AssignM m k y b
fmap a -> b
f (AssignM y -> m (k, a)
h) = (y -> m (k, b)) -> AssignM m k y b
forall (m :: * -> *) y k c.
Monad m =>
(y -> m (k, c)) -> AssignM m k y c
AssignM ((y -> m (k, b)) -> AssignM m k y b)
-> (y -> m (k, b)) -> AssignM m k y b
forall a b. (a -> b) -> a -> b
$ ((k, a) -> (k, b)) -> m (k, a) -> m (k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (k, a) -> (k, b)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second a -> b
f) (m (k, a) -> m (k, b)) -> (y -> m (k, a)) -> y -> m (k, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. y -> m (k, a)
h
  {-# INLINABLE fmap #-}

instance Profunctor (AssignM m k) where
  dimap :: (a -> b) -> (c -> d) -> AssignM m k b c -> AssignM m k a d
dimap a -> b
l c -> d
r (AssignM b -> m (k, c)
h) = (a -> m (k, d)) -> AssignM m k a d
forall (m :: * -> *) y k c.
Monad m =>
(y -> m (k, c)) -> AssignM m k y c
AssignM ((a -> m (k, d)) -> AssignM m k a d)
-> (a -> m (k, d)) -> AssignM m k a d
forall a b. (a -> b) -> a -> b
$ ((k, c) -> (k, d)) -> m (k, c) -> m (k, d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((c -> d) -> (k, c) -> (k, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second c -> d
r) (m (k, c) -> m (k, d)) -> (a -> m (k, c)) -> a -> m (k, d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> m (k, c)
h (b -> m (k, c)) -> (a -> b) -> a -> m (k, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
l
  {-# INLINABLE dimap #-}


-- | lift a non-monadic Assign to a monadic one for any monad m
generalizeAssign :: Monad m => Assign k y c -> AssignM m k y c
generalizeAssign :: Assign k y c -> AssignM m k y c
generalizeAssign (Assign y -> (k, c)
h) = (y -> m (k, c)) -> AssignM m k y c
forall (m :: * -> *) y k c.
Monad m =>
(y -> m (k, c)) -> AssignM m k y c
AssignM ((y -> m (k, c)) -> AssignM m k y c)
-> (y -> m (k, c)) -> AssignM m k y c
forall a b. (a -> b) -> a -> b
$ (k, c) -> m (k, c)
forall (m :: * -> *) a. Monad m => a -> m a
return ((k, c) -> m (k, c)) -> (y -> (k, c)) -> y -> m (k, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. y -> (k, c)
h
{-# INLINABLE generalizeAssign #-}

-- | Wrapper for functions to reduce keyed and grouped data to the result type.
-- It is *strongly* suggested that you use Folds for this step.  Type-inference and
-- applicative optimization are more straightforward that way.  The non-Fold contructors are
-- there in order to retro-fit existing functions.

-- | Reduce step for non-effectful reductions
data Reduce k x d where
  Reduce :: (k -> (forall h. (Foldable h, Functor h) => (h x -> d))) -> Reduce k x d
  ReduceFold :: (k -> FL.Fold x d) -> Reduce k x d

-- | Reduce step for effectful reductions.
-- It is *strongly* suggested that you use Folds for this step.  Type-inference and
-- applicative optimization are more straightforward that way.  The non-Fold contructors are
-- there in order to retro-fit existing functions.
data ReduceM m k x d where
  ReduceM :: Monad m => (k -> (forall h. (Foldable h, Functor h) => (h x -> m d))) -> ReduceM m k x d
  ReduceFoldM :: Monad m => (k -> FL.FoldM m x d) -> ReduceM m k x d

instance Functor (Reduce k x) where
  fmap :: (a -> b) -> Reduce k x a -> Reduce k x b
fmap a -> b
f (Reduce k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> a
g) = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
-> Reduce k x b
forall k x d.
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> d)
-> Reduce k x d
Reduce ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
 -> Reduce k x b)
-> (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
-> Reduce k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> a -> b
f (a -> b) -> (h x -> a) -> h x -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> a
g k
k
  fmap a -> b
f (ReduceFold k -> Fold x a
g) = (k -> Fold x b) -> Reduce k x b
forall k x d. (k -> Fold x d) -> Reduce k x d
ReduceFold ((k -> Fold x b) -> Reduce k x b)
-> (k -> Fold x b) -> Reduce k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> (a -> b) -> Fold x a -> Fold x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (k -> Fold x a
g k
k)
  {-# INLINABLE fmap #-}

instance Functor (ReduceM m k x) where
  fmap :: (a -> b) -> ReduceM m k x a -> ReduceM m k x b
fmap a -> b
f (ReduceM k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m a
g) = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
-> ReduceM m k x b
forall (m :: * -> *) k x d.
Monad m =>
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m d)
-> ReduceM m k x d
ReduceM ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
 -> ReduceM m k x b)
-> (k
    -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
-> ReduceM m k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> (h x -> m a) -> h x -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m a
g k
k
  fmap a -> b
f (ReduceFoldM k -> FoldM m x a
g) = (k -> FoldM m x b) -> ReduceM m k x b
forall (m :: * -> *) k x d.
Monad m =>
(k -> FoldM m x d) -> ReduceM m k x d
ReduceFoldM ((k -> FoldM m x b) -> ReduceM m k x b)
-> (k -> FoldM m x b) -> ReduceM m k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> (a -> b) -> FoldM m x a -> FoldM m x b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (k -> FoldM m x a
g k
k)
  {-# INLINABLE fmap #-}

instance Profunctor (Reduce k) where
  dimap :: (a -> b) -> (c -> d) -> Reduce k b c -> Reduce k a d
dimap a -> b
l c -> d
r (Reduce k -> forall (h :: * -> *). (Foldable h, Functor h) => h b -> c
g)  = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h a -> d)
-> Reduce k a d
forall k x d.
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> d)
-> Reduce k x d
Reduce ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h a -> d)
 -> Reduce k a d)
-> (k -> forall (h :: * -> *). (Foldable h, Functor h) => h a -> d)
-> Reduce k a d
forall a b. (a -> b) -> a -> b
$ \k
k -> (h a -> h b) -> (c -> d) -> (h b -> c) -> h a -> d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap ((a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
l) c -> d
r (k -> forall (h :: * -> *). (Foldable h, Functor h) => h b -> c
g k
k)
  dimap a -> b
l c -> d
r (ReduceFold k -> Fold b c
g) = (k -> Fold a d) -> Reduce k a d
forall k x d. (k -> Fold x d) -> Reduce k x d
ReduceFold ((k -> Fold a d) -> Reduce k a d)
-> (k -> Fold a d) -> Reduce k a d
forall a b. (a -> b) -> a -> b
$ \k
k -> (a -> b) -> (c -> d) -> Fold b c -> Fold a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap a -> b
l c -> d
r (k -> Fold b c
g k
k)
  {-# INLINABLE dimap #-}

instance Profunctor (ReduceM m k) where
  dimap :: (a -> b) -> (c -> d) -> ReduceM m k b c -> ReduceM m k a d
dimap a -> b
l c -> d
r (ReduceM k -> forall (h :: * -> *). (Foldable h, Functor h) => h b -> m c
g)  = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h a -> m d)
-> ReduceM m k a d
forall (m :: * -> *) k x d.
Monad m =>
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m d)
-> ReduceM m k x d
ReduceM ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h a -> m d)
 -> ReduceM m k a d)
-> (k
    -> forall (h :: * -> *). (Foldable h, Functor h) => h a -> m d)
-> ReduceM m k a d
forall a b. (a -> b) -> a -> b
$ \k
k -> (h a -> h b) -> (m c -> m d) -> (h b -> m c) -> h a -> m d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap ((a -> b) -> h a -> h b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
l) ((c -> d) -> m c -> m d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
r) (k -> forall (h :: * -> *). (Foldable h, Functor h) => h b -> m c
g k
k)
  dimap a -> b
l c -> d
r (ReduceFoldM k -> FoldM m b c
g) = (k -> FoldM m a d) -> ReduceM m k a d
forall (m :: * -> *) k x d.
Monad m =>
(k -> FoldM m x d) -> ReduceM m k x d
ReduceFoldM ((k -> FoldM m a d) -> ReduceM m k a d)
-> (k -> FoldM m a d) -> ReduceM m k a d
forall a b. (a -> b) -> a -> b
$ \k
k -> (a -> b) -> (c -> d) -> FoldM m b c -> FoldM m a d
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap a -> b
l c -> d
r (k -> FoldM m b c
g k
k)
  {-# INLINABLE dimap #-}

instance Applicative (Reduce k x) where
  pure :: a -> Reduce k x a
pure a
x = (k -> Fold x a) -> Reduce k x a
forall k x d. (k -> Fold x d) -> Reduce k x d
ReduceFold ((k -> Fold x a) -> Reduce k x a)
-> (k -> Fold x a) -> Reduce k x a
forall a b. (a -> b) -> a -> b
$ Fold x a -> k -> Fold x a
forall a b. a -> b -> a
const (a -> Fold x a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  {-# INLINABLE pure #-}
  Reduce k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> a -> b
r1 <*> :: Reduce k x (a -> b) -> Reduce k x a -> Reduce k x b
<*> Reduce k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> a
r2 = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
-> Reduce k x b
forall k x d.
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> d)
-> Reduce k x d
Reduce ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
 -> Reduce k x b)
-> (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
-> Reduce k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> a -> b
r1 k
k (h x -> a -> b) -> (h x -> a) -> h x -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> a
r2 k
k
  ReduceFold k -> Fold x (a -> b)
f1 <*> ReduceFold k -> Fold x a
f2 = (k -> Fold x b) -> Reduce k x b
forall k x d. (k -> Fold x d) -> Reduce k x d
ReduceFold ((k -> Fold x b) -> Reduce k x b)
-> (k -> Fold x b) -> Reduce k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> k -> Fold x (a -> b)
f1 k
k Fold x (a -> b) -> Fold x a -> Fold x b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> k -> Fold x a
f2 k
k
  Reduce k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> a -> b
r1 <*> ReduceFold k -> Fold x a
f2 = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
-> Reduce k x b
forall k x d.
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> d)
-> Reduce k x d
Reduce ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
 -> Reduce k x b)
-> (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
-> Reduce k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> a -> b
r1 k
k (h x -> a -> b) -> (h x -> a) -> h x -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Fold x a -> h x -> a
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
FL.fold (k -> Fold x a
f2 k
k)
  ReduceFold k -> Fold x (a -> b)
f1 <*> Reduce k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> a
r2 = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
-> Reduce k x b
forall k x d.
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> d)
-> Reduce k x d
Reduce ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
 -> Reduce k x b)
-> (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> b)
-> Reduce k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> Fold x (a -> b) -> h x -> a -> b
forall (f :: * -> *) a b. Foldable f => Fold a b -> f a -> b
FL.fold (k -> Fold x (a -> b)
f1 k
k) (h x -> a -> b) -> (h x -> a) -> h x -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> a
r2 k
k
  {-# INLINABLE (<*>) #-}

instance Monad m => Applicative (ReduceM m k x) where
  pure :: a -> ReduceM m k x a
pure a
x = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m a)
-> ReduceM m k x a
forall (m :: * -> *) k x d.
Monad m =>
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m d)
-> ReduceM m k x d
ReduceM ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m a)
 -> ReduceM m k x a)
-> (k
    -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m a)
-> ReduceM m k x a
forall a b. (a -> b) -> a -> b
$ \k
_ -> m a -> h x -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (m a -> h x -> m a) -> m a -> h x -> m a
forall a b. (a -> b) -> a -> b
$ a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  {-# INLINABLE pure #-}
  ReduceM k
-> forall (h :: * -> *).
   (Foldable h, Functor h) =>
   h x -> m (a -> b)
r1 <*> :: ReduceM m k x (a -> b) -> ReduceM m k x a -> ReduceM m k x b
<*> ReduceM k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m a
r2 = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
-> ReduceM m k x b
forall (m :: * -> *) k x d.
Monad m =>
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m d)
-> ReduceM m k x d
ReduceM ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
 -> ReduceM m k x b)
-> (k
    -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
-> ReduceM m k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (m (a -> b) -> m a -> m b)
-> (h x -> m (a -> b)) -> h x -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k
-> forall (h :: * -> *).
   (Foldable h, Functor h) =>
   h x -> m (a -> b)
r1 k
k (h x -> m a -> m b) -> (h x -> m a) -> h x -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m a
r2 k
k
  ReduceFoldM k -> FoldM m x (a -> b)
f1 <*> ReduceFoldM k -> FoldM m x a
f2 = (k -> FoldM m x b) -> ReduceM m k x b
forall (m :: * -> *) k x d.
Monad m =>
(k -> FoldM m x d) -> ReduceM m k x d
ReduceFoldM ((k -> FoldM m x b) -> ReduceM m k x b)
-> (k -> FoldM m x b) -> ReduceM m k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> k -> FoldM m x (a -> b)
f1 k
k FoldM m x (a -> b) -> FoldM m x a -> FoldM m x b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> k -> FoldM m x a
f2 k
k
  ReduceM k
-> forall (h :: * -> *).
   (Foldable h, Functor h) =>
   h x -> m (a -> b)
r1 <*> ReduceFoldM k -> FoldM m x a
f2 = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
-> ReduceM m k x b
forall (m :: * -> *) k x d.
Monad m =>
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m d)
-> ReduceM m k x d
ReduceM ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
 -> ReduceM m k x b)
-> (k
    -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
-> ReduceM m k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (m (a -> b) -> m a -> m b)
-> (h x -> m (a -> b)) -> h x -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> k
-> forall (h :: * -> *).
   (Foldable h, Functor h) =>
   h x -> m (a -> b)
r1 k
k (h x -> m a -> m b) -> (h x -> m a) -> h x -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FoldM m x a -> h x -> m a
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
FoldM m a b -> f a -> m b
FL.foldM (k -> FoldM m x a
f2 k
k)
  ReduceFoldM k -> FoldM m x (a -> b)
f1 <*> ReduceM k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m a
r2 = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
-> ReduceM m k x b
forall (m :: * -> *) k x d.
Monad m =>
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m d)
-> ReduceM m k x d
ReduceM ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
 -> ReduceM m k x b)
-> (k
    -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m b)
-> ReduceM m k x b
forall a b. (a -> b) -> a -> b
$ \k
k -> m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) (m (a -> b) -> m a -> m b)
-> (h x -> m (a -> b)) -> h x -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FoldM m x (a -> b) -> h x -> m (a -> b)
forall (f :: * -> *) (m :: * -> *) a b.
(Foldable f, Monad m) =>
FoldM m a b -> f a -> m b
FL.foldM (k -> FoldM m x (a -> b)
f1 k
k) (h x -> m a -> m b) -> (h x -> m a) -> h x -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m a
r2 k
k
  {-# INLINABLE (<*>) #-}

-- | Make a non-monadic reduce monadic. 
generalizeReduce :: Monad m => Reduce k x d -> ReduceM m k x d
generalizeReduce :: Reduce k x d -> ReduceM m k x d
generalizeReduce (Reduce     k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> d
f) = (k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m d)
-> ReduceM m k x d
forall (m :: * -> *) k x d.
Monad m =>
(k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m d)
-> ReduceM m k x d
ReduceM ((k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m d)
 -> ReduceM m k x d)
-> (k
    -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> m d)
-> ReduceM m k x d
forall a b. (a -> b) -> a -> b
$ \k
k -> d -> m d
forall (m :: * -> *) a. Monad m => a -> m a
return (d -> m d) -> (h x -> d) -> h x -> m d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. k -> forall (h :: * -> *). (Foldable h, Functor h) => h x -> d
f k
k
generalizeReduce (ReduceFold k -> Fold x d
f) = (k -> FoldM m x d) -> ReduceM m k x d
forall (m :: * -> *) k x d.
Monad m =>
(k -> FoldM m x d) -> ReduceM m k x d
ReduceFoldM ((k -> FoldM m x d) -> ReduceM m k x d)
-> (k -> FoldM m x d) -> ReduceM m k x d
forall a b. (a -> b) -> a -> b
$ \k
k -> Fold x d -> FoldM m x d
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
FL.generalize (k -> Fold x d
f k
k)
{-# INLINABLE generalizeReduce #-}

-- TODO: submit a PR to foldl for this
-- | Given an effectful (monadic) Control.Foldl fold, a @FoldM m x a@, we can use its @Functor@ instance
-- to apply a non-effectful @(a -> b)@ to its result type.  To apply @(a -> m b)@, we need this combinator.
postMapM :: Monad m => (a -> m b) -> FL.FoldM m x a -> FL.FoldM m x b
postMapM :: (a -> m b) -> FoldM m x a -> FoldM m x b
postMapM a -> m b
f (FL.FoldM x -> x -> m x
step m x
begin x -> m a
done) = (x -> x -> m x) -> m x -> (x -> m b) -> FoldM m x b
forall (m :: * -> *) a b x.
(x -> a -> m x) -> m x -> (x -> m b) -> FoldM m a b
FL.FoldM x -> x -> m x
step m x
begin x -> m b
done'
  where done' :: x -> m b
done' x
x = x -> m a
done x
x m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> m b
f
{-# INLINABLE postMapM #-}

seqF :: FL.Fold a (S.Seq a)
seqF :: Fold a (Seq a)
seqF = (Seq a -> a -> Seq a)
-> Seq a -> (Seq a -> Seq a) -> Fold a (Seq a)
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
FL.Fold Seq a -> a -> Seq a
forall a. Seq a -> a -> Seq a
(S.|>) Seq a
forall a. Seq a
S.empty Seq a -> Seq a
forall a. a -> a
id

-- | convert a function which takes a foldable container of x and produces an a into a Fold x a.
-- uses Data.Sequence.Seq as an intermediate type because it should behave well whether
-- f is a left or right fold. 
-- This can be helpful in putting an existing function into a Reduce.
functionToFold :: (forall h . Foldable h => h x -> a) -> FL.Fold x a
functionToFold :: (forall (h :: * -> *). Foldable h => h x -> a) -> Fold x a
functionToFold forall (h :: * -> *). Foldable h => h x -> a
f = (Seq x -> a) -> Fold x (Seq x) -> Fold x a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Seq x -> a
forall (h :: * -> *). Foldable h => h x -> a
f Fold x (Seq x)
forall a. Fold a (Seq a)
seqF

-- | convert a function which takes a foldable container of x and produces an (m a) into a FoldM m x a.
-- uses Data.Sequence.Seq as an intermediate type because it should behave well whether
-- f is a left or right fold.
-- This can be helpful in putting an existing function into a ReduceM.
functionToFoldM
  :: Monad m => (forall h . Foldable h => h x -> m a) -> FL.FoldM m x a
functionToFoldM :: (forall (h :: * -> *). Foldable h => h x -> m a) -> FoldM m x a
functionToFoldM forall (h :: * -> *). Foldable h => h x -> m a
f = (Seq x -> m a) -> FoldM m x (Seq x) -> FoldM m x a
forall (m :: * -> *) a b x.
Monad m =>
(a -> m b) -> FoldM m x a -> FoldM m x b
postMapM Seq x -> m a
forall (h :: * -> *). Foldable h => h x -> m a
f (FoldM m x (Seq x) -> FoldM m x a)
-> FoldM m x (Seq x) -> FoldM m x a
forall a b. (a -> b) -> a -> b
$ Fold x (Seq x) -> FoldM m x (Seq x)
forall (m :: * -> *) a b. Monad m => Fold a b -> FoldM m a b
FL.generalize Fold x (Seq x)
forall a. Fold a (Seq a)
seqF