{-# LANGUAGE ConstraintKinds, DataKinds, FlexibleContexts, FlexibleInstances,
KindSignatures, MultiParamTypeClasses, PolyKinds,
ScopedTypeVariables, TypeFamilies, TypeOperators,
UndecidableInstances, TemplateHaskell, QuasiQuotes,
Rank2Types, TypeApplications, AllowAmbiguousTypes #-}
module Frames.Joins (innerJoin
, outerJoin
, leftJoin
, rightJoin)
where
import Data.Discrimination
import Data.Foldable as F
import Frames.Frame
import Frames.Rec
import Frames.InCore (toFrame)
import Frames.Melt (RDeleteAll)
import Frames.InCore (RecVec)
import Data.Vinyl.TypeLevel
import Data.Vinyl
import Data.Vinyl.Functor
mergeRec :: forall fs rs rs2 rs2'.
(fs ⊆ rs2
, rs2' ⊆ rs2
, rs2' ~ RDeleteAll fs rs2
, rs ⊆ (rs ++ rs2')) =>
Record rs ->
Record rs2 ->
Record (rs ++ rs2')
{-# INLINE mergeRec #-}
mergeRec :: forall (fs :: [(Symbol, *)]) (rs :: [(Symbol, *)])
(rs2 :: [(Symbol, *)]) (rs2' :: [(Symbol, *)]).
(fs ⊆ rs2, rs2' ⊆ rs2, rs2' ~ RDeleteAll fs rs2,
rs ⊆ (rs ++ rs2')) =>
Record rs -> Record rs2 -> Record (rs ++ rs2')
mergeRec Record rs
rec1 Record rs2
rec2 =
Record rs
rec1 forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> Rec ElField rs2'
rec2'
where
rec2' :: Rec ElField rs2'
rec2' = 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
rcast @rs2' Record rs2
rec2
innerJoin :: forall fs rs rs2 rs2'.
(fs ⊆ rs
, fs ⊆ rs2
, rs ⊆ (rs ++ rs2')
, rs2' ⊆ rs2
, rs2' ~ RDeleteAll fs rs2
, Grouping (Record fs)
, RecVec rs
, RecVec rs2'
, RecVec (rs ++ rs2')
) =>
Frame (Record rs)
-> Frame (Record rs2)
-> Frame (Record (rs ++ rs2'))
innerJoin :: forall (fs :: [(Symbol, *)]) (rs :: [(Symbol, *)])
(rs2 :: [(Symbol, *)]) (rs2' :: [(Symbol, *)]).
(fs ⊆ rs, fs ⊆ rs2, rs ⊆ (rs ++ rs2'), rs2' ⊆ rs2,
rs2' ~ RDeleteAll fs rs2, Grouping (Record fs), RecVec rs,
RecVec rs2', RecVec (rs ++ rs2')) =>
Frame (Record rs)
-> Frame (Record rs2) -> Frame (Record (rs ++ rs2'))
innerJoin Frame (Record rs)
a Frame (Record rs2)
b =
forall (f :: * -> *) (rs :: [(Symbol, *)]).
(Foldable f, RecVec rs) =>
f (Record rs) -> Frame (Record rs)
toFrame forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(forall (f :: * -> *) d a b c.
Discriminating f =>
f d -> (a -> b -> c) -> (a -> d) -> (b -> d) -> [a] -> [b] -> [[c]]
inner forall a. Grouping a => Group a
grouping Record rs -> Record rs2 -> Record (rs ++ rs2')
mergeFun Record rs -> Record fs
proj1 Record rs2 -> Record fs
proj2 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Frame (Record rs)
a) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Frame (Record rs2)
b))
where
{-# INLINE mergeFun #-}
mergeFun :: Record rs -> Record rs2 -> Record (rs ++ rs2')
mergeFun = forall (fs :: [(Symbol, *)]) (rs :: [(Symbol, *)])
(rs2 :: [(Symbol, *)]) (rs2' :: [(Symbol, *)]).
(fs ⊆ rs2, rs2' ⊆ rs2, rs2' ~ RDeleteAll fs rs2,
rs ⊆ (rs ++ rs2')) =>
Record rs -> Record rs2 -> Record (rs ++ rs2')
mergeRec @fs
{-# INLINE proj1 #-}
proj1 :: Record rs -> Record fs
proj1 = 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
rcast @fs
{-# INLINE proj2 #-}
proj2 :: Record rs2 -> Record fs
proj2 = 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
rcast @fs
justsFromRec :: RMap fs => Record fs -> Rec (Maybe :. ElField) fs
{-# INLINE justsFromRec #-}
justsFromRec :: forall (fs :: [(Symbol, *)]).
RMap fs =>
Record fs -> Rec (Maybe :. ElField) fs
justsFromRec = forall {u} (rs :: [u]) (f :: u -> *) (g :: u -> *).
RMap rs =>
(forall (x :: u). f x -> g x) -> Rec f rs -> Rec g rs
rmap (forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
mkNothingsRec :: forall fs.
(RecApplicative fs) =>
Rec (Maybe :. ElField) fs
{-# INLINE mkNothingsRec #-}
mkNothingsRec :: forall (fs :: [(Symbol, *)]).
RecApplicative fs =>
Rec (Maybe :. ElField) fs
mkNothingsRec = forall {u} (rs :: [u]) (f :: u -> *).
RecApplicative rs =>
(forall (x :: u). f x) -> Rec f rs
rpure @fs (forall l k (f :: l -> *) (g :: k -> l) (x :: k).
f (g x) -> Compose f g x
Compose forall a. Maybe a
Nothing)
outerJoin :: forall fs rs rs' rs2 rs2' ors.
(fs ⊆ rs
, fs ⊆ rs2
, rs ⊆ (rs ++ rs2')
, rs' ⊆ rs
, rs' ~ RDeleteAll fs rs
, rs2' ⊆ rs2
, rs2' ~ RDeleteAll fs rs2
, ors ~ (rs ++ rs2')
, ors :~: (rs' ++ rs2)
, RecApplicative rs2'
, RecApplicative rs
, RecApplicative rs'
, Grouping (Record fs)
, RMap rs
, RMap rs2
, RMap ors
, RecVec rs
, RecVec rs2'
, RecVec ors
) =>
Frame (Record rs)
-> Frame (Record rs2)
-> [Rec (Maybe :. ElField) ors]
outerJoin :: forall (fs :: [(Symbol, *)]) (rs :: [(Symbol, *)])
(rs' :: [(Symbol, *)]) (rs2 :: [(Symbol, *)])
(rs2' :: [(Symbol, *)]) (ors :: [(Symbol, *)]).
(fs ⊆ rs, fs ⊆ rs2, rs ⊆ (rs ++ rs2'), rs' ⊆ rs,
rs' ~ RDeleteAll fs rs, rs2' ⊆ rs2, rs2' ~ RDeleteAll fs rs2,
ors ~ (rs ++ rs2'), ors :~: (rs' ++ rs2), RecApplicative rs2',
RecApplicative rs, RecApplicative rs', Grouping (Record fs),
RMap rs, RMap rs2, RMap ors, RecVec rs, RecVec rs2', RecVec ors) =>
Frame (Record rs)
-> Frame (Record rs2) -> [Rec (Maybe :. ElField) ors]
outerJoin Frame (Record rs)
a Frame (Record rs2)
b =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(forall (f :: * -> *) d a b c.
Discriminating f =>
f d
-> (a -> b -> c)
-> (a -> c)
-> (b -> c)
-> (a -> d)
-> (b -> d)
-> [a]
-> [b]
-> [[c]]
outer forall a. Grouping a => Group a
grouping Record rs -> Record rs2 -> Rec (Maybe :. ElField) ors
mergeFun Record rs -> Rec (Maybe :. ElField) (rs ++ rs2')
mergeLeftEmpty Record rs2 -> Rec (Maybe :. ElField) ors
mergeRightEmpty
Record rs -> Record fs
proj1 Record rs2 -> Record fs
proj2 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Frame (Record rs)
a) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Frame (Record rs2)
b))
where
{-# INLINE proj1 #-}
proj1 :: Record rs -> Record fs
proj1 = 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
rcast @fs
{-# INLINE proj2 #-}
proj2 :: Record rs2 -> Record fs
proj2 = 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
rcast @fs
{-# INLINE mergeFun #-}
mergeFun :: Record rs -> Record rs2 -> Rec (Maybe :. ElField) ors
mergeFun Record rs
l Record rs2
r = forall (fs :: [(Symbol, *)]).
RMap fs =>
Record fs -> Rec (Maybe :. ElField) fs
justsFromRec forall a b. (a -> b) -> a -> b
$ forall (fs :: [(Symbol, *)]) (rs :: [(Symbol, *)])
(rs2 :: [(Symbol, *)]) (rs2' :: [(Symbol, *)]).
(fs ⊆ rs2, rs2' ⊆ rs2, rs2' ~ RDeleteAll fs rs2,
rs ⊆ (rs ++ rs2')) =>
Record rs -> Record rs2 -> Record (rs ++ rs2')
mergeRec @fs Record rs
l Record rs2
r
{-# INLINE mergeLeftEmpty #-}
mergeLeftEmpty :: Record rs -> Rec (Maybe :. ElField) (rs ++ rs2')
mergeLeftEmpty Record rs
l = forall (fs :: [(Symbol, *)]).
RMap fs =>
Record fs -> Rec (Maybe :. ElField) fs
justsFromRec Record rs
l forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> forall (fs :: [(Symbol, *)]).
RecApplicative fs =>
Rec (Maybe :. ElField) fs
mkNothingsRec @rs2'
{-# INLINE mergeRightEmpty #-}
mergeRightEmpty :: Record rs2 -> Rec (Maybe :. ElField) ors
mergeRightEmpty Record rs2
r = 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
rcast @ors (forall (fs :: [(Symbol, *)]).
RecApplicative fs =>
Rec (Maybe :. ElField) fs
mkNothingsRec @rs' forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> forall (fs :: [(Symbol, *)]).
RMap fs =>
Record fs -> Rec (Maybe :. ElField) fs
justsFromRec Record rs2
r)
rightJoin :: forall fs rs rs' rs2 rs2' ors.
(fs ⊆ rs
, fs ⊆ rs2
, rs ⊆ (rs ++ rs2')
, rs' ⊆ rs
, rs' ~ RDeleteAll fs rs
, rs2' ⊆ rs2
, rs2' ~ RDeleteAll fs rs2
, ors ~ (rs ++ rs2')
, ors :~: (rs' ++ rs2)
, RecApplicative rs2'
, RecApplicative rs
, RecApplicative rs'
, Grouping (Record fs)
, RMap rs2
, RMap ors
, RecVec rs
, RecVec rs2'
, RecVec ors
) =>
Frame (Record rs)
-> Frame (Record rs2)
-> [Rec (Maybe :. ElField) ors]
rightJoin :: forall (fs :: [(Symbol, *)]) (rs :: [(Symbol, *)])
(rs' :: [(Symbol, *)]) (rs2 :: [(Symbol, *)])
(rs2' :: [(Symbol, *)]) (ors :: [(Symbol, *)]).
(fs ⊆ rs, fs ⊆ rs2, rs ⊆ (rs ++ rs2'), rs' ⊆ rs,
rs' ~ RDeleteAll fs rs, rs2' ⊆ rs2, rs2' ~ RDeleteAll fs rs2,
ors ~ (rs ++ rs2'), ors :~: (rs' ++ rs2), RecApplicative rs2',
RecApplicative rs, RecApplicative rs', Grouping (Record fs),
RMap rs2, RMap ors, RecVec rs, RecVec rs2', RecVec ors) =>
Frame (Record rs)
-> Frame (Record rs2) -> [Rec (Maybe :. ElField) ors]
rightJoin Frame (Record rs)
a Frame (Record rs2)
b =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) d a b c.
Discriminating f =>
f d
-> (a -> b -> c)
-> (b -> c)
-> (a -> d)
-> (b -> d)
-> [a]
-> [b]
-> [[c]]
rightOuter forall a. Grouping a => Group a
grouping Record rs -> Record rs2 -> Rec (Maybe :. ElField) ors
mergeFun Record rs2 -> Rec (Maybe :. ElField) ors
mergeRightEmpty
Record rs -> Record fs
proj1 Record rs2 -> Record fs
proj2 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Frame (Record rs)
a) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Frame (Record rs2)
b)
where
{-# INLINE proj1 #-}
proj1 :: Record rs -> Record fs
proj1 = 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
rcast @fs
{-# INLINE proj2 #-}
proj2 :: Record rs2 -> Record fs
proj2 = 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
rcast @fs
{-# INLINE mergeFun #-}
mergeFun :: Record rs -> Record rs2 -> Rec (Maybe :. ElField) ors
mergeFun Record rs
l Record rs2
r = forall (fs :: [(Symbol, *)]).
RMap fs =>
Record fs -> Rec (Maybe :. ElField) fs
justsFromRec forall a b. (a -> b) -> a -> b
$ forall (fs :: [(Symbol, *)]) (rs :: [(Symbol, *)])
(rs2 :: [(Symbol, *)]) (rs2' :: [(Symbol, *)]).
(fs ⊆ rs2, rs2' ⊆ rs2, rs2' ~ RDeleteAll fs rs2,
rs ⊆ (rs ++ rs2')) =>
Record rs -> Record rs2 -> Record (rs ++ rs2')
mergeRec @fs Record rs
l Record rs2
r
{-# INLINE mergeRightEmpty #-}
mergeRightEmpty :: Record rs2 -> Rec (Maybe :. ElField) ors
mergeRightEmpty Record rs2
r = 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
rcast @ors (forall (fs :: [(Symbol, *)]).
RecApplicative fs =>
Rec (Maybe :. ElField) fs
mkNothingsRec @rs' forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> forall (fs :: [(Symbol, *)]).
RMap fs =>
Record fs -> Rec (Maybe :. ElField) fs
justsFromRec Record rs2
r)
leftJoin :: forall fs rs rs2 rs2'.
(fs ⊆ rs
, fs ⊆ rs2
, rs ⊆ (rs ++ rs2')
, rs2' ⊆ rs2
, rs2' ~ RDeleteAll fs rs2
, RMap rs
, RMap (rs ++ rs2')
, RecApplicative rs2'
, Grouping (Record fs)
, RecVec rs
, RecVec rs2'
, RecVec (rs ++ rs2')
) =>
Frame (Record rs)
-> Frame (Record rs2)
-> [Rec (Maybe :. ElField) (rs ++ rs2')]
leftJoin :: forall (fs :: [(Symbol, *)]) (rs :: [(Symbol, *)])
(rs2 :: [(Symbol, *)]) (rs2' :: [(Symbol, *)]).
(fs ⊆ rs, fs ⊆ rs2, rs ⊆ (rs ++ rs2'), rs2' ⊆ rs2,
rs2' ~ RDeleteAll fs rs2, RMap rs, RMap (rs ++ rs2'),
RecApplicative rs2', Grouping (Record fs), RecVec rs, RecVec rs2',
RecVec (rs ++ rs2')) =>
Frame (Record rs)
-> Frame (Record rs2) -> [Rec (Maybe :. ElField) (rs ++ rs2')]
leftJoin Frame (Record rs)
a Frame (Record rs2)
b =
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
(forall (f :: * -> *) d a b c.
Discriminating f =>
f d
-> (a -> b -> c)
-> (a -> c)
-> (a -> d)
-> (b -> d)
-> [a]
-> [b]
-> [[c]]
leftOuter forall a. Grouping a => Group a
grouping Record rs -> Record rs2 -> Rec (Maybe :. ElField) (rs ++ rs2')
mergeFun Record rs -> Rec (Maybe :. ElField) (rs ++ rs2')
mergeLeftEmpty
Record rs -> Record fs
proj1 Record rs2 -> Record fs
proj2 (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Frame (Record rs)
a) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Frame (Record rs2)
b))
where
proj1 :: Record rs -> Record fs
proj1 = 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
rcast @fs
proj2 :: Record rs2 -> Record fs
proj2 = 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
rcast @fs
mergeFun :: Record rs -> Record rs2 -> Rec (Maybe :. ElField) (rs ++ rs2')
mergeFun Record rs
l Record rs2
r = forall (fs :: [(Symbol, *)]).
RMap fs =>
Record fs -> Rec (Maybe :. ElField) fs
justsFromRec forall a b. (a -> b) -> a -> b
$ forall (fs :: [(Symbol, *)]) (rs :: [(Symbol, *)])
(rs2 :: [(Symbol, *)]) (rs2' :: [(Symbol, *)]).
(fs ⊆ rs2, rs2' ⊆ rs2, rs2' ~ RDeleteAll fs rs2,
rs ⊆ (rs ++ rs2')) =>
Record rs -> Record rs2 -> Record (rs ++ rs2')
mergeRec @fs Record rs
l Record rs2
r
mergeLeftEmpty :: Record rs -> Rec (Maybe :. ElField) (rs ++ rs2')
mergeLeftEmpty Record rs
l = forall (fs :: [(Symbol, *)]).
RMap fs =>
Record fs -> Rec (Maybe :. ElField) fs
justsFromRec Record rs
l forall {k} (f :: k -> *) (as :: [k]) (bs :: [k]).
Rec f as -> Rec f bs -> Rec f (as ++ bs)
<+> forall (fs :: [(Symbol, *)]).
RecApplicative fs =>
Rec (Maybe :. ElField) fs
mkNothingsRec @rs2'