{-# LANGUAGE AllowAmbiguousTypes   #-}
{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE InstanceSigs          #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PolyKinds             #-}
{-# LANGUAGE RankNTypes            #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeApplications      #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Frames.MapReduce.General where

import qualified Control.MapReduce             as MR

import qualified Control.Foldl                 as FL
import qualified Data.Hashable                 as Hash
import           Data.Kind                      ( Type )
import           GHC.TypeLits                   ( Symbol )

import           Frames                         ( (:.) )
import qualified Frames.Melt                   as F
import qualified Data.Vinyl                    as V
import           Data.Vinyl                     ( ElField )
import qualified Data.Vinyl.Functor            as V
import qualified Data.Vinyl.TypeLevel          as V
import qualified Data.Vinyl.SRec               as V
import qualified Data.Vinyl.ARec               as V
import qualified Foreign.Storable              as FS

class RecGetFieldC t record f rs where
  rgetF ::  ( V.KnownField t
            , F.ElemOf rs t
            ) => record (f :. ElField) rs -> (f :. ElField) t
  rgetFieldF :: ( V.KnownField t
                , Functor f
                , F.ElemOf rs t
                ) => record (f :. ElField) rs -> f (V.Snd t)
  rgetFieldF = (ElField '(Fst t, Snd t) -> Snd t)
-> f (ElField '(Fst t, Snd t)) -> f (Snd t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ElField '(Fst t, Snd t) -> Snd t
forall (s :: Symbol) t. ElField '(s, t) -> t
V.getField (f (ElField '(Fst t, Snd t)) -> f (Snd t))
-> (record (f :. ElField) rs -> f (ElField '(Fst t, Snd t)))
-> record (f :. ElField) rs
-> f (Snd t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose f ElField t -> f (ElField t)
forall l (f :: l -> *) k (g :: k -> l) (x :: k).
Compose f g x -> f (g x)
V.getCompose (Compose f ElField t -> f (ElField t))
-> (record (f :. ElField) rs -> Compose f ElField t)
-> record (f :. ElField) rs
-> f (ElField t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RecGetFieldC t record f rs, KnownField t, ElemOf rs t) =>
record (f :. ElField) rs -> Compose f ElField t
forall (t :: (Symbol, *))
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *)
       (rs :: [(Symbol, *)]).
(RecGetFieldC t record f rs, KnownField t, ElemOf rs t) =>
record (f :. ElField) rs -> Compose f ElField t
rgetF @t @record @f @rs

instance RecGetFieldC t V.Rec f rs where
  rgetF :: Rec (f :. ElField) rs -> (:.) f ElField t
rgetF = forall (rs :: [(Symbol, *)]) (f :: (Symbol, *) -> *)
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *).
(RecElem record t t rs rs (RIndex t rs), RecElemFCtx record f) =>
record f rs -> f t
forall k (r :: k) (rs :: [k]) (f :: k -> *)
       (record :: (k -> *) -> [k] -> *).
(RecElem record r r rs rs (RIndex r rs), RecElemFCtx record f) =>
record f rs -> f r
V.rget @t

instance RecGetFieldC t V.ARec f rs where
  rgetF :: ARec (f :. ElField) rs -> (:.) f ElField t
rgetF = forall k (t :: k) (f :: k -> *) (ts :: [k]).
NatToInt (RIndex t ts) =>
ARec f ts -> f t
forall (f :: (Symbol, *) -> *) (ts :: [(Symbol, *)]).
NatToInt (RIndex t ts) =>
ARec f ts -> f t
V.aget @t

instance (V.FieldOffset (f :. ElField) rs t) => RecGetFieldC t V.SRec f rs where
  rgetF :: SRec (f :. ElField) rs -> (:.) f ElField t
rgetF = forall (ts :: [(Symbol, *)]).
FieldOffset (f :. ElField) ts t =>
SRec2 (f :. ElField) (f :. ElField) ts -> (:.) f ElField t
forall k (f :: k -> *) (t :: k) (ts :: [k]).
FieldOffset f ts t =>
SRec2 f f ts -> f t
V.sget @_ @t (SRec2 (f :. ElField) (f :. ElField) rs -> (:.) f ElField t)
-> (SRec (f :. ElField) rs
    -> SRec2 (f :. ElField) (f :. ElField) rs)
-> SRec (f :. ElField) rs
-> (:.) f ElField t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SRec (f :. ElField) rs -> SRec2 (f :. ElField) (f :. ElField) rs
forall k (f :: k -> *) (ts :: [k]). SRec f ts -> SRec2 f f ts
V.getSRecNT --srecGetField @t @f @rs

class RCastC rs ss record f  where
  rcastF :: record (f :. ElField) ss -> record (f :. ElField) rs

instance V.RecSubset V.Rec rs ss (V.RImage rs ss) => RCastC rs ss V.Rec f where
  rcastF :: Rec (f :. ElField) ss -> Rec (f :. ElField) rs
rcastF = Rec (f :. ElField) ss -> Rec (f :. ElField) rs
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
V.rcast

instance (V.IndexWitnesses (V.RImage rs ss), V.NatToInt (V.RLength rs)) => RCastC rs ss V.ARec f where
  rcastF :: ARec (f :. ElField) ss -> ARec (f :. ElField) rs
rcastF = ARec (f :. ElField) ss -> ARec (f :. ElField) rs
forall k (rs :: [k]) (ss :: [k]) (f :: k -> *).
(IndexWitnesses (RImage rs ss), NatToInt (RLength rs)) =>
ARec f ss -> ARec f rs
V.arecGetSubset

instance (V.RPureConstrained (V.FieldOffset (f :. ElField) ss) rs
         , V.RPureConstrained (V.FieldOffset (f :. ElField) rs) rs
         , V.RFoldMap rs
         , V.RMap rs
         , V.RApply rs
         , FS.Storable (V.Rec (f :. ElField) rs)) =>  RCastC rs ss V.SRec f where
  rcastF :: SRec (f :. ElField) ss -> SRec (f :. ElField) rs
rcastF = SRec2 (f :. ElField) (f :. ElField) rs -> SRec (f :. ElField) rs
forall k (f :: k -> *) (ts :: [k]). SRec2 f f ts -> SRec f ts
V.SRecNT (SRec2 (f :. ElField) (f :. ElField) rs -> SRec (f :. ElField) rs)
-> (SRec (f :. ElField) ss
    -> SRec2 (f :. ElField) (f :. ElField) rs)
-> SRec (f :. ElField) ss
-> SRec (f :. ElField) rs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SRec2 (f :. ElField) (f :. ElField) ss
-> SRec2 (f :. ElField) (f :. ElField) rs
forall u (ss :: [u]) (rs :: [u]) (f :: u -> *).
(RPureConstrained (FieldOffset f ss) rs,
 RPureConstrained (FieldOffset f rs) rs, RFoldMap rs, RMap rs,
 RApply rs, Storable (Rec f rs)) =>
SRec2 f f ss -> SRec2 f f rs
V.srecGetSubset (SRec2 (f :. ElField) (f :. ElField) ss
 -> SRec2 (f :. ElField) (f :. ElField) rs)
-> (SRec (f :. ElField) ss
    -> SRec2 (f :. ElField) (f :. ElField) ss)
-> SRec (f :. ElField) ss
-> SRec2 (f :. ElField) (f :. ElField) rs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SRec (f :. ElField) ss -> SRec2 (f :. ElField) (f :. ElField) ss
forall k (f :: k -> *) (ts :: [k]). SRec f ts -> SRec2 f f ts
V.getSRecNT

class IsoRec rs record f where
  toRec :: record (f :. ElField) rs -> V.Rec (f :. ElField) rs
  fromRec :: V.Rec (f :. ElField) rs -> record (f :. ElField) rs

instance IsoRec rs V.Rec f where
  toRec :: Rec (f :. ElField) rs -> Rec (f :. ElField) rs
toRec = Rec (f :. ElField) rs -> Rec (f :. ElField) rs
forall a. a -> a
id
  fromRec :: Rec (f :. ElField) rs -> Rec (f :. ElField) rs
fromRec = Rec (f :. ElField) rs -> Rec (f :. ElField) rs
forall a. a -> a
id

instance FS.Storable (V.Rec (f :. ElField) rs) => IsoRec rs V.SRec f where
  toRec :: SRec (f :. ElField) rs -> Rec (f :. ElField) rs
toRec = SRec (f :. ElField) rs -> Rec (f :. ElField) rs
forall u (f :: u -> *) (ts :: [u]).
Storable (Rec f ts) =>
SRec f ts -> Rec f ts
V.fromSRec
  fromRec :: Rec (f :. ElField) rs -> SRec (f :. ElField) rs
fromRec = Rec (f :. ElField) rs -> SRec (f :. ElField) rs
forall k (f :: k -> *) (ts :: [k]).
Storable (Rec f ts) =>
Rec f ts -> SRec f ts
V.toSRec


instance (V.NatToInt (V.RLength rs)
         , V.RecApplicative rs
         , V.RPureConstrained (V.IndexableField rs) rs) => IsoRec rs V.ARec f where
  toRec :: ARec (f :. ElField) rs -> Rec (f :. ElField) rs
toRec = ARec (f :. ElField) rs -> Rec (f :. ElField) rs
forall u (f :: u -> *) (ts :: [u]).
(RecApplicative ts, RPureConstrained (IndexableField ts) ts) =>
ARec f ts -> Rec f ts
V.fromARec
  fromRec :: Rec (f :. ElField) rs -> ARec (f :. ElField) rs
fromRec = Rec (f :. ElField) rs -> ARec (f :. ElField) rs
forall k (f :: k -> *) (ts :: [k]).
NatToInt (RLength ts) =>
Rec f ts -> ARec f ts
V.toARec

isoRecAppend
  :: forall f record (as :: [(Symbol, Type)]) bs
   . (IsoRec as record f, IsoRec bs record f, IsoRec (as V.++ bs) record f)
  => record (f :. ElField) as
  -> record (f :. ElField) bs
  -> record (f :. ElField) (as V.++ bs)
isoRecAppend :: record (f :. ElField) as
-> record (f :. ElField) bs -> record (f :. ElField) (as ++ bs)
isoRecAppend record (f :. ElField) as
lhs record (f :. ElField) bs
rhs =
  IsoRec (as ++ bs) record f =>
Rec (f :. ElField) (as ++ bs) -> record (f :. ElField) (as ++ bs)
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
Rec (f :. ElField) rs -> record (f :. ElField) rs
fromRec @(as V.++ bs) @record @f
    (Rec (f :. ElField) (as ++ bs) -> record (f :. ElField) (as ++ bs))
-> Rec (f :. ElField) (as ++ bs)
-> record (f :. ElField) (as ++ bs)
forall a b. (a -> b) -> a -> b
$           (record (f :. ElField) as -> Rec (f :. ElField) as
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec @as @record @f record (f :. ElField) as
lhs)
    Rec (f :. ElField) as
-> Rec (f :. ElField) bs -> Rec (f :. ElField) (as ++ bs)
forall k (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
`V.rappend` (record (f :. ElField) bs -> Rec (f :. ElField) bs
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec @bs @record @f record (f :. ElField) bs
rhs)

-- | This is only here so we can use hash maps for the grouping step.  This should properly be in Frames itself.
instance Hash.Hashable (record (f :. ElField)  '[]) where
  hash :: record (f :. ElField) '[] -> Int
hash = Int -> record (f :. ElField) '[] -> Int
forall a b. a -> b -> a
const Int
0
  {-# INLINABLE hash #-}
  hashWithSalt :: Int -> record (f :. ElField) '[] -> Int
hashWithSalt Int
s = Int -> record (f :. ElField) '[] -> Int
forall a b. a -> b -> a
const Int
s -- TODO: this seems BAD! Or not?
  {-# INLINABLE hashWithSalt #-}

instance (V.KnownField t
         , Functor f
         , RecGetFieldC t record f (t ': rs)
         , RCastC rs (t ': rs) record f
         , Hash.Hashable (f (V.Snd t))
         , Hash.Hashable (record (f :. ElField) rs)
         ) => Hash.Hashable (record (f :. ElField) (t ': rs)) where
  hashWithSalt :: Int -> record (f :. ElField) (t : rs) -> Int
hashWithSalt Int
s record (f :. ElField) (t : rs)
r = Int
s Int -> f (Snd t) -> Int
forall a. Hashable a => Int -> a -> Int
`Hash.hashWithSalt` (record (f :. ElField) (t : rs) -> f (Snd t)
forall (t :: (Symbol, *))
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *)
       (rs :: [(Symbol, *)]).
(RecGetFieldC t record f rs, KnownField t, Functor f,
 ElemOf rs t) =>
record (f :. ElField) rs -> f (Snd t)
rgetFieldF @t record (f :. ElField) (t : rs)
r) Int -> record (f :. ElField) rs -> Int
forall a. Hashable a => Int -> a -> Int
`Hash.hashWithSalt` (record (f :. ElField) (t : rs) -> record (f :. ElField) rs
forall k (rs :: k) (ss :: k)
       (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *).
RCastC rs ss record f =>
record (f :. ElField) ss -> record (f :. ElField) rs
rcastF @rs record (f :. ElField) (t : rs)
r)
  {-# INLINABLE hashWithSalt #-}

-- | Don't do anything 
unpackNoOp :: MR.Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackNoOp :: Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackNoOp = (record (f :. ElField) rs -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
forall x. (x -> Bool) -> Unpack x x
MR.Filter (Bool -> record (f :. ElField) rs -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | Filter records using a function on the entire record. 
unpackFilterRow
  :: (record (f :. ElField) rs -> Bool)
  -> MR.Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackFilterRow :: (record (f :. ElField) rs -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackFilterRow record (f :. ElField) rs -> Bool
test = (record (f :. ElField) rs -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
forall x. (x -> Bool) -> Unpack x x
MR.Filter record (f :. ElField) rs -> Bool
test

-- | Filter records based on a condition on only one field in the row.  Will usually require a Type Application to indicate which field.
unpackFilterOnField
  :: forall t rs record f
   . (Functor f, V.KnownField t, F.ElemOf rs t, RecGetFieldC t record f rs)
  => (f (V.Snd t) -> Bool)
  -> MR.Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackFilterOnField :: (f (Snd t) -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackFilterOnField f (Snd t) -> Bool
test = (record (f :. ElField) rs -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
forall k (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *)
       (rs :: k).
(record (f :. ElField) rs -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackFilterRow (f (Snd t) -> Bool
test (f (Snd t) -> Bool)
-> (record (f :. ElField) rs -> f (Snd t))
-> record (f :. ElField) rs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (Symbol, *))
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *)
       (rs :: [(Symbol, *)]).
(RecGetFieldC t record f rs, KnownField t, Functor f,
 ElemOf rs t) =>
record (f :. ElField) rs -> f (Snd t)
forall (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *)
       (f :: * -> *) (rs :: [(Symbol, *)]).
(RecGetFieldC t record f rs, KnownField t, Functor f,
 ElemOf rs t) =>
record (f :. ElField) rs -> f (Snd t)
rgetFieldF @t)

unpackFilterOnGoodField
  :: forall t rs record f
   . (Functor f, V.KnownField t, F.ElemOf rs t, RecGetFieldC t record f rs)
  => (forall a . f a -> Maybe a)
  -> (V.Snd t -> Bool)
  -> MR.Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackFilterOnGoodField :: (forall a. f a -> Maybe a)
-> (Snd t -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackFilterOnGoodField forall a. f a -> Maybe a
toMaybe Snd t -> Bool
testValue =
  let test' :: f (Snd t) -> Bool
test' = (Bool -> (Snd t -> Bool) -> Maybe (Snd t) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Snd t -> Bool
testValue) (Maybe (Snd t) -> Bool)
-> (f (Snd t) -> Maybe (Snd t)) -> f (Snd t) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f (Snd t) -> Maybe (Snd t)
forall a. f a -> Maybe a
toMaybe in (f (Snd t) -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
forall (t :: (Symbol, *)) (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(Functor f, KnownField t, ElemOf rs t,
 RecGetFieldC t record f rs) =>
(f (Snd t) -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackFilterOnField @t f (Snd t) -> Bool
test'

-- | An unpack step which specifies a subset of columns, cs,
-- (via a type-application) and then filters a @record (Maybe :. Elfield) rs@
-- to only rows which have all good data in that subset.
unpackGoodRows
  :: forall cs rs record f
   . (RCastC cs rs record f)
  => (record (f :. ElField) cs -> Bool)
  -> MR.Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackGoodRows :: (record (f :. ElField) cs -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackGoodRows record (f :. ElField) cs -> Bool
testSubset = (record (f :. ElField) rs -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
forall k (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *)
       (rs :: k).
(record (f :. ElField) rs -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackFilterRow (record (f :. ElField) cs -> Bool
testSubset (record (f :. ElField) cs -> Bool)
-> (record (f :. ElField) rs -> record (f :. ElField) cs)
-> record (f :. ElField) rs
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (ss :: k) (record :: ((Symbol, *) -> *) -> k -> *)
       (f :: * -> *).
RCastC cs ss record f =>
record (f :. ElField) ss -> record (f :. ElField) cs
forall k (rs :: k) (ss :: k)
       (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *).
RCastC rs ss record f =>
record (f :. ElField) ss -> record (f :. ElField) rs
rcastF @cs)

-- | Assign both keys and data cols.  Uses type applications to specify them if they cannot be inferred.
-- Keys usually can't. Data sometimes can.
assignKeysAndData
  :: forall ks cs rs record f
   . (RCastC ks rs record f, RCastC cs rs record f)
  => MR.Assign
       (record (f :. ElField) ks)
       (record (f :. ElField) rs)
       (record (f :. ElField) cs)
assignKeysAndData :: Assign
  (record (f :. ElField) ks)
  (record (f :. ElField) rs)
  (record (f :. ElField) cs)
assignKeysAndData = (record (f :. ElField) rs -> record (f :. ElField) ks)
-> (record (f :. ElField) rs -> record (f :. ElField) cs)
-> Assign
     (record (f :. ElField) ks)
     (record (f :. ElField) rs)
     (record (f :. ElField) cs)
forall k y c. (y -> k) -> (y -> c) -> Assign k y c
MR.assign (forall (ss :: k) (record :: ((Symbol, *) -> *) -> k -> *)
       (f :: * -> *).
RCastC ks ss record f =>
record (f :. ElField) ss -> record (f :. ElField) ks
forall k (rs :: k) (ss :: k)
       (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *).
RCastC rs ss record f =>
record (f :. ElField) ss -> record (f :. ElField) rs
rcastF @ks) (forall (ss :: k) (record :: ((Symbol, *) -> *) -> k -> *)
       (f :: * -> *).
RCastC cs ss record f =>
record (f :. ElField) ss -> record (f :. ElField) cs
forall k (rs :: k) (ss :: k)
       (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *).
RCastC rs ss record f =>
record (f :. ElField) ss -> record (f :. ElField) rs
rcastF @cs)
{-# INLINABLE assignKeysAndData #-}

-- | Assign keys and leave the rest of the columns, excluding the keys, in the data passed to reduce.
splitOnKeys
  :: forall ks rs cs record f
   . (RCastC ks rs record f, RCastC cs rs record f, cs ~ F.RDeleteAll ks rs)
  => MR.Assign
       (record (f :. ElField) ks)
       (record (f :. ElField) rs)
       (record (f :. ElField) cs)
splitOnKeys :: Assign
  (record (f :. ElField) ks)
  (record (f :. ElField) rs)
  (record (f :. ElField) cs)
splitOnKeys = forall (rs :: [a]) (record :: ((Symbol, *) -> *) -> [a] -> *)
       (f :: * -> *).
(RCastC ks rs record f, RCastC cs rs record f) =>
Assign
  (record (f :. ElField) ks)
  (record (f :. ElField) rs)
  (record (f :. ElField) cs)
forall k (ks :: k) (cs :: k) (rs :: k)
       (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *).
(RCastC ks rs record f, RCastC cs rs record f) =>
Assign
  (record (f :. ElField) ks)
  (record (f :. ElField) rs)
  (record (f :. ElField) cs)
assignKeysAndData @ks @cs
{-# INLINABLE splitOnKeys #-}

-- | Assign data and leave the rest of the columns, excluding the data, as the keys.
splitOnData
  :: forall cs rs ks record f
   . (RCastC ks rs record f, RCastC cs rs record f, ks ~ F.RDeleteAll cs rs)
  => MR.Assign
       (record (f :. ElField) ks)
       (record (f :. ElField) rs)
       (record (f :. ElField) cs)
splitOnData :: Assign
  (record (f :. ElField) ks)
  (record (f :. ElField) rs)
  (record (f :. ElField) cs)
splitOnData = forall (rs :: [a]) (record :: ((Symbol, *) -> *) -> [a] -> *)
       (f :: * -> *).
(RCastC ks rs record f, RCastC cs rs record f) =>
Assign
  (record (f :. ElField) ks)
  (record (f :. ElField) rs)
  (record (f :. ElField) cs)
forall k (ks :: k) (cs :: k) (rs :: k)
       (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *).
(RCastC ks rs record f, RCastC cs rs record f) =>
Assign
  (record (f :. ElField) ks)
  (record (f :. ElField) rs)
  (record (f :. ElField) cs)
assignKeysAndData @ks @cs
{-# INLINABLE splitOnData #-}


-- | Assign keys and leave all columns, including the keys, in the data passed to reduce.
assignKeys
  :: forall ks rs record f
   . (RCastC ks rs record f)
  => MR.Assign
       (record (f :. ElField) ks)
       (record (f :. ElField) rs)
       (record (f :. ElField) rs)
assignKeys :: Assign
  (record (f :. ElField) ks)
  (record (f :. ElField) rs)
  (record (f :. ElField) rs)
assignKeys = (record (f :. ElField) rs -> record (f :. ElField) ks)
-> (record (f :. ElField) rs -> record (f :. ElField) rs)
-> Assign
     (record (f :. ElField) ks)
     (record (f :. ElField) rs)
     (record (f :. ElField) rs)
forall k y c. (y -> k) -> (y -> c) -> Assign k y c
MR.assign (forall (ss :: k) (record :: ((Symbol, *) -> *) -> k -> *)
       (f :: * -> *).
RCastC ks ss record f =>
record (f :. ElField) ss -> record (f :. ElField) ks
forall k (rs :: k) (ss :: k)
       (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *).
RCastC rs ss record f =>
record (f :. ElField) ss -> record (f :. ElField) rs
rcastF @ks) record (f :. ElField) rs -> record (f :. ElField) rs
forall a. a -> a
id
{-# INLINABLE assignKeys #-}

-- | Reduce the data to a single row and then re-attach the key.
-- | NB: for all but Rec case, this will have to convert record to Rec and back for the append
reduceAndAddKey
  :: forall ks cs x record f
   . (IsoRec ks record f, IsoRec cs record f, IsoRec (ks V.++ cs) record f)
  => (forall h . Foldable h => h x -> record (f :. ElField) cs) -- ^ reduction step
  -> MR.Reduce
       (record (f :. ElField) ks)
       x
       (record (f :. ElField) (ks V.++ cs))
reduceAndAddKey :: (forall (h :: * -> *).
 Foldable h =>
 h x -> record (f :. ElField) cs)
-> Reduce
     (record (f :. ElField) ks) x (record (f :. ElField) (ks ++ cs))
reduceAndAddKey forall (h :: * -> *). Foldable h => h x -> record (f :. ElField) cs
process =
  (forall (h :: * -> *).
 (Foldable h, Functor h) =>
 h x -> record (f :. ElField) cs)
-> (record (f :. ElField) ks
    -> record (f :. ElField) cs -> record (f :. ElField) (ks ++ cs))
-> Reduce
     (record (f :. ElField) ks) x (record (f :. ElField) (ks ++ cs))
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 (f :. ElField) cs
forall (h :: * -> *).
(Foldable h, Functor h) =>
h x -> record (f :. ElField) cs
process (\record (f :. ElField) ks
k record (f :. ElField) cs
y -> Rec (f :. ElField) (ks ++ cs) -> record (f :. ElField) (ks ++ cs)
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
Rec (f :. ElField) rs -> record (f :. ElField) rs
fromRec (record (f :. ElField) ks -> Rec (f :. ElField) ks
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec record (f :. ElField) ks
k Rec (f :. ElField) ks
-> Rec (f :. ElField) cs -> Rec (f :. ElField) (ks ++ cs)
forall k (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
`V.rappend` record (f :. ElField) cs -> Rec (f :. ElField) cs
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec record (f :. ElField) cs
y))
{-# INLINABLE reduceAndAddKey #-}

-- | Reduce by folding the data to a single row and then re-attaching the key.
foldAndAddKey
  :: (IsoRec ks record f, IsoRec cs record f, IsoRec (ks V.++ cs) record f)
  => FL.Fold x (record (f :. ElField) cs) -- ^ reduction fold
  -> MR.Reduce
       (record (f :. ElField) ks)
       x
       (record (f :. ElField) (ks V.++ cs))
foldAndAddKey :: Fold x (record (f :. ElField) cs)
-> Reduce
     (record (f :. ElField) ks) x (record (f :. ElField) (ks ++ cs))
foldAndAddKey Fold x (record (f :. ElField) cs)
fld =
  Fold x (record (f :. ElField) cs)
-> (record (f :. ElField) ks
    -> record (f :. ElField) cs -> record (f :. ElField) (ks ++ cs))
-> Reduce
     (record (f :. ElField) ks) x (record (f :. ElField) (ks ++ cs))
forall x y k z. Fold x y -> (k -> y -> z) -> Reduce k x z
MR.foldAndLabel Fold x (record (f :. ElField) cs)
fld (\record (f :. ElField) ks
k record (f :. ElField) cs
y -> Rec (f :. ElField) (ks ++ cs) -> record (f :. ElField) (ks ++ cs)
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
Rec (f :. ElField) rs -> record (f :. ElField) rs
fromRec (record (f :. ElField) ks -> Rec (f :. ElField) ks
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec record (f :. ElField) ks
k Rec (f :. ElField) ks
-> Rec (f :. ElField) cs -> Rec (f :. ElField) (ks ++ cs)
forall k (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
`V.rappend` record (f :. ElField) cs -> Rec (f :. ElField) cs
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec record (f :. ElField) cs
y))
{-# INLINABLE foldAndAddKey #-}

-- | Transform a reduce which produces a container of results, with a function from each result to a record,
-- into a reduce which produces a foldable (based on the original reduce) of the result records with the key re-attached.
makeRecsWithKey
  :: ( Functor g
     , Foldable g
     , IsoRec ks record f
     , IsoRec as record f
     , IsoRec (ks V.++ as) record f
     )
  => (y -> record (f :. ElField) as) -- ^ map a result to a record
  -> MR.Reduce (record (f :. ElField) ks) x (g y) -- ^ original reduce
  -> MR.Reduce
       (record (f :. ElField) ks)
       x
       (g (record (f :. ElField) (ks V.++ as)))
makeRecsWithKey :: (y -> record (f :. ElField) as)
-> Reduce (record (f :. ElField) ks) x (g y)
-> Reduce
     (record (f :. ElField) ks) x (g (record (f :. ElField) (ks ++ as)))
makeRecsWithKey y -> record (f :. ElField) as
makeRec Reduce (record (f :. ElField) ks) x (g y)
reduceToY = (record (f :. ElField) ks
 -> g y -> g (record (f :. ElField) (ks ++ as)))
-> Reduce (record (f :. ElField) ks) x (g y)
-> Reduce
     (record (f :. ElField) ks) x (g (record (f :. ElField) (ks ++ as)))
forall k y z x. (k -> y -> z) -> Reduce k x y -> Reduce k x z
MR.reduceMapWithKey record (f :. ElField) ks
-> g y -> g (record (f :. ElField) (ks ++ as))
addKey Reduce (record (f :. ElField) ks) x (g y)
reduceToY
 where
  addKey :: record (f :. ElField) ks
-> g y -> g (record (f :. ElField) (ks ++ as))
addKey record (f :. ElField) ks
k = (y -> record (f :. ElField) (ks ++ as))
-> g y -> g (record (f :. ElField) (ks ++ as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\y
y -> Rec (f :. ElField) (ks ++ as) -> record (f :. ElField) (ks ++ as)
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
Rec (f :. ElField) rs -> record (f :. ElField) rs
fromRec (Rec (f :. ElField) (ks ++ as) -> record (f :. ElField) (ks ++ as))
-> (record (f :. ElField) as -> Rec (f :. ElField) (ks ++ as))
-> record (f :. ElField) as
-> record (f :. ElField) (ks ++ as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (f :. ElField) ks
-> Rec (f :. ElField) as -> Rec (f :. ElField) (ks ++ as)
forall k (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
V.rappend (record (f :. ElField) ks -> Rec (f :. ElField) ks
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec record (f :. ElField) ks
k) (Rec (f :. ElField) as -> Rec (f :. ElField) (ks ++ as))
-> (record (f :. ElField) as -> Rec (f :. ElField) as)
-> record (f :. ElField) as
-> Rec (f :. ElField) (ks ++ as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record (f :. ElField) as -> Rec (f :. ElField) as
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec (record (f :. ElField) as -> record (f :. ElField) (ks ++ as))
-> record (f :. ElField) as -> record (f :. ElField) (ks ++ as)
forall a b. (a -> b) -> a -> b
$ y -> record (f :. ElField) as
makeRec y
y)
{-# INLINABLE makeRecsWithKey #-}

-- | Transform an effectful reduce which produces a container of results, with a function from each result to a record,
-- into a reduce which produces a foldable (based on the original reduce) of the result records with the key re-attached.
makeRecsWithKeyM
  :: ( Monad m
     , Functor g
     , Foldable g
     , IsoRec ks record f
     , IsoRec as record f
     , IsoRec (ks V.++ as) record f
     )
  => (y -> record (f :. ElField) as) -- ^ map a result to a record
  -> MR.ReduceM m (record (f :. ElField) ks) x (g y) -- ^ original reduce
  -> MR.ReduceM
       m
       (record (f :. ElField) ks)
       x
       (g (record (f :. ElField) (ks V.++ as)))
makeRecsWithKeyM :: (y -> record (f :. ElField) as)
-> ReduceM m (record (f :. ElField) ks) x (g y)
-> ReduceM
     m
     (record (f :. ElField) ks)
     x
     (g (record (f :. ElField) (ks ++ as)))
makeRecsWithKeyM y -> record (f :. ElField) as
makeRec ReduceM m (record (f :. ElField) ks) x (g y)
reduceToY = (record (f :. ElField) ks
 -> g y -> g (record (f :. ElField) (ks ++ as)))
-> ReduceM m (record (f :. ElField) ks) x (g y)
-> ReduceM
     m
     (record (f :. ElField) ks)
     x
     (g (record (f :. ElField) (ks ++ as)))
forall k y z (m :: * -> *) x.
(k -> y -> z) -> ReduceM m k x y -> ReduceM m k x z
MR.reduceMMapWithKey record (f :. ElField) ks
-> g y -> g (record (f :. ElField) (ks ++ as))
addKey ReduceM m (record (f :. ElField) ks) x (g y)
reduceToY
 where
  addKey :: record (f :. ElField) ks
-> g y -> g (record (f :. ElField) (ks ++ as))
addKey record (f :. ElField) ks
k = (y -> record (f :. ElField) (ks ++ as))
-> g y -> g (record (f :. ElField) (ks ++ as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\y
y -> Rec (f :. ElField) (ks ++ as) -> record (f :. ElField) (ks ++ as)
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
Rec (f :. ElField) rs -> record (f :. ElField) rs
fromRec (Rec (f :. ElField) (ks ++ as) -> record (f :. ElField) (ks ++ as))
-> (record (f :. ElField) as -> Rec (f :. ElField) (ks ++ as))
-> record (f :. ElField) as
-> record (f :. ElField) (ks ++ as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rec (f :. ElField) ks
-> Rec (f :. ElField) as -> Rec (f :. ElField) (ks ++ as)
forall k (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
V.rappend (record (f :. ElField) ks -> Rec (f :. ElField) ks
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec record (f :. ElField) ks
k) (Rec (f :. ElField) as -> Rec (f :. ElField) (ks ++ as))
-> (record (f :. ElField) as -> Rec (f :. ElField) as)
-> record (f :. ElField) as
-> Rec (f :. ElField) (ks ++ as)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. record (f :. ElField) as -> Rec (f :. ElField) as
forall (rs :: [(Symbol, *)])
       (record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec (record (f :. ElField) as -> record (f :. ElField) (ks ++ as))
-> record (f :. ElField) as -> record (f :. ElField) (ks ++ as)
forall a b. (a -> b) -> a -> b
$ y -> record (f :. ElField) as
makeRec y
y)
{-# INLINABLE makeRecsWithKeyM #-}