{-# 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
(
EndoFold
, FoldEndo(..)
, FoldRecord(..)
, toFoldRecord
, recFieldF
, fieldToFieldFold
, sequenceRecFold
, sequenceEndoFolds
, 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
toFoldRecord
:: (a -> g b)
-> FL.Fold (record (Maybe :. ElField) rs) a
-> FoldRecord record Maybe g rs b
toFoldRecord = FG.toFoldRecord
recFieldF
:: forall t rs a record
. V.KnownField t
=> FL.Fold a (V.Snd t)
-> (record (Maybe :. ElField) rs -> Maybe a)
-> FG.FoldRecord record Maybe (Maybe :. ElField) rs t
recFieldF = FG.recFieldF id
{-# INLINABLE recFieldF #-}
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)
-> FG.FoldRecord record Maybe (Maybe :. ElField) rs y
fieldToFieldFold = FG.fieldToFieldFold @x id
{-# INLINABLE fieldToFieldFold #-}
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
{-# INLINABLE sequenceRecFold #-}
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
{-# INLINABLE sequenceEndoFolds #-}
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 #-}
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 #-}
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 #-}