{-# LANGUAGE CPP #-}
{-# 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
, splitOnData
, 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 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
#if MIN_VERSION_base(4,16,0)
import GHC.Generics (Generic, Rep)
import Data.Hashable.Generic as Hash
#endif
#if MIN_VERSION_base(4,16,0)
instance (Generic (V.Rec V.ElField rs), Eq (V.Rec V.ElField rs), Hash.GHashable Hash.Zero (Rep (V.Rec V.ElField rs))) => Hash.Hashable (V.Rec V.ElField rs) where
hashWithSalt :: Int -> Rec ElField rs -> Int
hashWithSalt = forall a. (Generic a, GHashable Zero (Rep a)) => Int -> a -> Int
Hash.genericHashWithSalt
{-# INLINEABLE hashWithSalt #-}
#else
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 #-}
#endif
unpackFilterRow
:: (F.Record rs -> Bool) -> MR.Unpack (F.Record rs) (F.Record rs)
unpackFilterRow :: forall (rs :: [(Symbol, *)]).
(Record rs -> Bool) -> Unpack (Record rs) (Record rs)
unpackFilterRow Record rs -> Bool
test = forall x. (x -> Bool) -> Unpack x x
MR.Filter Record rs -> Bool
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 :: forall (t :: (Symbol, *)) (rs :: [(Symbol, *)]).
(KnownField t, ElemOf rs t) =>
(Snd t -> Bool) -> Unpack (Record rs) (Record rs)
unpackFilterOnField Snd t -> Bool
test = forall (rs :: [(Symbol, *)]).
(Record rs -> Bool) -> Unpack (Record rs) (Record rs)
unpackFilterRow (Snd t -> Bool
test forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (Symbol, *)) (s :: Symbol) a (rs :: [(Symbol, *)]).
(t ~ '(s, a), t ∈ rs) =>
Record rs -> a
F.rgetField @t)
unpackGoodRows
:: forall cs rs
. (cs F.⊆ rs)
=> MR.Unpack (F.Rec (Maybe F.:. F.ElField) rs) (F.Record cs)
unpackGoodRows :: forall (cs :: [(Symbol, *)]) (rs :: [(Symbol, *)]).
(cs ⊆ rs) =>
Unpack (Rec (Maybe :. ElField) rs) (Record cs)
unpackGoodRows = forall (g :: * -> *) x y. Traversable g => (x -> g y) -> Unpack x y
MR.Unpack forall a b. (a -> b) -> a -> b
$ forall (cs :: [(Symbol, *)]).
Rec (Maybe :. ElField) cs -> Maybe (Record cs)
F.recMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (rs :: [k1]) (ss :: [k1]) (f :: k2 -> *)
(record :: (k2 -> *) -> [k1] -> *) (is :: [Nat]).
(RecSubset record rs ss is, RecSubsetFCtx record f) =>
record f ss -> record f rs
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 :: forall (ks :: [(Symbol, *)]) (cs :: [(Symbol, *)])
(rs :: [(Symbol, *)]).
(ks ⊆ rs, cs ⊆ rs) =>
Assign (Record ks) (Record rs) (Record cs)
assignKeysAndData = forall k y c. (y -> k) -> (y -> c) -> Assign k y c
MR.assign (forall {k1} {k2} (rs :: [k1]) (ss :: [k1]) (f :: k2 -> *)
(record :: (k2 -> *) -> [k1] -> *) (is :: [Nat]).
(RecSubset record rs ss is, RecSubsetFCtx record f) =>
record f ss -> record f rs
F.rcast @ks) (forall {k1} {k2} (rs :: [k1]) (ss :: [k1]) (f :: k2 -> *)
(record :: (k2 -> *) -> [k1] -> *) (is :: [Nat]).
(RecSubset record rs ss is, RecSubsetFCtx record f) =>
record f ss -> record f rs
F.rcast @cs)
{-# INLINABLE assignKeysAndData #-}
assignKeys
:: forall ks rs
. (ks F.⊆ rs)
=> MR.Assign (F.Record ks) (F.Record rs) (F.Record rs)
assignKeys :: forall (ks :: [(Symbol, *)]) (rs :: [(Symbol, *)]).
(ks ⊆ rs) =>
Assign (Record ks) (Record rs) (Record rs)
assignKeys = forall k y c. (y -> k) -> (y -> c) -> Assign k y c
MR.assign (forall {k1} {k2} (rs :: [k1]) (ss :: [k1]) (f :: k2 -> *)
(record :: (k2 -> *) -> [k1] -> *) (is :: [Nat]).
(RecSubset record rs ss is, RecSubsetFCtx record f) =>
record f ss -> record f rs
F.rcast @ks) forall a. a -> a
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 :: forall (ks :: [(Symbol, *)]) (rs :: [(Symbol, *)])
(cs :: [(Symbol, *)]).
(ks ⊆ rs, cs ~ RDeleteAll ks rs, cs ⊆ rs) =>
Assign (Record ks) (Record rs) (Record cs)
splitOnKeys = forall (ks :: [(Symbol, *)]) (cs :: [(Symbol, *)])
(rs :: [(Symbol, *)]).
(ks ⊆ rs, cs ⊆ rs) =>
Assign (Record ks) (Record rs) (Record cs)
assignKeysAndData @ks @cs
{-# INLINABLE splitOnKeys #-}
splitOnData
:: forall cs rs ks
. (cs F.⊆ rs, ks ~ F.RDeleteAll cs rs, ks F.⊆ rs)
=> MR.Assign (F.Record ks) (F.Record rs) (F.Record cs)
splitOnData :: forall (cs :: [(Symbol, *)]) (rs :: [(Symbol, *)])
(ks :: [(Symbol, *)]).
(cs ⊆ rs, ks ~ RDeleteAll cs rs, ks ⊆ rs) =>
Assign (Record ks) (Record rs) (Record cs)
splitOnData = forall (ks :: [(Symbol, *)]) (cs :: [(Symbol, *)])
(rs :: [(Symbol, *)]).
(ks ⊆ rs, cs ⊆ rs) =>
Assign (Record ks) (Record rs) (Record cs)
assignKeysAndData @ks @cs
{-# INLINABLE splitOnData #-}
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 :: forall (ks :: [(Symbol, *)]) (cs :: [(Symbol, *)]) x.
RecVec (ks ++ cs) =>
(forall (h :: * -> *). Foldable h => h x -> Record cs)
-> Reduce (Record ks) x (FrameRec (ks ++ cs))
reduceAndAddKey forall (h :: * -> *). Foldable h => h x -> Record cs
process =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) (rs :: [(Symbol, *)]).
(Foldable f, RecVec rs) =>
f (Record rs) -> Frame (Record rs)
F.toFrame forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure @[]) forall a b. (a -> b) -> a -> b
$ forall x y k z.
(forall (h :: * -> *). (Foldable h, Functor h) => h x -> y)
-> (k -> y -> z) -> Reduce k x z
MR.processAndLabel forall (h :: * -> *). Foldable h => h x -> Record cs
process forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
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 :: forall (ks :: [(Symbol, *)]) (cs :: [(Symbol, *)]) x.
RecVec (ks ++ cs) =>
Fold x (Record cs) -> Reduce (Record ks) x (FrameRec (ks ++ cs))
foldAndAddKey Fold x (Record cs)
fld = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) (rs :: [(Symbol, *)]).
(Foldable f, RecVec rs) =>
f (Record rs) -> Frame (Record rs)
F.toFrame forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure @[]) forall a b. (a -> b) -> a -> b
$ forall x y k z. Fold x y -> (k -> y -> z) -> Reduce k x z
MR.foldAndLabel Fold x (Record cs)
fld forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
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 :: forall (g :: * -> *) (ks :: [(Symbol, *)]) (as :: [(Symbol, *)]) y
x.
(Functor g, Foldable g, RecVec (ks ++ as)) =>
(y -> Record as)
-> Reduce (Record ks) x (g y)
-> Reduce (Record ks) x (FrameRec (ks ++ as))
makeRecsWithKey y -> Record as
makeRec Reduce (Record ks) x (g y)
reduceToY = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) (rs :: [(Symbol, *)]).
(Foldable f, RecVec rs) =>
f (Record rs) -> Frame (Record rs)
F.toFrame
forall a b. (a -> b) -> a -> b
$ forall k y z x. (k -> y -> z) -> Reduce k x y -> Reduce k x z
MR.reduceMapWithKey Record ks -> g y -> g (Record (ks ++ as))
addKey Reduce (Record ks) x (g y)
reduceToY
where addKey :: Record ks -> g y -> g (Record (ks ++ as))
addKey Record ks
k = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
V.rappend Record ks
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. y -> Record as
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 :: forall (m :: * -> *) (g :: * -> *) (ks :: [(Symbol, *)])
(as :: [(Symbol, *)]) y x.
(Monad m, Functor g, Foldable g, RecVec (ks ++ as)) =>
(y -> Record as)
-> ReduceM m (Record ks) x (g y)
-> ReduceM m (Record ks) x (FrameRec (ks ++ as))
makeRecsWithKeyM y -> Record as
makeRec ReduceM m (Record ks) x (g y)
reduceToY = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) (rs :: [(Symbol, *)]).
(Foldable f, RecVec rs) =>
f (Record rs) -> Frame (Record rs)
F.toFrame
forall a b. (a -> b) -> a -> b
$ forall k y z (m :: * -> *) x.
(k -> y -> z) -> ReduceM m k x y -> ReduceM m k x z
MR.reduceMMapWithKey Record ks -> g y -> g (Record (ks ++ as))
addKey ReduceM m (Record ks) x (g y)
reduceToY
where addKey :: Record ks -> g y -> g (Record (ks ++ as))
addKey Record ks
k = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
V.rappend Record ks
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. y -> Record as
makeRec)
{-# INLINABLE makeRecsWithKeyM #-}