{-# 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 #-}