{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
{-|
Module      : Frames.Folds.Maybe
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.Maybe
  (
    -- * Types
    EndoFold

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

    -- * 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
  , maybeFoldAllConstrained
  , foldAllMonoid
  )
where

import qualified Frames.MapReduce.General      as MG
import qualified Frames.Folds.General          as FG
import           Frames.Folds.General           ( FoldEndo(..)
                                                , FoldRecord(..)
                                                )

import           Frames.Folds                   ( EndoFold
                                                , MonoidalField
                                                )

import qualified Control.Foldl                 as FL

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

-- | 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 (Maybe :. ElField) rs) a
  -> FoldRecord record Maybe g rs b
toFoldRecord :: (a -> g b)
-> Fold (record (Maybe :. ElField) rs) a
-> FoldRecord record Maybe g rs b
toFoldRecord = (a -> g b)
-> Fold (record (Maybe :. ElField) rs) a
-> FoldRecord record Maybe g rs b
forall k1 k2 a (g :: k1 -> *) (b :: k1)
       (record :: ((Symbol, *) -> *) -> k2 -> *) (f :: * -> *) (rs :: k2).
(a -> g b)
-> Fold (record (f :. ElField) rs) a -> FoldRecord record f g rs b
FG.toFoldRecord --FoldRecord . fmap wrap

-- | Helper for building a 'FoldRecord' from a given fold and function of the record
recFieldF
  :: forall t rs a record
   . V.KnownField t
  => FL.Fold a (V.Snd t) -- ^ A fold from some type a to the field type of an ElField 
  -> (record (Maybe :. ElField) rs -> Maybe a) -- ^ a function to get the a value from the input record
  -> FG.FoldRecord record Maybe (Maybe :. ElField) rs t -- ^ the resulting 'FoldRecord'-wrapped fold 
recFieldF :: Fold a (Snd t)
-> (record (Maybe :. ElField) rs -> Maybe a)
-> FoldRecord record Maybe (Maybe :. ElField) rs t
recFieldF = (forall x. Maybe x -> Maybe x)
-> Fold a (Snd t)
-> (record (Maybe :. ElField) rs -> Maybe a)
-> FoldRecord record Maybe (Maybe :. ElField) rs t
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
FG.recFieldF forall a. a -> a
forall x. Maybe x -> Maybe x
id
{-# 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
   . ( V.KnownField x
     , V.KnownField y
     , F.ElemOf rs x
     , MG.RecGetFieldC x record Maybe rs
     )
  => FL.Fold (V.Snd x) (V.Snd y) -- ^ the fold to be wrapped
  -> FG.FoldRecord record Maybe (Maybe :. ElField) rs y -- ^ the wrapped fold
fieldToFieldFold :: Fold (Snd x) (Snd y)
-> FoldRecord record Maybe (Maybe :. ElField) rs y
fieldToFieldFold = (forall x. Maybe x -> Maybe x)
-> Fold (Snd x) (Snd y)
-> FoldRecord record Maybe (Maybe :. ElField) rs y
forall (x :: (Symbol, *)) (y :: (Symbol, *)) (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(KnownField x, KnownField y, ElemOf rs x,
 RecGetFieldC x record f rs, Applicative f) =>
(forall z. f z -> Maybe z)
-> Fold (Snd x) (Snd y) -> FoldRecord record f (f :. ElField) rs y
FG.fieldToFieldFold @x forall a. a -> a
forall x. Maybe x -> Maybe x
id
{-# INLINABLE fieldToFieldFold #-}

-- 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
   . (MG.IsoRec rs record Maybe)
  => F.Rec (FG.FoldRecord record Maybe (Maybe :. ElField) as) rs
  -> FL.Fold (record (Maybe :. ElField) as) (record (Maybe :. ElField) rs)
sequenceRecFold :: Rec (FoldRecord record Maybe (Maybe :. ElField) as) rs
-> Fold
     (record (Maybe :. ElField) as) (record (Maybe :. ElField) rs)
sequenceRecFold = Rec (FoldRecord record Maybe (Maybe :. ElField) as) rs
-> Fold
     (record (Maybe :. ElField) as) (record (Maybe :. 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)
FG.sequenceRecFold --V.rtraverse unFoldRecord
{-# INLINABLE sequenceRecFold #-}

-- | turn a record of endo-folds over each field, into a fold over records 
sequenceEndoFolds
  :: forall rs record
   . ( V.RApply rs
     , V.RPureConstrained V.KnownField rs
     , FG.EndoFieldFoldsToRecordFolds rs record Maybe
     , MG.IsoRec rs record Maybe
     )
  => F.Rec (FG.FoldEndo Maybe) rs
  -> FL.Fold (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
sequenceEndoFolds :: Rec (FoldEndo Maybe) rs
-> Fold
     (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
sequenceEndoFolds = Rec (FoldEndo Maybe) rs
-> Fold
     (record (Maybe :. ElField) rs) (record (Maybe :. 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)
FG.sequenceEndoFolds --sequenceFieldEndoFolds . 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
     , FG.EndoFieldFoldsToRecordFolds rs record Maybe
     , MG.IsoRec rs record Maybe
     )
  => (forall a . FL.Fold a a)
  -> FL.Fold (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
foldAll :: (forall a. Fold a a)
-> Fold
     (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
foldAll = (forall a. Fold a a)
-> Fold
     (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(RPureConstrained KnownField rs, RApply rs,
 EndoFieldFoldsToRecordFolds rs record f, IsoRec rs record f,
 Functor f) =>
(forall a. Fold a a)
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
FG.foldAll
{-# INLINABLE foldAll #-}

-- | 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
   . ( V.RPureConstrained (FG.ConstrainedField c) rs
     , V.RPureConstrained V.KnownField rs
     , V.RApply rs
     , FG.EndoFieldFoldsToRecordFolds rs record Maybe
     , MG.IsoRec rs record Maybe
     )
  => (forall a . c a => FL.Fold a a)
  -> FL.Fold (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
foldAllConstrained :: (forall a. c a => Fold a a)
-> Fold
     (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
foldAllConstrained = (forall x. Maybe x -> Maybe x)
-> (forall a. c a => Fold a a)
-> Fold
     (record (Maybe :. ElField) rs) (record (Maybe :. 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)
FG.foldAllConstrained @c forall a. a -> a
forall x. Maybe x -> Maybe x
id
{-# INLINABLE foldAllConstrained #-}

maybeFoldAllConstrained
  :: forall c rs record
   . ( V.RPureConstrained (FG.ConstrainedField c) rs
     , V.RPureConstrained V.KnownField rs
     , V.RApply rs
     , FG.EndoFieldFoldsToRecordFolds rs record Maybe
     , MG.IsoRec rs record Maybe
     )
  => (forall a . c a => FL.Fold (Maybe a) (Maybe a))
  -> FL.Fold (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
maybeFoldAllConstrained :: (forall a. c a => Fold (Maybe a) (Maybe a))
-> Fold
     (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
maybeFoldAllConstrained = forall (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. c a => Fold (f a) (f 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. c a => Fold (f a) (f a))
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
FG.functorFoldAllConstrained @c
{-# INLINABLE maybeFoldAllConstrained #-}

-- | 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
   . ( V.RPureConstrained (FG.ConstrainedField (MonoidalField g)) rs
     , V.RPureConstrained V.KnownField rs
     , V.RApply rs
     , FG.EndoFieldFoldsToRecordFolds rs record Maybe
     , MG.IsoRec rs record Maybe
     )
  => FL.Fold (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
foldAllMonoid :: Fold (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
foldAllMonoid = (forall x. Maybe x -> Maybe x)
-> Fold
     (record (Maybe :. ElField) rs) (record (Maybe :. ElField) rs)
forall (g :: * -> *) (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(RPureConstrained (ConstrainedField (MonoidalField g)) rs,
 RPureConstrained KnownField rs, RApply rs,
 EndoFieldFoldsToRecordFolds rs record f, IsoRec rs record f,
 Applicative f) =>
(forall a. f a -> Maybe a)
-> Fold (record (f :. ElField) rs) (record (f :. ElField) rs)
FG.foldAllMonoid @g forall a. a -> a
forall x. Maybe x -> Maybe x
id
{-# INLINABLE foldAllMonoid #-}