Maybe.hs

{-# 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 = 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 = FG.recFieldF 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 = FG.fieldToFieldFold @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 = 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 = 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 = 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 = FG.foldAllConstrained @c 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 = 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 = FG.foldAllMonoid @g id
{-# INLINABLE foldAllMonoid #-}