{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE CPP                   #-}
{-# 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.Monomorphic.Folds
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
  (
    -- * Types
    EndoFold

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

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

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

  -- * functions/types using constraints to extend an endo-fold across a record
  , foldAll
  , ConstrainedFoldable
  , foldAllConstrained
  , foldAllMonoid

  -- * for generalizing
  , monoidWrapperToFold
  , MonoidalField
  )
where

import qualified Control.Foldl                 as FL
import qualified Control.Newtype               as N
#if MIN_VERSION_base(4,11,0)
#else  
import           Data.Monoid                    ( (<>) )
import           Data.Monoid                    ( Monoid(..))
#endif
import qualified Data.Profunctor               as P
import qualified Data.Vinyl                    as V
import qualified Data.Vinyl.TypeLevel          as V
import qualified Data.Vinyl.Functor            as V
import qualified Frames                        as F
import qualified Frames.Melt                   as F


-- | A Type synonym for folds like sum or, often, average.
type EndoFold a = FL.Fold a a

-- | Turn and EndoFold a into an EndoFold (ElField '(s, a))
fieldFold
  :: (V.KnownField t, a ~ V.Snd t) => EndoFold a -> EndoFold (F.ElField t)
fieldFold :: EndoFold a -> EndoFold (ElField t)
fieldFold = (ElField t -> a)
-> (a -> ElField '(Fst t, a))
-> EndoFold a
-> Fold (ElField t) (ElField '(Fst t, a))
forall (p :: * -> * -> *) a b c d.
Profunctor p =>
(a -> b) -> (c -> d) -> p b c -> p a d
P.dimap (\(V.Field t
x) -> a
t
x) a -> ElField '(Fst t, a)
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 t = FoldEndo { FoldEndo t -> EndoFold (Snd t)
unFoldEndo :: EndoFold (V.Snd t) }

-- | Wrapper for endo-folds on an interpretation f.  Usually f ~ ElField 
newtype FoldFieldEndo f a = FoldFieldEndo { FoldFieldEndo f a -> EndoFold (f a)
unFoldFieldEndo :: EndoFold (f a) } -- type FoldFieldEndo f a = FoldEndo (f a)

-- | Wrapper for folds from a record to an interpreted field.  Usually f ~ ElField
newtype FoldRecord f rs a = FoldRecord { FoldRecord f rs a -> Fold (Record rs) (f a)
unFoldRecord :: FL.Fold (F.Record rs) (f 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
  :: V.KnownField t
  => FL.Fold (F.Record rs) (V.Snd t)
  -> FoldRecord F.ElField rs t
toFoldRecord :: Fold (Record rs) (Snd t) -> FoldRecord ElField rs t
toFoldRecord = Fold (Record rs) (ElField '(Fst t, Snd t))
-> FoldRecord ElField rs '(Fst t, Snd t)
forall k (f :: k -> *) (rs :: [(Symbol, *)]) (a :: k).
Fold (Record rs) (f a) -> FoldRecord f rs a
FoldRecord (Fold (Record rs) (ElField '(Fst t, Snd t))
 -> FoldRecord ElField rs '(Fst t, Snd t))
-> (Fold (Record rs) (Snd t)
    -> Fold (Record rs) (ElField '(Fst t, Snd t)))
-> Fold (Record rs) (Snd t)
-> FoldRecord ElField rs '(Fst t, Snd t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Snd t -> ElField '(Fst t, Snd t))
-> Fold (Record rs) (Snd t)
-> Fold (Record rs) (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 toFoldRecord #-}

-- | Helper for building a 'FoldRecord' from a given fold and function of the record
recFieldF
  :: forall t rs a
   . V.KnownField t
  => FL.Fold a (V.Snd t) -- ^ A fold from some type a to the field type of an ElField 
  -> (F.Record rs -> a) -- ^ a function to get the a value from the input record
  -> FoldRecord V.ElField rs t -- ^ the resulting 'FoldRecord'-wrapped fold 
recFieldF :: Fold a (Snd t) -> (Record rs -> a) -> FoldRecord ElField rs t
recFieldF Fold a (Snd t)
fld Record rs -> a
fromRec = Fold (Record rs) (ElField '(Fst t, Snd t))
-> FoldRecord ElField rs '(Fst t, Snd t)
forall k (f :: k -> *) (rs :: [(Symbol, *)]) (a :: k).
Fold (Record rs) (f a) -> FoldRecord f rs a
FoldRecord (Fold (Record rs) (ElField '(Fst t, Snd t))
 -> FoldRecord ElField rs '(Fst t, Snd t))
-> Fold (Record rs) (ElField '(Fst t, Snd t))
-> FoldRecord ElField rs '(Fst t, Snd t)
forall a b. (a -> b) -> a -> b
$ (Record rs -> a)
-> (Snd t -> ElField '(Fst t, Snd t))
-> Fold a (Snd t)
-> Fold (Record rs) (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 rs -> a
fromRec Snd t -> ElField '(Fst t, Snd t)
forall (s :: Symbol) t. KnownSymbol s => t -> ElField '(s, t)
V.Field 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
   . (V.KnownField x, V.KnownField y, F.ElemOf rs x)
  => FL.Fold (V.Snd x) (V.Snd y) -- ^ the fold to be wrapped
  -> FoldRecord F.ElField rs y -- ^ the wrapped fold
fieldToFieldFold :: Fold (Snd x) (Snd y) -> FoldRecord ElField rs y
fieldToFieldFold Fold (Snd x) (Snd y)
fld = Fold (Snd x) (Snd y)
-> (Record rs -> Snd x) -> FoldRecord ElField rs y
forall (t :: (Symbol, *)) (rs :: [(Symbol, *)]) a.
KnownField t =>
Fold a (Snd t) -> (Record rs -> a) -> FoldRecord ElField rs t
recFieldF Fold (Snd x) (Snd y)
fld (forall (s :: Symbol) a (rs :: [(Symbol, *)]).
(x ~ '(s, a), x ∈ rs) =>
Record rs -> a
forall (t :: (Symbol, *)) (s :: Symbol) a (rs :: [(Symbol, *)]).
(t ~ '(s, a), t ∈ rs) =>
Record rs -> a
F.rgetField @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
   . (as F.⊆ rs, V.RMap as)
  => F.Rec (FoldRecord F.ElField as) as -- ^ original fold 
  -> F.Rec (FoldRecord F.ElField rs) as -- ^ resulting fold 
expandFoldInRecord :: Rec (FoldRecord ElField as) as -> Rec (FoldRecord ElField rs) as
expandFoldInRecord = (forall (x :: (Symbol, *)).
 FoldRecord ElField as x -> FoldRecord ElField rs x)
-> Rec (FoldRecord ElField as) as -> Rec (FoldRecord 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 rs) (ElField x) -> FoldRecord ElField rs x
forall k (f :: k -> *) (rs :: [(Symbol, *)]) (a :: k).
Fold (Record rs) (f a) -> FoldRecord f rs a
FoldRecord (Fold (Record rs) (ElField x) -> FoldRecord ElField rs x)
-> (FoldRecord ElField as x -> Fold (Record rs) (ElField x))
-> FoldRecord ElField as x
-> FoldRecord ElField rs x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Record rs -> Rec ElField as)
-> Fold (Rec ElField as) (ElField x)
-> Fold (Record rs) (ElField x)
forall a b r. (a -> b) -> Fold b r -> Fold a r
FL.premap Record rs -> Rec ElField as
forall k1 k2 (rs :: [k1]) (ss :: [k1]) (f :: k2 -> *)
       (record :: (k2 -> *) -> [k1] -> *) (is :: [Nat]).
(RecSubset record rs ss is, RecSubsetFCtx record f) =>
record f ss -> record f rs
F.rcast (Fold (Rec ElField as) (ElField x) -> Fold (Record rs) (ElField x))
-> (FoldRecord ElField as x -> Fold (Rec ElField as) (ElField x))
-> FoldRecord ElField as x
-> Fold (Record rs) (ElField x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoldRecord ElField as x -> Fold (Rec ElField as) (ElField x)
forall k (f :: k -> *) (rs :: [(Symbol, *)]) (a :: k).
FoldRecord f rs a -> Fold (Record rs) (f 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 where
  endoFieldFoldsToRecordFolds :: F.Rec (FoldFieldEndo F.ElField) rs -> F.Rec (FoldRecord F.ElField rs) rs


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

instance (EndoFieldFoldsToRecordFolds rs, rs F.⊆ (r ': rs), V.RMap rs) => EndoFieldFoldsToRecordFolds (r ': rs) where
  endoFieldFoldsToRecordFolds :: Rec (FoldFieldEndo ElField) (r : rs)
-> Rec (FoldRecord ElField (r : rs)) (r : rs)
endoFieldFoldsToRecordFolds (FoldFieldEndo ElField r
fe V.:& Rec (FoldFieldEndo ElField) rs
fes) = Fold (Record (r : rs)) (ElField r) -> FoldRecord ElField (r : rs) r
forall k (f :: k -> *) (rs :: [(Symbol, *)]) (a :: k).
Fold (Record rs) (f a) -> FoldRecord f rs a
FoldRecord ((Record (r : rs) -> ElField r)
-> Fold (ElField r) (ElField r)
-> Fold (Record (r : rs)) (ElField r)
forall a b r. (a -> b) -> Fold b r -> Fold a r
FL.premap (forall (rs :: [(Symbol, *)]) (f :: (Symbol, *) -> *)
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *).
(RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f) =>
record f rs -> f r
forall k (r :: k) (rs :: [k]) (f :: k -> *)
       (record :: (k -> *) -> [k] -> *).
(RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f) =>
record f rs -> f r
V.rget @r) (FoldFieldEndo ElField r -> EndoFold (ElField r)
forall k (f :: k -> *) (a :: k).
FoldFieldEndo f a -> EndoFold (f a)
unFoldFieldEndo FoldFieldEndo ElField r
fe)) FoldRecord ElField (r : rs) r
-> Rec (FoldRecord ElField (r : rs)) rs
-> Rec (FoldRecord 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 ElField rs) rs
-> Rec (FoldRecord ElField (r : rs)) rs
forall (rs :: [(Symbol, *)]) (as :: [(Symbol, *)]).
(as ⊆ rs, RMap as) =>
Rec (FoldRecord ElField as) as -> Rec (FoldRecord ElField rs) as
expandFoldInRecord @(r ': rs) (Rec (FoldFieldEndo ElField) rs -> Rec (FoldRecord ElField rs) rs
forall (rs :: [(Symbol, *)]).
EndoFieldFoldsToRecordFolds rs =>
Rec (FoldFieldEndo ElField) rs -> Rec (FoldRecord ElField rs) rs
endoFieldFoldsToRecordFolds Rec (FoldFieldEndo 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
   . F.Rec (FoldRecord F.ElField as) rs
  -> FL.Fold (F.Record as) (F.Record rs)
sequenceRecFold :: Rec (FoldRecord ElField as) rs -> Fold (Record as) (Record rs)
sequenceRecFold = (forall (x :: (Symbol, *)).
 FoldRecord ElField as x -> Fold (Record as) (ElField x))
-> Rec (FoldRecord ElField as) rs -> Fold (Record as) (Record 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 (f :: k -> *) (rs :: [(Symbol, *)]) (a :: k).
FoldRecord f rs a -> Fold (Record rs) (f a)
forall (x :: (Symbol, *)).
FoldRecord ElField as x -> Fold (Record as) (ElField x)
unFoldRecord
{-# INLINABLE sequenceRecFold #-}

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

{-
liftFold
  :: V.KnownField t => FL.Fold (V.Snd t) (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 => FoldEndo t -> FoldFieldEndo F.ElField t
liftFoldEndo :: FoldEndo t -> FoldFieldEndo ElField t
liftFoldEndo = EndoFold (ElField t) -> FoldFieldEndo ElField t
forall k (f :: k -> *) (a :: k).
EndoFold (f a) -> FoldFieldEndo f a
FoldFieldEndo (EndoFold (ElField t) -> FoldFieldEndo ElField t)
-> (FoldEndo t -> EndoFold (ElField t))
-> FoldEndo t
-> FoldFieldEndo ElField t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EndoFold (Snd t) -> EndoFold (ElField t)
forall (t :: (Symbol, *)) a.
(KnownField t, a ~ Snd t) =>
EndoFold a -> EndoFold (ElField t)
fieldFold (EndoFold (Snd t) -> EndoFold (ElField t))
-> (FoldEndo t -> EndoFold (Snd t))
-> FoldEndo t
-> EndoFold (ElField t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoldEndo t -> EndoFold (Snd t)
forall k1 (t :: (k1, *)). FoldEndo t -> EndoFold (Snd t)
unFoldEndo
{-# INLINABLE liftFoldEndo #-}

liftFolds
  :: (V.RPureConstrained V.KnownField rs, V.RApply rs)
  => F.Rec FoldEndo rs
  -> F.Rec (FoldFieldEndo F.ElField) rs
liftFolds :: Rec FoldEndo rs -> Rec (FoldFieldEndo ElField) rs
liftFolds = Rec (Lift (->) FoldEndo (FoldFieldEndo ElField)) rs
-> Rec FoldEndo rs -> Rec (FoldFieldEndo 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 (FoldFieldEndo ElField)) rs
liftedFs
  where liftedFs :: Rec (Lift (->) FoldEndo (FoldFieldEndo 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 (FoldFieldEndo ElField) a)
 -> Rec (Lift (->) FoldEndo (FoldFieldEndo ElField)) rs)
-> (forall (a :: (Symbol, *)).
    KnownField a =>
    Lift (->) FoldEndo (FoldFieldEndo ElField) a)
-> Rec (Lift (->) FoldEndo (FoldFieldEndo ElField)) rs
forall a b. (a -> b) -> a -> b
$ (FoldEndo a -> FoldFieldEndo ElField a)
-> Lift (->) FoldEndo (FoldFieldEndo 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 a -> FoldFieldEndo ElField a
forall (t :: (Symbol, *)).
KnownField t =>
FoldEndo t -> FoldFieldEndo ElField t
liftFoldEndo
{-# INLINABLE liftFolds #-}


-- | turn a record of endo-folds over each field, into a fold over records 
sequenceEndoFolds
  :: forall rs
   . ( V.RApply rs
     , V.RPureConstrained V.KnownField rs
     , EndoFieldFoldsToRecordFolds rs
     )
  => F.Rec FoldEndo rs
  -> FL.Fold (F.Record rs) (F.Record rs)
sequenceEndoFolds :: Rec FoldEndo rs -> Fold (Record rs) (Record rs)
sequenceEndoFolds = Rec (FoldFieldEndo ElField) rs -> Fold (Record rs) (Record rs)
forall (rs :: [(Symbol, *)]).
EndoFieldFoldsToRecordFolds rs =>
Rec (FoldFieldEndo ElField) rs -> Fold (Record rs) (Record rs)
sequenceFieldEndoFolds (Rec (FoldFieldEndo ElField) rs -> Fold (Record rs) (Record rs))
-> (Rec FoldEndo rs -> Rec (FoldFieldEndo ElField) rs)
-> Rec FoldEndo rs
-> Fold (Record rs) (Record rs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec FoldEndo rs -> Rec (FoldFieldEndo ElField) rs
forall (rs :: [(Symbol, *)]).
(RPureConstrained KnownField rs, RApply rs) =>
Rec FoldEndo rs -> Rec (FoldFieldEndo 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
     )
  => (forall a . FL.Fold a a)
  -> FL.Fold (F.Record rs) (F.Record rs)
foldAll :: (forall a. Fold a a) -> Fold (Record rs) (Record rs)
foldAll forall a. Fold a a
f = Rec FoldEndo rs -> Fold (Record rs) (Record rs)
forall (rs :: [(Symbol, *)]).
(RApply rs, RPureConstrained KnownField rs,
 EndoFieldFoldsToRecordFolds rs) =>
Rec FoldEndo rs -> Fold (Record rs) (Record rs)
sequenceEndoFolds (Rec FoldEndo rs -> Fold (Record rs) (Record rs))
-> Rec FoldEndo rs -> Fold (Record rs) (Record rs)
forall a b. (a -> b) -> a -> b
$ (forall (a :: (Symbol, *)). KnownField a => FoldEndo a)
-> Rec FoldEndo 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 (Snd '(Fst a, Snd a)) -> FoldEndo '(Fst a, Snd a)
forall k1 (t :: (k1, *)). EndoFold (Snd t) -> FoldEndo t
FoldEndo EndoFold (Snd '(Fst a, 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

type ConstrainedFoldable c rs = (V.RPureConstrained (ConstrainedField c) rs
                                , V.RPureConstrained V.KnownField rs
                                , V.RApply rs
                                , EndoFieldFoldsToRecordFolds rs
                                )

-- | 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. ConstrainedFoldable c rs
  => (forall a . c a => FL.Fold a a)
  -> FL.Fold (F.Record rs) (F.Record rs)
foldAllConstrained :: (forall a. c a => Fold a a) -> Fold (Record rs) (Record rs)
foldAllConstrained forall a. c a => Fold a a
f =
  Rec FoldEndo rs -> Fold (Record rs) (Record rs)
forall (rs :: [(Symbol, *)]).
(RApply rs, RPureConstrained KnownField rs,
 EndoFieldFoldsToRecordFolds rs) =>
Rec FoldEndo rs -> Fold (Record rs) (Record rs)
sequenceEndoFolds (Rec FoldEndo rs -> Fold (Record rs) (Record rs))
-> Rec FoldEndo rs -> Fold (Record rs) (Record rs)
forall a b. (a -> b) -> a -> b
$ (forall (a :: (Symbol, *)). ConstrainedField c a => FoldEndo a)
-> Rec FoldEndo 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 (Snd a) -> FoldEndo a
forall k1 (t :: (k1, *)). EndoFold (Snd t) -> FoldEndo t
FoldEndo EndoFold (Snd a)
forall a. c a => Fold a a
f)
{-# INLINABLE foldAllConstrained #-}



-- | Given a monoid-wrapper, e.g., Sum, and functions to wrap and unwrap, we can produce an endo-fold on a
monoidWrapperToFold
  :: forall f a . (N.Newtype (f a) a, Monoid (f a)) => FL.Fold a a
monoidWrapperToFold :: Fold a a
monoidWrapperToFold = (f a -> a -> f a) -> f a -> (f a -> a) -> Fold a a
forall a b x. (x -> a -> x) -> x -> (x -> b) -> Fold a b
FL.Fold (\f a
w a
a -> a -> f a
forall n o. Newtype n o => o -> n
N.pack a
a f a -> f a -> f a
forall a. Semigroup a => a -> a -> a
<> f a
w) (Monoid (f a) => f a
forall a. Monoid a => a
mempty @(f a)) f a -> a
forall n o. Newtype n o => n -> o
N.unpack -- is this the correct order in (<>) ?
{-# INLINABLE monoidWrapperToFold #-}

class (N.Newtype (f a) a, Monoid (f a)) => MonoidalField f a
instance (N.Newtype (f a) a, Monoid (f a)) => MonoidalField f a

-- | 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 f rs
   . ( V.RPureConstrained (ConstrainedField (MonoidalField f)) rs
     , V.RPureConstrained V.KnownField rs
     , V.RApply rs
     , EndoFieldFoldsToRecordFolds rs
     )
  => FL.Fold (F.Record rs) (F.Record rs)
foldAllMonoid :: Fold (Record rs) (Record rs)
foldAllMonoid = forall (rs :: [(Symbol, *)]).
ConstrainedFoldable (MonoidalField f) rs =>
(forall a. MonoidalField f a => Fold a a)
-> Fold (Record rs) (Record rs)
forall (c :: * -> Constraint) (rs :: [(Symbol, *)]).
ConstrainedFoldable c rs =>
(forall a. c a => Fold a a) -> Fold (Record rs) (Record rs)
foldAllConstrained @(MonoidalField f) ((forall a. MonoidalField f a => Fold a a)
 -> Fold (Record rs) (Record rs))
-> (forall a. MonoidalField f a => Fold a a)
-> Fold (Record rs) (Record rs)
forall a b. (a -> b) -> a -> b
$ forall a. (Newtype (f a) a, Monoid (f a)) => Fold a a
forall (f :: * -> *) a. (Newtype (f a) a, Monoid (f a)) => Fold a a
monoidWrapperToFold @f
{-# INLINABLE foldAllMonoid #-}