{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (s :: Symbol) t. ElField '(s, t) -> t
V.getField forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall l k (f :: l -> *) (g :: k -> l) (x :: k).
Compose f g x -> f (g x)
V.getCompose 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, ElemOf rs t) =>
record (f :. ElField) rs -> (:.) f ElField t
rgetF @t @record @f @rs
instance RecGetFieldC t V.Rec f rs where
rgetF :: (KnownField t, ElemOf rs t) =>
Rec (f :. ElField) rs -> (:.) f ElField t
rgetF = 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 :: (KnownField t, ElemOf rs t) =>
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
V.aget @t
instance (V.FieldOffset (f :. ElField) rs t) => RecGetFieldC t V.SRec f rs where
rgetF :: (KnownField t, ElemOf rs t) =>
SRec (f :. ElField) rs -> (:.) f ElField t
rgetF = forall {k} (f :: k -> *) (t :: k) (ts :: [k]).
FieldOffset f ts t =>
SRec2 f f ts -> f t
V.sget @_ @t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (ts :: [k]). SRec f ts -> SRec2 f f ts
V.getSRecNT
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 = 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 = 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 = forall {k} (f :: k -> *) (ts :: [k]). SRec2 f f ts -> SRec f ts
V.SRecNT forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. a -> a
id
fromRec :: Rec (f :. ElField) rs -> Rec (f :. ElField) rs
fromRec = 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 = 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 = 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
#if MIN_VERSION_vinyl(0,14,2)
, V.ToARec rs
#endif
) => IsoRec rs V.ARec f where
toRec :: ARec (f :. ElField) rs -> Rec (f :. ElField) rs
toRec = 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 = forall {k} (f :: k -> *) (ts :: [k]).
(NatToInt (RLength ts), ToARec 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 :: forall (f :: * -> *)
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *)
(as :: [(Symbol, *)]) (bs :: [(Symbol, *)]).
(IsoRec as record f, IsoRec bs record f,
IsoRec (as ++ bs) record f) =>
record (f :. ElField) as
-> record (f :. ElField) bs -> record (f :. ElField) (as ++ bs)
isoRecAppend record (f :. ElField) as
lhs record (f :. ElField) bs
rhs =
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
forall a b. (a -> b) -> a -> b
$ (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)
forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
`V.rappend` (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)
#if MIN_VERSION_hashable(1,4,0)
instance Eq (record (f :. ElField) '[]) => Hash.Hashable (record (f :. ElField) '[]) where
#else
instance Hash.Hashable (record (f :. ElField) '[]) where
#endif
hash :: record (f :. ElField) '[] -> Int
hash = forall a b. a -> b -> a
const Int
0
{-# INLINABLE hash #-}
hashWithSalt :: Int -> record (f :. ElField) '[] -> Int
hashWithSalt Int
s = forall a b. a -> b -> a
const Int
s
{-# INLINABLE hashWithSalt #-}
instance (V.KnownField t
, Functor f
, RecGetFieldC t record f (t ': rs)
, RCastC rs (t ': rs) record f
#if MIN_VERSION_hashable(1,4,0)
, Eq (record (f :. ElField) (t ': rs))
#endif
, 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 forall a. Hashable a => Int -> a -> Int
`Hash.hashWithSalt` (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) forall a. Hashable a => Int -> a -> Int
`Hash.hashWithSalt` (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 #-}
unpackNoOp :: MR.Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackNoOp :: forall {k} (record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *)
(rs :: k).
Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackNoOp = forall x. (x -> Bool) -> Unpack x x
MR.Filter (forall a b. a -> b -> a
const Bool
True)
unpackFilterRow
:: (record (f :. ElField) rs -> Bool)
-> MR.Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackFilterRow :: 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) rs -> Bool
test = forall x. (x -> Bool) -> Unpack x x
MR.Filter record (f :. ElField) rs -> Bool
test
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 :: 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 f (Snd t) -> Bool
test = 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 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)
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 (t :: (Symbol, *)) (rs :: [(Symbol, *)])
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(Functor f, KnownField t, ElemOf rs t,
RecGetFieldC t record f rs) =>
(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' = (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Snd t -> Bool
testValue) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. f a -> Maybe a
toMaybe in 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'
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 :: forall {k} (cs :: k) (rs :: k)
(record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *).
RCastC cs rs record f =>
(record (f :. ElField) cs -> Bool)
-> Unpack (record (f :. ElField) rs) (record (f :. ElField) rs)
unpackGoodRows record (f :. ElField) cs -> Bool
testSubset = 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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)
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 :: 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 = forall k y c. (y -> k) -> (y -> c) -> Assign k y c
MR.assign (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 {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 #-}
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 :: forall {a} (ks :: [a]) (rs :: [a]) (cs :: [a])
(record :: ((Symbol, *) -> *) -> [a] -> *) (f :: * -> *).
(RCastC ks rs record f, RCastC cs rs record f,
cs ~ RDeleteAll ks rs) =>
Assign
(record (f :. ElField) ks)
(record (f :. ElField) rs)
(record (f :. ElField) cs)
splitOnKeys = 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 #-}
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 :: forall {a} (cs :: [a]) (rs :: [a]) (ks :: [a])
(record :: ((Symbol, *) -> *) -> [a] -> *) (f :: * -> *).
(RCastC ks rs record f, RCastC cs rs record f,
ks ~ RDeleteAll cs rs) =>
Assign
(record (f :. ElField) ks)
(record (f :. ElField) rs)
(record (f :. ElField) cs)
splitOnData = 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 #-}
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 :: forall {k} (ks :: k) (rs :: k)
(record :: ((Symbol, *) -> *) -> k -> *) (f :: * -> *).
RCastC ks rs record f =>
Assign
(record (f :. ElField) ks)
(record (f :. ElField) rs)
(record (f :. ElField) rs)
assignKeys = forall k y c. (y -> k) -> (y -> c) -> Assign k y c
MR.assign (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 a. a -> a
id
{-# INLINABLE assignKeys #-}
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)
-> MR.Reduce
(record (f :. ElField) ks)
x
(record (f :. ElField) (ks V.++ cs))
reduceAndAddKey :: forall (ks :: [(Symbol, *)]) (cs :: [(Symbol, *)]) x
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
(IsoRec ks record f, IsoRec cs record f,
IsoRec (ks ++ cs) record f) =>
(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 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
process (\record (f :. ElField) ks
k record (f :. ElField) cs
y -> forall (rs :: [(Symbol, *)])
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
Rec (f :. ElField) rs -> record (f :. ElField) rs
fromRec (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 forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
`V.rappend` 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 #-}
foldAndAddKey
:: (IsoRec ks record f, IsoRec cs record f, IsoRec (ks V.++ cs) record f)
=> FL.Fold x (record (f :. ElField) cs)
-> MR.Reduce
(record (f :. ElField) ks)
x
(record (f :. ElField) (ks V.++ cs))
foldAndAddKey :: forall (ks :: [(Symbol, *)])
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *)
(cs :: [(Symbol, *)]) x.
(IsoRec ks record f, IsoRec cs record f,
IsoRec (ks ++ cs) record f) =>
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 =
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 -> forall (rs :: [(Symbol, *)])
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
Rec (f :. ElField) rs -> record (f :. ElField) rs
fromRec (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 forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
`V.rappend` 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 #-}
makeRecsWithKey
:: ( Functor g
, Foldable g
, IsoRec ks record f
, IsoRec as record f
, IsoRec (ks V.++ as) record f
)
=> (y -> record (f :. ElField) as)
-> MR.Reduce (record (f :. ElField) ks) x (g y)
-> MR.Reduce
(record (f :. ElField) ks)
x
(g (record (f :. ElField) (ks V.++ as)))
makeRecsWithKey :: forall (g :: * -> *) (ks :: [(Symbol, *)])
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *)
(as :: [(Symbol, *)]) y x.
(Functor g, Foldable g, IsoRec ks record f, IsoRec as record f,
IsoRec (ks ++ as) record f) =>
(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 = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\y
y -> forall (rs :: [(Symbol, *)])
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
Rec (f :. ElField) rs -> record (f :. ElField) rs
fromRec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
V.rappend (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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rs :: [(Symbol, *)])
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec forall a b. (a -> b) -> a -> b
$ y -> record (f :. ElField) as
makeRec y
y)
{-# INLINABLE makeRecsWithKey #-}
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)
-> MR.ReduceM m (record (f :. ElField) ks) x (g y)
-> MR.ReduceM
m
(record (f :. ElField) ks)
x
(g (record (f :. ElField) (ks V.++ as)))
makeRecsWithKeyM :: forall (m :: * -> *) (g :: * -> *) (ks :: [(Symbol, *)])
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *)
(as :: [(Symbol, *)]) y x.
(Monad m, Functor g, Foldable g, IsoRec ks record f,
IsoRec as record f, IsoRec (ks ++ as) record f) =>
(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 = 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\y
y -> forall (rs :: [(Symbol, *)])
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
Rec (f :. ElField) rs -> record (f :. ElField) rs
fromRec forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
V.rappend (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) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rs :: [(Symbol, *)])
(record :: ((Symbol, *) -> *) -> [(Symbol, *)] -> *) (f :: * -> *).
IsoRec rs record f =>
record (f :. ElField) rs -> Rec (f :. ElField) rs
toRec forall a b. (a -> b) -> a -> b
$ y -> record (f :. ElField) as
makeRec y
y)
{-# INLINABLE makeRecsWithKeyM #-}