{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
{-|
Module      : Frames.Folds.General
Description : Types and functions to simplify folding over Vinyl/Frames records. Leans heavily on the foldl package. 
Copyright   : (c) Adam Conner-Sax 2019
License     : BSD
Maintainer  : adam_conner_sax@yahoo.com
Stability   : experimental

Frames.Folds contains various helper functions designed to simplify folding over Frames/Vinyl records given some way of folding over each column.
-}
module Frames.Folds.General
  (
    -- * Types
    EndoFold

    -- ** Types to act as "interpretation functors" for records of folds
  , FoldEndo(..)
  , FoldRecord(..)

  -- * classes
  , EndoFieldFoldsToRecordFolds
  , ConstrainedField

  -- * functions for building records of folds
  , toFoldRecord
  , recFieldF
  , fieldToFieldFold

  -- * functions for turning records of folds into folds of records
  , sequenceRecFold
  , sequenceEndoFolds

  -- * functions using constraints to extend an endo-fold across a record
  , foldAll
  , foldAllConstrained
  , functorFoldAllConstrained
  , foldAllMonoid
  )
where

import           Frames.MapReduce.General       ( RecGetFieldC(..)
                                                , RCastC(..)
                                                , IsoRec(..)
                                                )
import           Frames.Folds                   ( EndoFold
                                                , FoldFieldEndo(..)
                                                , monoidWrapperToFold
                                                , MonoidalField
                                                )

import qualified Control.Foldl                 as FL

import qualified Data.Profunctor               as P
import qualified Data.Vinyl                    as V
import           Data.Vinyl                     ( ElField )
import qualified Data.Vinyl.TypeLevel          as V
import qualified Data.Vinyl.Functor            as V
import qualified Frames                        as F
import           Frames                         ( (:.) )
import qualified Frames.Melt                   as F


-- | Turn and EndoFold (Maybe a) into an EndoFold ((Maybe :. ElField) '(s, a))
fieldFold
  :: (Functor f, V.KnownField t)
  => EndoFold (f (V.Snd t))
  -> EndoFold ((f :. ElField) t)
fieldFold :: EndoFold (f (Snd t)) -> EndoFold ((:.) f ElField t)
fieldFold =
  ((:.) f ElField t -> f (Snd t))
-> (f (Snd t) -> Compose f ElField '(Fst t, Snd t))
-> EndoFold (f (Snd t))
-> Fold ((:.) f ElField t) (Compose f ElField '(Fst t, Snd t))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap ((ElField t -> Snd t) -> f (ElField t) -> f (Snd t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(V.Field t
x) -> t
Snd t
x) (f (ElField t) -> f (Snd t))
-> ((:.) f ElField t -> f (ElField t))
-> (:.) f ElField t
-> f (Snd t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:.) f ElField t -> f (ElField t)
forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Compose f g x -> f (g x)
V.getCompose) (f (ElField '(Fst t, Snd t)) -> Compose f ElField '(Fst t, Snd t)
forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
V.Compose (f (ElField '(Fst t, Snd t)) -> Compose f ElField '(Fst t, Snd t))
-> (f (Snd t) -> f (ElField '(Fst t, Snd t)))
-> f (Snd t)
-> Compose f ElField '(Fst t, Snd t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Snd t -> ElField '(Fst t, Snd t))
-> f (Snd t) -> f (ElField '(Fst t, Snd t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Snd t -> ElField '(Fst t, Snd t)
forall (s :: Symbol) t. KnownSymbol s => t -> ElField '(s, t)
V.Field)
{-# INLINABLE fieldFold #-}



-- | Wrapper for Endo-folds of the field types of ElFields
newtype FoldEndo f t = FoldEndo { FoldEndo f t -> EndoFold (f (Snd t))
unFoldEndo :: EndoFold (f (V.Snd t)) }

-- | Wrapper for folds from a record to an interpreted field.  Usually g ~ ElField
newtype FoldRecord record f g rs a = FoldRecord { FoldRecord record f g rs a -> Fold (record (f :. ElField) rs) (g a)
unFoldRecord :: FL.Fold (record (f :. ElField) rs) (g a) }

-- | Create a @FoldRecord@ from a @Fold@ from a record to a specific type.
-- This is helpful when creating folds from a record to another record (or the same record)
-- by building it one field at a time.  See examples for details.
toFoldRecord
  :: (a -> g b)
  -> FL.Fold (record (f :. ElField) rs) a
  -> FoldRecord record f g rs b
toFoldRecord :: (a -> g b)
-> Fold (record (f :. ElField) rs) a -> FoldRecord record f g rs b
toFoldRecord a -> g b
wrap = Fold (record (f :. ElField) rs) (g b) -> FoldRecord record f g rs b
forall k k (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *)
       (g :: k -> *) (rs :: k) (a :: k).
Fold (record (f :. ElField) rs) (g a) -> FoldRecord record f g rs a
FoldRecord (Fold (record (f :. ElField) rs) (g b)
 -> FoldRecord record f g rs b)
-> (Fold (record (f :. ElField) rs) a
    -> Fold (record (f :. ElField) rs) (g b))
-> Fold (record (f :. ElField) rs) a
-> FoldRecord record f g rs b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> g b)
-> Fold (record (f :. ElField) rs) a
-> Fold (record (f :. ElField) rs) (g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> g b
wrap
{-# INLINABLE toFoldRecord #-}

-- | Control.Foldl helper for filtering
filteredFold :: (f a -> Maybe a) -> FL.Fold a b -> FL.Fold (f a) b
filteredFold :: (f a -> Maybe a) -> Fold a b -> Fold (f a) b
filteredFold f a -> Maybe a
toMaybe (FL.Fold x -> a -> x
step x
begin x -> b
done) = (x -> f a -> x) -> x -> (x -> b) -> Fold (f a) b
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
FL.Fold x -> f a -> x
step' x
begin x -> b
done
  where step' :: x -> f a -> x
step' x
x = x -> (a -> x) -> Maybe a -> x
forall b a. b -> (a -> b) -> Maybe a -> b
maybe x
x (x -> a -> x
step x
x) (Maybe a -> x) -> (f a -> Maybe a) -> f a -> x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Maybe a
toMaybe

-- | Helper for building a 'FoldRecord' from a given fold and function of the record
recFieldF
  :: forall t rs a record f
   . (V.KnownField t, Applicative f)
  => (forall x . f x -> Maybe x)
  -> FL.Fold a (V.Snd t) -- ^ A fold from some type a to the field type of an ElField
  -> (record (f :. ElField) rs -> f a)
  -> FoldRecord record f (f :. ElField) rs t -- ^ the resulting 'FoldRecord'-wrapped fold 
recFieldF :: (forall x. f x -> Maybe x)
-> Fold a (Snd t)
-> (record (f :. ElField) rs -> f a)
-> FoldRecord record f (f :. ElField) rs t
recFieldF forall x. f x -> Maybe x
toMaybe Fold a (Snd t)
fld record (f :. ElField) rs -> f a
fromRecF = Fold (record (f :. ElField) rs) (Compose f ElField '(Fst t, Snd t))
-> FoldRecord record f (f :. ElField) rs '(Fst t, Snd t)
forall k k (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *)
       (g :: k -> *) (rs :: k) (a :: k).
Fold (record (f :. ElField) rs) (g a) -> FoldRecord record f g rs a
FoldRecord
  (Fold
   (record (f :. ElField) rs) (Compose f ElField '(Fst t, Snd t))
 -> FoldRecord record f (f :. ElField) rs '(Fst t, Snd t))
-> Fold
     (record (f :. ElField) rs) (Compose f ElField '(Fst t, Snd t))
-> FoldRecord record f (f :. ElField) rs '(Fst t, Snd t)
forall a b. (a -> b) -> a -> b
$ (record (f :. ElField) rs -> f a)
-> (Snd t -> Compose f ElField '(Fst t, Snd t))
-> Fold (f a) (Snd t)
-> Fold
     (record (f :. ElField) rs) (Compose f ElField '(Fst t, Snd t))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap record (f :. ElField) rs -> f a
fromRecF (f (ElField '(Fst t, Snd t)) -> Compose f ElField '(Fst t, Snd t)
forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
V.Compose (f (ElField '(Fst t, Snd t)) -> Compose f ElField '(Fst t, Snd t))
-> (Snd t -> f (ElField '(Fst t, Snd t)))
-> Snd t
-> Compose f ElField '(Fst t, Snd t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElField '(Fst t, Snd t) -> f (ElField '(Fst t, Snd t))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ElField '(Fst t, Snd t) -> f (ElField '(Fst t, Snd t)))
-> (Snd t -> ElField '(Fst t, Snd t))
-> Snd t
-> f (ElField '(Fst t, Snd t))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Snd t -> ElField '(Fst t, Snd t)
forall (s :: Symbol) t. KnownSymbol s => t -> ElField '(s, t)
V.Field) ((f a -> Maybe a) -> Fold a (Snd t) -> Fold (f a) (Snd t)
forall (f :: * -> *) a b.
(f a -> Maybe a) -> Fold a b -> Fold (f a) b
filteredFold f a -> Maybe a
forall x. f x -> Maybe x
toMaybe Fold a (Snd t)
fld)
{-# INLINABLE recFieldF #-}

-- | special case of 'recFieldF' for the case when the function from the record to the folded type
-- is just retrieving the value in a field.
fieldToFieldFold
  :: forall x y rs record f
   . ( V.KnownField x
     , V.KnownField y
     , F.ElemOf rs x
     , RecGetFieldC x record f rs
     , Applicative f
     )
  => (forall z . f z -> Maybe z)
  -> FL.Fold (V.Snd x) (V.Snd y) -- ^ the fold to be wrapped
  -> FoldRecord record f (f :. ElField) rs y -- ^ the wrapped fold
fieldToFieldFold :: (forall z. f z -> Maybe z)
-> Fold (Snd x) (Snd y) -> FoldRecord record f (f :. ElField) rs y
fieldToFieldFold forall z. f z -> Maybe z
toMaybe Fold (Snd x) (Snd y)
fld = (forall z. f z -> Maybe z)
-> Fold (Snd x) (Snd y)
-> (record (f :. ElField) rs -> f (Snd x))
-> FoldRecord record f (f :. ElField) rs y
forall k (t :: (Symbol, *)) (rs :: k) a
       (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *).
(KnownField t, Applicative f) =>
(forall x. f x -> Maybe x)
-> Fold a (Snd t)
-> (record (f :. ElField) rs -> f a)
-> FoldRecord record f (f :. ElField) rs t
recFieldF forall z. f z -> Maybe z
toMaybe Fold (Snd x) (Snd y)
fld (forall (t :: (Symbol, *))
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *)
       (rs :: [(Symbol, *)]).
(RecGetFieldC t record f rs, KnownField t, Functor f,
 ElemOf rs t) =>
record (f :. ElField) rs -> f (Snd t)
forall (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *)
       (f :: * -> *) (rs :: [(Symbol, *)]).
(RecGetFieldC x record f rs, KnownField x, Functor f,
 ElemOf rs x) =>
record (f :. ElField) rs -> f (Snd x)
rgetFieldF @x)
{-# INLINABLE fieldToFieldFold #-}

-- | Expand a record of folds, each from the entire record to one field, into a record of folds each from a larger record to the smaller one.
expandFoldInRecord
  :: forall rs as record f
   . (RCastC as rs record f, V.RMap as)
  => V.Rec (FoldRecord record f (f :. ElField) as) as -- ^ original fold 
  -> V.Rec (FoldRecord record f (f :. ElField) rs) as -- ^ resulting fold 
expandFoldInRecord :: Rec (FoldRecord record f (f :. ElField) as) as
-> Rec (FoldRecord record f (f :. ElField) rs) as
expandFoldInRecord = (forall (x :: (Symbol, *)).
 FoldRecord record f (f :. ElField) as x
 -> FoldRecord record f (f :. ElField) rs x)
-> Rec (FoldRecord record f (f :. ElField) as) as
-> Rec (FoldRecord record f (f :. ElField) rs) as
forall u (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
V.rmap (Fold (record (f :. ElField) rs) ((:.) f ElField x)
-> FoldRecord record f (f :. ElField) rs x
forall k k (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *)
       (g :: k -> *) (rs :: k) (a :: k).
Fold (record (f :. ElField) rs) (g a) -> FoldRecord record f g rs a
FoldRecord (Fold (record (f :. ElField) rs) ((:.) f ElField x)
 -> FoldRecord record f (f :. ElField) rs x)
-> (FoldRecord record f (f :. ElField) as x
    -> Fold (record (f :. ElField) rs) ((:.) f ElField x))
-> FoldRecord record f (f :. ElField) as x
-> FoldRecord record f (f :. ElField) rs x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (record (f :. ElField) rs -> record (f :. ElField) as)
-> Fold (record (f :. ElField) as) ((:.) f ElField x)
-> Fold (record (f :. ElField) rs) ((:.) f ElField x)
forall a b r. (a -> b) -> Fold b r -> Fold a r
FL.premap record (f :. ElField) rs -> record (f :. ElField) as
forall k (rs :: k) (ss :: k)
       (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *).
RCastC rs ss record f =>
record (f :. ElField) ss -> record (f :. ElField) rs
rcastF (Fold (record (f :. ElField) as) ((:.) f ElField x)
 -> Fold (record (f :. ElField) rs) ((:.) f ElField x))
-> (FoldRecord record f (f :. ElField) as x
    -> Fold (record (f :. ElField) as) ((:.) f ElField x))
-> FoldRecord record f (f :. ElField) as x
-> Fold (record (f :. ElField) rs) ((:.) f ElField x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoldRecord record f (f :. ElField) as x
-> Fold (record (f :. ElField) as) ((:.) f ElField x)
forall k (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *) k
       (g :: k -> *) (rs :: k) (a :: k).
FoldRecord record f g rs a -> Fold (record (f :. ElField) rs) (g a)
unFoldRecord)
{-# INLINABLE expandFoldInRecord #-}

-- | Change a record of single field folds to a record of folds from the entire record to each field
class EndoFieldFoldsToRecordFolds rs record f where
  endoFieldFoldsToRecordFolds :: F.Rec (FoldFieldEndo (f :. ElField)) rs -> F.Rec (FoldRecord record f (f :. ElField) rs) rs


instance EndoFieldFoldsToRecordFolds '[] record f where
  endoFieldFoldsToRecordFolds :: Rec (FoldFieldEndo (f :. ElField)) '[]
-> Rec (FoldRecord record f (f :. ElField) '[]) '[]
endoFieldFoldsToRecordFolds Rec (FoldFieldEndo (f :. ElField)) '[]
_ = Rec (FoldRecord record f (f :. ElField) '[]) '[]
forall u (a :: u -> *). Rec a '[]
V.RNil
  {-# INLINABLE endoFieldFoldsToRecordFolds #-}

instance (EndoFieldFoldsToRecordFolds rs record f
         , RCastC rs (r ': rs) record f
         , V.KnownField r
         , RecGetFieldC r record f (r ': rs)
         , V.RMap rs
         ) => EndoFieldFoldsToRecordFolds (r ': rs) record f where
  endoFieldFoldsToRecordFolds :: Rec (FoldFieldEndo (f :. ElField)) (r : rs)
-> Rec (FoldRecord record f (f :. ElField) (r : rs)) (r : rs)
endoFieldFoldsToRecordFolds (FoldFieldEndo (f :. ElField) r
fe V.:& Rec (FoldFieldEndo (f :. ElField)) rs
fes) = Fold (record (f :. ElField) (r : rs)) (Compose f ElField r)
-> FoldRecord record f (f :. ElField) (r : rs) r
forall k k (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *)
       (g :: k -> *) (rs :: k) (a :: k).
Fold (record (f :. ElField) rs) (g a) -> FoldRecord record f g rs a
FoldRecord ((record (f :. ElField) (r : rs) -> (:.) f ElField r)
-> Fold ((:.) f ElField r) (Compose f ElField r)
-> Fold (record (f :. ElField) (r : rs)) (Compose f ElField r)
forall a b r. (a -> b) -> Fold b r -> Fold a r
FL.premap (forall (t :: (Symbol, *))
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *)
       (rs :: [(Symbol, *)]).
(RecGetFieldC t record f rs, KnownField t, ElemOf rs t) =>
record (f :. ElField) rs -> (:.) f ElField t
forall (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *)
       (f :: * -> *) (rs :: [(Symbol, *)]).
(RecGetFieldC r record f rs, KnownField r, ElemOf rs r) =>
record (f :. ElField) rs -> (:.) f ElField r
rgetF @r) (FoldFieldEndo (f :. ElField) r -> EndoFold (Compose f ElField r)
forall k (f :: k -> *) (a :: k).
FoldFieldEndo f a -> EndoFold (f a)
unFoldFieldEndo FoldFieldEndo (f :. ElField) r
fe)) FoldRecord record f (f :. ElField) (r : rs) r
-> Rec (FoldRecord record f (f :. ElField) (r : rs)) rs
-> Rec (FoldRecord record f (f :. ElField) (r : rs)) (r : rs)
forall u (a :: u -> *) (r :: u) (rs :: [u]).
a r -> Rec a rs -> Rec a (r : rs)
V.:& Rec (FoldRecord record f (f :. ElField) rs) rs
-> Rec (FoldRecord record f (f :. ElField) (r : rs)) rs
forall (rs :: [(Symbol, *)]) (as :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(RCastC as rs record f, RMap as) =>
Rec (FoldRecord record f (f :. ElField) as) as
-> Rec (FoldRecord record f (f :. ElField) rs) as
expandFoldInRecord @(r ': rs) (Rec (FoldFieldEndo (f :. ElField)) rs
-> Rec (FoldRecord record f (f :. ElField) rs) rs
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
EndoFieldFoldsToRecordFolds rs record f =>
Rec (FoldFieldEndo (f :. ElField)) rs
-> Rec (FoldRecord record f (f :. ElField) rs) rs
endoFieldFoldsToRecordFolds Rec (FoldFieldEndo (f :. ElField)) rs
fes)
  {-# INLINABLE endoFieldFoldsToRecordFolds #-}

-- can we do all/some of this via F.Rec (Fold as) bs?
-- | Turn a Record of folds into a fold over records
sequenceRecFold
  :: forall as rs record f
   . (IsoRec rs record f)
  => F.Rec (FoldRecord record f (f :. ElField) as) rs
  -> FL.Fold (record (f :. ElField) as) (record (f :. ElField) rs)
sequenceRecFold :: Rec (FoldRecord record f (f :. ElField) as) rs
-> Fold (record (f :. ElField) as) (record (f :. ElField) rs)
sequenceRecFold = (Rec (f :. ElField) rs -> record (f :. ElField) rs)
-> Fold (record (f :. ElField) as) (Rec (f :. ElField) rs)
-> Fold (record (f :. ElField) as) (record (f :. ElField) rs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Rec (f :. ElField) rs -> record (f :. ElField) rs
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
Rec (f :. ElField) rs -> record (f :. ElField) rs
fromRec (Fold (record (f :. ElField) as) (Rec (f :. ElField) rs)
 -> Fold (record (f :. ElField) as) (record (f :. ElField) rs))
-> (Rec (FoldRecord record f (f :. ElField) as) rs
    -> Fold (record (f :. ElField) as) (Rec (f :. ElField) rs))
-> Rec (FoldRecord record f (f :. ElField) as) rs
-> Fold (record (f :. ElField) as) (record (f :. ElField) rs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (x :: (Symbol, *)).
 FoldRecord record f (f :. ElField) as x
 -> Fold (record (f :. ElField) as) ((:.) f ElField x))
-> Rec (FoldRecord record f (f :. ElField) as) rs
-> Fold (record (f :. ElField) as) (Rec (f :. ElField) rs)
forall u (h :: * -> *) (f :: u -> *) (g :: u -> *) (rs :: [u]).
Applicative h =>
(forall (x :: u). f x -> h (g x)) -> Rec f rs -> h (Rec g rs)
V.rtraverse forall k (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *) k
       (g :: k -> *) (rs :: k) (a :: k).
FoldRecord record f g rs a -> Fold (record (f :. ElField) rs) (g a)
forall (x :: (Symbol, *)).
FoldRecord record f (f :. ElField) as x
-> Fold (record (f :. ElField) as) ((:.) f ElField x)
unFoldRecord
{-# INLINABLE sequenceRecFold #-}

-- | turn a record of folds over each field, into a fold over records 
sequenceFieldEndoFolds
  :: (EndoFieldFoldsToRecordFolds rs record f, IsoRec rs record f)
  => F.Rec (FoldFieldEndo (f :. ElField)) rs
  -> FL.Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
sequenceFieldEndoFolds :: Rec (FoldFieldEndo (f :. ElField)) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
sequenceFieldEndoFolds = Rec (FoldRecord record f (f :. ElField) rs) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall (as :: [(Symbol, *)]) (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
Rec (FoldRecord record f (f :. ElField) as) rs
-> Fold (record (f :. ElField) as) (record (f :. ElField) rs)
sequenceRecFold (Rec (FoldRecord record f (f :. ElField) rs) rs
 -> Fold (record (f :. ElField) rs) (record (f :. ElField) rs))
-> (Rec (FoldFieldEndo (f :. ElField)) rs
    -> Rec (FoldRecord record f (f :. ElField) rs) rs)
-> Rec (FoldFieldEndo (f :. ElField)) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (FoldFieldEndo (f :. ElField)) rs
-> Rec (FoldRecord record f (f :. ElField) rs) rs
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
EndoFieldFoldsToRecordFolds rs record f =>
Rec (FoldFieldEndo (f :. ElField)) rs
-> Rec (FoldRecord record f (f :. ElField) rs) rs
endoFieldFoldsToRecordFolds
{-# INLINABLE sequenceFieldEndoFolds #-}

{-
liftFold
  :: (V.KnownField t, Functor f)
  => FL.Fold (f (V.Snd t)) (f (V.Snd t))
  -> FoldFieldEndo (f :. ElField) t
liftFold = FoldFieldEndo . fieldFold
{-# INLINABLE liftFold #-}
-}
-- This is not a natural transformation, FoldEndoT ~> FoldEndo F.EField, because of the constraint
liftFoldEndo
  :: (V.KnownField t, Functor f)
  => FoldEndo f t
  -> FoldFieldEndo (f :. ElField) t
liftFoldEndo :: FoldEndo f t -> FoldFieldEndo (f :. ElField) t
liftFoldEndo = EndoFold (Compose f ElField t) -> FoldFieldEndo (f :. ElField) t
forall k (f :: k -> *) (a :: k).
EndoFold (f a) -> FoldFieldEndo f a
FoldFieldEndo (EndoFold (Compose f ElField t) -> FoldFieldEndo (f :. ElField) t)
-> (FoldEndo f t -> EndoFold (Compose f ElField t))
-> FoldEndo f t
-> FoldFieldEndo (f :. ElField) t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Fold (f (Snd t)) (f (Snd t)) -> EndoFold (Compose f ElField t)
forall (f :: * -> *) (t :: (Symbol, *)).
(Functor f, KnownField t) =>
EndoFold (f (Snd t)) -> EndoFold ((:.) f ElField t)
fieldFold (Fold (f (Snd t)) (f (Snd t)) -> EndoFold (Compose f ElField t))
-> (FoldEndo f t -> Fold (f (Snd t)) (f (Snd t)))
-> FoldEndo f t
-> EndoFold (Compose f ElField t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoldEndo f t -> Fold (f (Snd t)) (f (Snd t))
forall k (f :: k -> *) k1 (t :: (k1, k)).
FoldEndo f t -> EndoFold (f (Snd t))
unFoldEndo
{-# INLINABLE liftFoldEndo #-}

liftFolds
  :: (V.RPureConstrained V.KnownField rs, V.RApply rs, Functor f)
  => F.Rec (FoldEndo f) rs
  -> F.Rec (FoldFieldEndo (f :. ElField)) rs
liftFolds :: Rec (FoldEndo f) rs -> Rec (FoldFieldEndo (f :. ElField)) rs
liftFolds = Rec (Lift (->) (FoldEndo f) (FoldFieldEndo (f :. ElField))) rs
-> Rec (FoldEndo f) rs -> Rec (FoldFieldEndo (f :. ElField)) rs
forall u (rs :: [u]) (f :: u -> *) (g :: u -> *).
RApply rs =>
Rec (Lift (->) f g) rs -> Rec f rs -> Rec g rs
V.rapply Rec (Lift (->) (FoldEndo f) (FoldFieldEndo (f :. ElField))) rs
liftedFs
  where liftedFs :: Rec (Lift (->) (FoldEndo f) (FoldFieldEndo (f :. ElField))) rs
liftedFs = forall (ts :: [(Symbol, *)]) (f :: (Symbol, *) -> *).
RPureConstrained KnownField ts =>
(forall (a :: (Symbol, *)). KnownField a => f a) -> Rec f ts
forall u (c :: u -> Constraint) (ts :: [u]) (f :: u -> *).
RPureConstrained c ts =>
(forall (a :: u). c a => f a) -> Rec f ts
V.rpureConstrained @V.KnownField ((forall (a :: (Symbol, *)).
  KnownField a =>
  Lift (->) (FoldEndo f) (FoldFieldEndo (f :. ElField)) a)
 -> Rec (Lift (->) (FoldEndo f) (FoldFieldEndo (f :. ElField))) rs)
-> (forall (a :: (Symbol, *)).
    KnownField a =>
    Lift (->) (FoldEndo f) (FoldFieldEndo (f :. ElField)) a)
-> Rec (Lift (->) (FoldEndo f) (FoldFieldEndo (f :. ElField))) rs
forall a b. (a -> b) -> a -> b
$ (FoldEndo f a -> FoldFieldEndo (f :. ElField) a)
-> Lift (->) (FoldEndo f) (FoldFieldEndo (f :. ElField)) a
forall l l' k (op :: l -> l' -> *) (f :: k -> l) (g :: k -> l')
       (x :: k).
op (f x) (g x) -> Lift op f g x
V.Lift FoldEndo f a -> FoldFieldEndo (f :. ElField) a
forall (t :: (Symbol, *)) (f :: * -> *).
(KnownField t, Functor f) =>
FoldEndo f t -> FoldFieldEndo (f :. ElField) t
liftFoldEndo
{-# INLINABLE liftFolds #-}

-- | turn a record of endo-folds over each field, into a fold over records 
sequenceEndoFolds
  :: forall rs record f
   . ( V.RApply rs
     , V.RPureConstrained V.KnownField rs
     , EndoFieldFoldsToRecordFolds rs record f
     , IsoRec rs record f
     , Functor f
     )
  => F.Rec (FoldEndo f) rs
  -> FL.Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
sequenceEndoFolds :: Rec (FoldEndo f) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
sequenceEndoFolds = Rec (FoldFieldEndo (f :. ElField)) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(EndoFieldFoldsToRecordFolds rs record f, IsoRec rs record f) =>
Rec (FoldFieldEndo (f :. ElField)) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
sequenceFieldEndoFolds (Rec (FoldFieldEndo (f :. ElField)) rs
 -> Fold (record (f :. ElField) rs) (record (f :. ElField) rs))
-> (Rec (FoldEndo f) rs -> Rec (FoldFieldEndo (f :. ElField)) rs)
-> Rec (FoldEndo f) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (FoldEndo f) rs -> Rec (FoldFieldEndo (f :. ElField)) rs
forall (rs :: [(Symbol, *)]) (f :: * -> *).
(RPureConstrained KnownField rs, RApply rs, Functor f) =>
Rec (FoldEndo f) rs -> Rec (FoldFieldEndo (f :. ElField)) rs
liftFolds
{-# INLINABLE sequenceEndoFolds #-}

-- | apply an unconstrained endo-fold, e.g., a fold which takes the last item in a container, to every field in a record
foldAll
  :: ( V.RPureConstrained V.KnownField rs
     , V.RApply rs
     , EndoFieldFoldsToRecordFolds rs record f
     , IsoRec rs record f
     , Functor f
     )
  => (forall a . FL.Fold a a)
  -> FL.Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
foldAll :: (forall a. Fold a a)
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
foldAll forall a. Fold a a
f = Rec (FoldEndo f) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(RApply rs, RPureConstrained KnownField rs,
 EndoFieldFoldsToRecordFolds rs record f, IsoRec rs record f,
 Functor f) =>
Rec (FoldEndo f) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
sequenceEndoFolds (Rec (FoldEndo f) rs
 -> Fold (record (f :. ElField) rs) (record (f :. ElField) rs))
-> Rec (FoldEndo f) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall a b. (a -> b) -> a -> b
$ (forall (a :: (Symbol, *)). KnownField a => FoldEndo f a)
-> Rec (FoldEndo f) rs
forall u (c :: u -> Constraint) (ts :: [u]) (f :: u -> *).
RPureConstrained c ts =>
(forall (a :: u). c a => f a) -> Rec f ts
V.rpureConstrained @V.KnownField (EndoFold (f (Snd a)) -> FoldEndo f a
forall k k1 (f :: k -> *) (t :: (k1, k)).
EndoFold (f (Snd t)) -> FoldEndo f t
FoldEndo EndoFold (f (Snd a))
forall a. Fold a a
f)
{-# INLINABLE foldAll #-}

class (c  (V.Snd t)) => ConstrainedField c t
instance (c  (V.Snd t)) => ConstrainedField c t

-- | Apply a constrained endo-fold to all fields of a record.
-- May require a use of TypeApplications, e.g., foldAllConstrained @Num FL.sum
foldAllConstrained
  :: forall c rs record f
   . ( V.RPureConstrained (ConstrainedField c) rs
     , V.RPureConstrained V.KnownField rs
     , V.RApply rs
     , EndoFieldFoldsToRecordFolds rs record f
     , IsoRec rs record f
     , Applicative f
     )
  => (forall a . f a -> Maybe a)
  -> (forall a . c a => FL.Fold a a)
  -> FL.Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
foldAllConstrained :: (forall a. f a -> Maybe a)
-> (forall a. c a => Fold a a)
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
foldAllConstrained forall a. f a -> Maybe a
toMaybe forall a. c a => Fold a a
f =
  Rec (FoldEndo f) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(RApply rs, RPureConstrained KnownField rs,
 EndoFieldFoldsToRecordFolds rs record f, IsoRec rs record f,
 Functor f) =>
Rec (FoldEndo f) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
sequenceEndoFolds (Rec (FoldEndo f) rs
 -> Fold (record (f :. ElField) rs) (record (f :. ElField) rs))
-> Rec (FoldEndo f) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall a b. (a -> b) -> a -> b
$ (forall (a :: (Symbol, *)). ConstrainedField c a => FoldEndo f a)
-> Rec (FoldEndo f) rs
forall u (c :: u -> Constraint) (ts :: [u]) (f :: u -> *).
RPureConstrained c ts =>
(forall (a :: u). c a => f a) -> Rec f ts
V.rpureConstrained @(ConstrainedField c)
    (EndoFold (f (Snd a)) -> FoldEndo f a
forall k k1 (f :: k -> *) (t :: (k1, k)).
EndoFold (f (Snd t)) -> FoldEndo f t
FoldEndo ((Snd a -> f (Snd a))
-> Fold (f (Snd a)) (Snd a) -> EndoFold (f (Snd a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Snd a -> f (Snd a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Fold (f (Snd a)) (Snd a) -> EndoFold (f (Snd a)))
-> Fold (f (Snd a)) (Snd a) -> EndoFold (f (Snd a))
forall a b. (a -> b) -> a -> b
$ (f (Snd a) -> Maybe (Snd a))
-> Fold (Snd a) (Snd a) -> Fold (f (Snd a)) (Snd a)
forall (f :: * -> *) a b.
(f a -> Maybe a) -> Fold a b -> Fold (f a) b
filteredFold f (Snd a) -> Maybe (Snd a)
forall a. f a -> Maybe a
toMaybe Fold (Snd a) (Snd a)
forall a. c a => Fold a a
f))
{-# INLINABLE foldAllConstrained #-}

functorFoldAllConstrained
  :: forall c rs record f
   . ( V.RPureConstrained (ConstrainedField c) rs
     , V.RPureConstrained V.KnownField rs
     , V.RApply rs
     , EndoFieldFoldsToRecordFolds rs record f
     , IsoRec rs record f
     , Applicative f
     )
  => (forall a . c a => FL.Fold (f a) (f a))
  -> FL.Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
functorFoldAllConstrained :: (forall a. c a => Fold (f a) (f a))
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
functorFoldAllConstrained forall a. c a => Fold (f a) (f a)
f =
  Rec (FoldEndo f) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(RApply rs, RPureConstrained KnownField rs,
 EndoFieldFoldsToRecordFolds rs record f, IsoRec rs record f,
 Functor f) =>
Rec (FoldEndo f) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
sequenceEndoFolds (Rec (FoldEndo f) rs
 -> Fold (record (f :. ElField) rs) (record (f :. ElField) rs))
-> Rec (FoldEndo f) rs
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall a b. (a -> b) -> a -> b
$ (forall (a :: (Symbol, *)). ConstrainedField c a => FoldEndo f a)
-> Rec (FoldEndo f) rs
forall u (c :: u -> Constraint) (ts :: [u]) (f :: u -> *).
RPureConstrained c ts =>
(forall (a :: u). c a => f a) -> Rec f ts
V.rpureConstrained @(ConstrainedField c) (EndoFold (f (Snd a)) -> FoldEndo f a
forall k k1 (f :: k -> *) (t :: (k1, k)).
EndoFold (f (Snd t)) -> FoldEndo f t
FoldEndo EndoFold (f (Snd a))
forall a. c a => Fold (f a) (f a)
f)
{-# INLINABLE functorFoldAllConstrained #-}

-- | Given a monoid-wrapper, e.g., Sum, apply the derived endo-fold to all fields of a record
-- This is strictly less powerful than foldAllConstrained but might be simpler to use in some cases
foldAllMonoid
  :: forall g rs record f
   . ( V.RPureConstrained (ConstrainedField (MonoidalField g)) rs
     , V.RPureConstrained V.KnownField rs
     , V.RApply rs
     , EndoFieldFoldsToRecordFolds rs record f
     , IsoRec rs record f
     , Applicative f
     )
  => (forall a . f a -> Maybe a)
  -> FL.Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
foldAllMonoid :: (forall a. f a -> Maybe a)
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
foldAllMonoid forall a. f a -> Maybe a
toMaybe =
  (forall a. f a -> Maybe a)
-> (forall a. MonoidalField g a => Fold a a)
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall (c :: * -> Constraint) (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(RPureConstrained (ConstrainedField c) rs,
 RPureConstrained KnownField rs, RApply rs,
 EndoFieldFoldsToRecordFolds rs record f, IsoRec rs record f,
 Applicative f) =>
(forall a. f a -> Maybe a)
-> (forall a. c a => Fold a a)
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
foldAllConstrained @(MonoidalField g) forall a. f a -> Maybe a
toMaybe ((forall a. MonoidalField g a => Fold a a)
 -> Fold (record (f :. ElField) rs) (record (f :. ElField) rs))
-> (forall a. MonoidalField g a => Fold a a)
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
forall a b. (a -> b) -> a -> b
$ forall a. (Newtype (g a) a, Monoid (g a)) => Fold a a
forall (f :: * -> *) a. (Newtype (f a) a, Monoid (f a)) => Fold a a
monoidWrapperToFold @g
{-# INLINABLE foldAllMonoid #-}