<div dir="ltr">Hello all! I'll get right to it.<br><br>As a first step I'd like to generalize innerJoinOnId's type signature to something like:<br><br>innerJoinOnId :: (Id ∈ fields, Id ∈ fields2, Id ∈ fields2) => [Rec Attr fields] -> [Rec Attr fields2] -> [Rec Attr fields3]<br><br>Or if possible:<br><br>innerJoinOnId :: (Id ∈ fields) => [Rec Attr fields] -> [Rec Attr fields] -> [Rec Attr fields]<br><br>As a next step I'd like to create an innerJoin function with type:<br><br>innerJoinOn :: (a ∈ fields) => [Rec Attr fields] -> [Rec Attr fields] -> [Rec Attr fields]<br><br>Where a is supplied and that constraint is carried on to the other inputs. Is this possible in Haskell?<br><br>Here is both a link and the text of my (working, compilable) code thus far.<br><br>Link: <a href="https://github.com/codygman/vinyl-experiments/blob/master/src/Main.hs">https://github.com/codygman/vinyl-experiments/blob/master/src/Main.hs</a><br><br>Source code:<br><br>{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies, FlexibleContexts, FlexibleInstances, NoMonomorphismRestriction, GADTs, TypeSynonymInstances, TemplateHaskell, StandaloneDeriving #-}<br><br>module Main where<br><br>import Data.Vinyl<br>import Control.Lens hiding (Identity)<br>import <a href="http://Data.Singletons.TH">Data.Singletons.TH</a><br>import Data.Maybe<br>import Control.Monad<br>import Data.Vinyl.TypeLevel (RIndex)<br><br>data Fields = Id | Name | Age | ActivityName deriving Show<br><br>type Person = ['Id, 'Name, 'Age]<br>type Activity = ['Id, 'ActivityName]<br><br>type family ElF (f :: Fields) :: * where<br>  ElF 'Id = Int<br>  ElF 'Name = String<br>  ElF 'Age = Int<br>  ElF 'ActivityName = String<br><br>newtype Attr f = Attr { _unAttr :: ElF f }<br>makeLenses ''Attr<br>genSingletons [ ''Fields ]<br>instance Show (Attr 'Id) where show (Attr x) = "id: " ++ show x<br>instance Show (Attr 'Name) where show (Attr x) = "name: " ++ show x<br>instance Show (Attr 'Age) where show (Attr x) = "age: " ++ show x<br>instance Show (Attr 'ActivityName) where show (Attr x) = "activity: " ++ x<br><br>(=::) :: sing f -> ElF f -> Attr f<br>_ =:: x = Attr x<br><br>joy :: Rec Attr ['Id, 'Name, 'Age]<br>joy = (SId =:: 1)<br>   :& (SName =:: "Joy")<br>   :& (SAge =:: 28)<br>   :& RNil<br>jon :: Rec Attr ['Id, 'Name, 'Age]<br>jon = (SId =:: 0)<br>   :& (SName =:: "Jon")<br>   :& (SAge =:: 23)<br>   :& RNil<br><br>karen :: Rec Attr ['Id, 'Name, 'Age]<br>karen = (SId =:: 2)<br>   :& (SName =:: "Karen")<br>   :& (SAge =:: 15)<br>   :& RNil<br><br>jonFootball :: Rec Attr ['Id, 'ActivityName]<br>jonFootball = (SId =:: 0)<br>           :& (SActivityName =:: "football")<br>           :& RNil<br><br>jonDancing :: Rec Attr ['Id, 'ActivityName]<br>jonDancing = (SId =:: 0)<br>           :& (SActivityName =:: "dancing")<br>           :& RNil<br><br>joyRacing :: Rec Attr ['Id, 'ActivityName]<br>joyRacing = (SId =:: 1)<br>           :& (SActivityName =:: "racing")<br>           :& RNil<br><br>peopleRows :: [Rec Attr ['Id, 'Name, 'Age]]<br>peopleRows = [joy, jon, karen]<br><br>activitieRows :: [Rec Attr ['Id, 'ActivityName]]<br>activitieRows = [jonFootball, jonDancing, joyRacing]<br><br>printActvy :: ('ActivityName ∈ fields) => Rec Attr fields -> IO ()<br>printActvy r = print (r ^. rlens SActivityName)<br><br>isInPplIdx :: ('Id ∈ fields) => [Int] -> Rec Attr fields -> Bool<br>isInPplIdx peopleIdx actvyRow =  any (== True) . map (== actvyIdInt) $ peopleIdx<br>  where actvyIdInt = actvyRow ^. rlens SId . unAttr<br><br><br>mkJoinedRow :: (Eq (ElF r1),<br>                                RElem<br>                                  r1<br>                                  ['Id, 'Name, 'Age]<br>                                  (RIndex r1 ['Id, 'Name, 'Age]),<br>                                RElem<br>                                  r1<br>                                  ['Id, 'ActivityName]<br>                                  (RIndex r1 ['Id, 'ActivityName]),<br>                                ElF r1 ~ Int) => sing1 r1 -> [Rec Attr ['Id, 'ActivityName]] -> Rec Attr ['Id, 'Name, 'Age] ->  [Rec Attr ['Id, 'Name, 'Age, 'ActivityName]]<br>-- mkJoinedRow :: _ -> [Rec Attr ['Id, 'ActivityName]] -> Rec Attr ['Id, 'Name, 'Age] ->  [Rec Attr ['Id, 'Name, 'Age, 'ActivityName]]<br>mkJoinedRow field activities person = do<br>  let name = person ^. rlens SName . unAttr<br>      age = person ^. rlens SAge . unAttr<br><br>  let filteredActivities = filter (\r -> r ^. rlens field . unAttr == person ^. rlens field . unAttr) activities<br>  case listToMaybe filteredActivities of<br>    Just _ -> do<br>      let activityId actvy = actvy ^. rlens field . unAttr<br>          activityName actvy = actvy ^. rlens SActivityName . unAttr<br>      (\actvy -> (SId =:: activityId actvy) :& (SName =:: name) :& (SAge =:: age) :& (SActivityName =:: activityName actvy) :& RNil) <$> filteredActivities<br>    Nothing -> []<br><br>innerJoinOnId :: [Rec Attr ['Id, 'Name, 'Age]] -> [Rec Attr ['Id, 'ActivityName]] -> [Rec Attr ['Id, 'Name, 'Age, 'ActivityName]]<br>innerJoinOnId people activities = do<br>  let peopleIdx =(\r -> r ^. rlens SId . unAttr) <$> people<br>  let filteredActivites = filter (isInPplIdx peopleIdx) activities<br>  join $ map (\p -> mkJoinedRow SId filteredActivites p) people<br><br>main :: IO ()<br>main = mapM_ print $ innerJoinOnId peopleRows activitieRows<br><br>-- example of main running:<br>-- λ> peopleRows<br>-- [{id: 1, name: "Joy", age: 28},{id: 0, name: "Jon", age: 23},{id: 2, name: "Karen", age: 15}]<br>-- λ> activitieRows<br>-- [{id: 0, activity: football},{id: 0, activity: dancing},{id: 1, activity: racing}]<br>-- λ> main<br>-- {id: 1, name: "Joy", age: 28, activity: racing}<br>-- {id: 0, name: "Jon", age: 23, activity: football}<br>-- {id: 0, name: "Jon", age: 23, activity: dancing}<br><br>-- Code I wish worked:<br><br>-- λ> mapM_ print $ innerJoinOn SId peopleRows activitieRows<br>-- λ> mapM_ print $ innerJoinOn SName peopleRows activitieRows -- this line would give a compiler error about activitiesRows not containing 'Name<br><br></div>