{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE InstanceSigs #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Frames.MapReduce
(
unpackFilterRow
, unpackFilterOnField
, unpackGoodRows
, assignKeysAndData
, assignKeys
, splitOnKeys
, reduceAndAddKey
, foldAndAddKey
, makeRecsWithKey
, makeRecsWithKeyM
, module Control.MapReduce
)
where
import qualified Control.MapReduce as MR
import Control.MapReduce
import qualified Control.Foldl as FL
import qualified Data.Hashable as Hash
import Data.Hashable ( Hashable )
import qualified Frames as F
import qualified Frames.Melt as F
import qualified Frames.InCore as FI
import qualified Data.Vinyl as V
import qualified Data.Vinyl.TypeLevel as V
instance Hash.Hashable (F.Record '[]) where
hash = const 0
{-# INLINABLE hash #-}
hashWithSalt s = const s
{-# INLINABLE hashWithSalt #-}
instance (V.KnownField t, Hash.Hashable (V.Snd t), Hash.Hashable (F.Record rs), rs F.⊆ (t ': rs)) => Hash.Hashable (F.Record (t ': rs)) where
hashWithSalt s r = s `Hash.hashWithSalt` (F.rgetField @t r) `Hash.hashWithSalt` (F.rcast @rs r)
{-# INLINABLE hashWithSalt #-}
unpackFilterRow
:: (F.Record rs -> Bool) -> MR.Unpack (F.Record rs) (F.Record rs)
unpackFilterRow test = MR.Filter test
unpackFilterOnField
:: forall t rs
. (V.KnownField t, F.ElemOf rs t)
=> (V.Snd t -> Bool)
-> MR.Unpack (F.Record rs) (F.Record rs)
unpackFilterOnField test = unpackFilterRow (test . F.rgetField @t)
unpackGoodRows
:: forall cs rs
. (cs F.⊆ rs)
=> MR.Unpack (F.Rec (Maybe F.:. F.ElField) rs) (F.Record cs)
unpackGoodRows = MR.Unpack $ F.recMaybe . F.rcast
assignKeysAndData
:: forall ks cs rs
. (ks F.⊆ rs, cs F.⊆ rs)
=> MR.Assign (F.Record ks) (F.Record rs) (F.Record cs)
assignKeysAndData = MR.assign (F.rcast @ks) (F.rcast @cs)
{-# INLINABLE assignKeysAndData #-}
assignKeys
:: forall ks rs
. (ks F.⊆ rs)
=> MR.Assign (F.Record ks) (F.Record rs) (F.Record rs)
assignKeys = MR.assign (F.rcast @ks) id
{-# INLINABLE assignKeys #-}
splitOnKeys
:: forall ks rs cs
. (ks F.⊆ rs, cs ~ F.RDeleteAll ks rs, cs F.⊆ rs)
=> MR.Assign (F.Record ks) (F.Record rs) (F.Record cs)
splitOnKeys = assignKeysAndData @ks @cs
{-# INLINABLE splitOnKeys #-}
reduceAndAddKey
:: forall ks cs x
. FI.RecVec ((ks V.++ cs))
=> (forall h . Foldable h => h x -> F.Record cs)
-> MR.Reduce (F.Record ks) x (F.FrameRec (ks V.++ cs))
reduceAndAddKey process =
fmap (F.toFrame . pure @[]) $ MR.processAndLabel process V.rappend
{-# INLINABLE reduceAndAddKey #-}
foldAndAddKey
:: (FI.RecVec ((ks V.++ cs)))
=> FL.Fold x (F.Record cs)
-> MR.Reduce (F.Record ks) x (F.FrameRec (ks V.++ cs))
foldAndAddKey fld = fmap (F.toFrame . pure @[]) $ MR.foldAndLabel fld V.rappend
{-# INLINABLE foldAndAddKey #-}
makeRecsWithKey
:: (Functor g, Foldable g, (FI.RecVec (ks V.++ as)))
=> (y -> F.Record as)
-> MR.Reduce (F.Record ks) x (g y)
-> MR.Reduce (F.Record ks) x (F.FrameRec (ks V.++ as))
makeRecsWithKey makeRec reduceToY = fmap F.toFrame
$ MR.reduceMapWithKey addKey reduceToY
where addKey k = fmap (V.rappend k . makeRec)
{-# INLINABLE makeRecsWithKey #-}
makeRecsWithKeyM
:: (Monad m, Functor g, Foldable g, (FI.RecVec (ks V.++ as)))
=> (y -> F.Record as)
-> MR.ReduceM m (F.Record ks) x (g y)
-> MR.ReduceM m (F.Record ks) x (F.FrameRec (ks V.++ as))
makeRecsWithKeyM makeRec reduceToY = fmap F.toFrame
$ MR.reduceMMapWithKey addKey reduceToY
where addKey k = fmap (V.rappend k . makeRec)
{-# INLINABLE makeRecsWithKeyM #-}