[prev in list] [next in list] [prev in thread] [next in thread]
List: haskell-cafe
Subject: Re: [Haskell-cafe] How can I generalize my innerJoinOnId function to innerJoin with Vinyl?
From: Cody Goodman <codygman.consulting () gmail ! com>
Date: 2016-08-21 19:56:21
Message-ID: CADq_+R0SQASQpW6smzO3v-BChjk24LCB7bQimxksEtZZkYc+yg () mail ! gmail ! com
[Download RAW message or body]
[Attachment #2 (multipart/alternative)]
I've since generalized a good bit, though I'm not sure what approach to
take with mkJoinedRow.
Link: https://github.com/codygman/vinyl-experiments/blob/master/src/Main.hs
code:
{-# LANGUAGE ConstraintKinds, PartialTypeSignatures #-}
{-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies,
FlexibleContexts, FlexibleInstances#-}
{-# LANGUAGE NoMonomorphismRestriction, GADTs, TypeSynonymInstances,
TemplateHaskell, StandaloneDeriving #-}
{-# LANGUAGE TypeOperators, ScopedTypeVariables, DeriveDataTypeable,
KindSignatures #-}
module Main where
import Data.Vinyl
import Control.Lens hiding (Identity)
import Data.Singletons.TH
import Data.Maybe
import Control.Monad
import Data.Vinyl.TypeLevel (RIndex)
import Data.Typeable
import GHC.Exts (Constraint)
-- TODO might end up going this route
-- type JoinOn a fields = (a ∈ fields)
data Fields = Id | Name | Age | ActivityName deriving Show
type Person = ['Id, 'Name, 'Age]
type Activity = ['Id, 'ActivityName]
type family ElF (f :: Fields) :: * where
ElF 'Id = Int
ElF 'Name = String
ElF 'Age = Int
ElF 'ActivityName = String
newtype Attr f = Attr { _unAttr :: ElF f }
makeLenses ''Attr
genSingletons [ ''Fields ]
instance Show (Attr 'Id) where show (Attr x) = "id: " ++ show x
instance Show (Attr 'Name) where show (Attr x) = "name: " ++ show x
instance Show (Attr 'Age) where show (Attr x) = "age: " ++ show x
instance Show (Attr 'ActivityName) where show (Attr x) = "activity: " ++ x
(=::) :: sing f -> ElF f -> Attr f
_ =:: x = Attr x
joy :: Rec Attr ['Id, 'Name, 'Age]
joy = (SId =:: 1)
:& (SName =:: "Joy")
:& (SAge =:: 28)
:& RNil
jon :: Rec Attr ['Id, 'Name, 'Age]
jon = (SId =:: 0)
:& (SName =:: "Jon")
:& (SAge =:: 23)
:& RNil
karen :: Rec Attr ['Id, 'Name, 'Age]
karen = (SId =:: 2)
:& (SName =:: "Karen")
:& (SAge =:: 15)
:& RNil
jonFootball :: Rec Attr ['Id, 'ActivityName]
jonFootball = (SId =:: 0)
:& (SActivityName =:: "football")
:& RNil
jonDancing :: Rec Attr ['Id, 'ActivityName]
jonDancing = (SId =:: 0)
:& (SActivityName =:: "dancing")
:& RNil
joyRacing :: Rec Attr ['Id, 'ActivityName]
joyRacing = (SId =:: 1)
:& (SActivityName =:: "racing")
:& RNil
peopleRows :: [Rec Attr ['Id, 'Name, 'Age]]
peopleRows = [joy, jon, karen]
activitieRows :: [Rec Attr ['Id, 'ActivityName]]
activitieRows = [jonFootball, jonDancing, joyRacing]
printActvy :: ('ActivityName ∈ fields) => Rec Attr fields -> IO ()
printActvy r = print (r ^. rlens SActivityName)
-- TODO leave these as Attr's to compare so compariso works in the general
case
isInIdx field leftIdx rightRow = any (== True) . map (== unAttrRightRow) $
leftIdx
where unAttrRightRow = rightRow ^. rlens field . unAttr
-- TODO generalize mkJoinedRow if possible or require a typeclass instance
of mkJoinedRow
-- TODO maybe we can just append fields or something
mkJoinedRow field activities person = do
let name = person ^. rlens SName . unAttr
age = person ^. rlens SAge . unAttr
let filteredActivities = filter (\r -> r ^. rlens field . unAttr ==
person ^. rlens field . unAttr) activities
case listToMaybe filteredActivities of
Just _ -> do
let activityId actvy = actvy ^. rlens field . unAttr
activityName actvy = actvy ^. rlens SActivityName . unAttr
(\actvy -> (SId =:: activityId actvy) :& (SName =:: name) :& (SAge
=:: age) :& (SActivityName =:: activityName actvy) :& RNil) <$>
filteredActivities
Nothing -> []
innerJoinOn field people activities = do
let peopleIdx =(\r -> r ^. rlens field . unAttr) <$> people
let filteredActivites = filter (isInIdx field peopleIdx) activities
join $ map (\p -> mkJoinedRow field filteredActivites p) people
main :: IO ()
main = mapM_ print $ innerJoinOn SId peopleRows activitieRows
-- example of main running:
-- λ> peopleRows
-- [{id: 1, name: "Joy", age: 28},{id: 0, name: "Jon", age: 23},{id: 2,
name: "Karen", age: 15}]
-- λ> activitieRows
-- [{id: 0, activity: football},{id: 0, activity: dancing},{id: 1,
activity: racing}]
-- λ> mapM_ print $ innerJoinOn SId peopleRows activitieRows
-- {id: 1, name: "Joy", age: 28, activity: racing}
-- {id: 0, name: "Jon", age: 23, activity: football}
-- {id: 0, name: "Jon", age: 23, activity: dancing}
On Sun, Aug 21, 2016 at 2:16 PM, Cody Goodman <codygman.consulting@gmail.com
> wrote:
> Hello all! I'll get right to it.
>
> As a first step I'd like to generalize innerJoinOnId's type signature to
> something like:
>
> innerJoinOnId :: (Id ∈ fields, Id ∈ fields2, Id ∈ fields2) => [Rec Attr
> fields] -> [Rec Attr fields2] -> [Rec Attr fields3]
>
> Or if possible:
>
> innerJoinOnId :: (Id ∈ fields) => [Rec Attr fields] -> [Rec Attr fields]
> -> [Rec Attr fields]
>
> As a next step I'd like to create an innerJoin function with type:
>
> innerJoinOn :: (a ∈ fields) => [Rec Attr fields] -> [Rec Attr fields] ->
> [Rec Attr fields]
>
> Where a is supplied and that constraint is carried on to the other inputs.
> Is this possible in Haskell?
>
> Here is both a link and the text of my (working, compilable) code thus far.
>
> Link: https://github.com/codygman/vinyl-experiments/blob/master/
> src/Main.hs
>
> Source code:
>
> {-# LANGUAGE DataKinds, PolyKinds, TypeOperators, TypeFamilies,
> FlexibleContexts, FlexibleInstances, NoMonomorphismRestriction, GADTs,
> TypeSynonymInstances, TemplateHaskell, StandaloneDeriving #-}
>
> module Main where
>
> import Data.Vinyl
> import Control.Lens hiding (Identity)
> import Data.Singletons.TH
> import Data.Maybe
> import Control.Monad
> import Data.Vinyl.TypeLevel (RIndex)
>
> data Fields = Id | Name | Age | ActivityName deriving Show
>
> type Person = ['Id, 'Name, 'Age]
> type Activity = ['Id, 'ActivityName]
>
> type family ElF (f :: Fields) :: * where
> ElF 'Id = Int
> ElF 'Name = String
> ElF 'Age = Int
> ElF 'ActivityName = String
>
> newtype Attr f = Attr { _unAttr :: ElF f }
> makeLenses ''Attr
> genSingletons [ ''Fields ]
> instance Show (Attr 'Id) where show (Attr x) = "id: " ++ show x
> instance Show (Attr 'Name) where show (Attr x) = "name: " ++ show x
> instance Show (Attr 'Age) where show (Attr x) = "age: " ++ show x
> instance Show (Attr 'ActivityName) where show (Attr x) = "activity: " ++ x
>
> (=::) :: sing f -> ElF f -> Attr f
> _ =:: x = Attr x
>
> joy :: Rec Attr ['Id, 'Name, 'Age]
> joy = (SId =:: 1)
> :& (SName =:: "Joy")
> :& (SAge =:: 28)
> :& RNil
> jon :: Rec Attr ['Id, 'Name, 'Age]
> jon = (SId =:: 0)
> :& (SName =:: "Jon")
> :& (SAge =:: 23)
> :& RNil
>
> karen :: Rec Attr ['Id, 'Name, 'Age]
> karen = (SId =:: 2)
> :& (SName =:: "Karen")
> :& (SAge =:: 15)
> :& RNil
>
> jonFootball :: Rec Attr ['Id, 'ActivityName]
> jonFootball = (SId =:: 0)
> :& (SActivityName =:: "football")
> :& RNil
>
> jonDancing :: Rec Attr ['Id, 'ActivityName]
> jonDancing = (SId =:: 0)
> :& (SActivityName =:: "dancing")
> :& RNil
>
> joyRacing :: Rec Attr ['Id, 'ActivityName]
> joyRacing = (SId =:: 1)
> :& (SActivityName =:: "racing")
> :& RNil
>
> peopleRows :: [Rec Attr ['Id, 'Name, 'Age]]
> peopleRows = [joy, jon, karen]
>
> activitieRows :: [Rec Attr ['Id, 'ActivityName]]
> activitieRows = [jonFootball, jonDancing, joyRacing]
>
> printActvy :: ('ActivityName ∈ fields) => Rec Attr fields -> IO ()
> printActvy r = print (r ^. rlens SActivityName)
>
> isInPplIdx :: ('Id ∈ fields) => [Int] -> Rec Attr fields -> Bool
> isInPplIdx peopleIdx actvyRow = any (== True) . map (== actvyIdInt) $
> peopleIdx
> where actvyIdInt = actvyRow ^. rlens SId . unAttr
>
>
> mkJoinedRow :: (Eq (ElF r1),
> RElem
> r1
> ['Id, 'Name, 'Age]
> (RIndex r1 ['Id, 'Name, 'Age]),
> RElem
> r1
> ['Id, 'ActivityName]
> (RIndex r1 ['Id, 'ActivityName]),
> ElF r1 ~ Int) => sing1 r1 -> [Rec Attr
> ['Id, 'ActivityName]] -> Rec Attr ['Id, 'Name, 'Age] -> [Rec Attr ['Id,
> 'Name, 'Age, 'ActivityName]]
> -- mkJoinedRow :: _ -> [Rec Attr ['Id, 'ActivityName]] -> Rec Attr ['Id,
> 'Name, 'Age] -> [Rec Attr ['Id, 'Name, 'Age, 'ActivityName]]
> mkJoinedRow field activities person = do
> let name = person ^. rlens SName . unAttr
> age = person ^. rlens SAge . unAttr
>
> let filteredActivities = filter (\r -> r ^. rlens field . unAttr ==
> person ^. rlens field . unAttr) activities
> case listToMaybe filteredActivities of
> Just _ -> do
> let activityId actvy = actvy ^. rlens field . unAttr
> activityName actvy = actvy ^. rlens SActivityName . unAttr
> (\actvy -> (SId =:: activityId actvy) :& (SName =:: name) :& (SAge
> =:: age) :& (SActivityName =:: activityName actvy) :& RNil) <$>
> filteredActivities
> Nothing -> []
>
> innerJoinOnId :: [Rec Attr ['Id, 'Name, 'Age]] -> [Rec Attr ['Id,
> 'ActivityName]] -> [Rec Attr ['Id, 'Name, 'Age, 'ActivityName]]
> innerJoinOnId people activities = do
> let peopleIdx =(\r -> r ^. rlens SId . unAttr) <$> people
> let filteredActivites = filter (isInPplIdx peopleIdx) activities
> join $ map (\p -> mkJoinedRow SId filteredActivites p) people
>
> main :: IO ()
> main = mapM_ print $ innerJoinOnId peopleRows activitieRows
>
> -- example of main running:
> -- λ> peopleRows
> -- [{id: 1, name: "Joy", age: 28},{id: 0, name: "Jon", age: 23},{id: 2,
> name: "Karen", age: 15}]
> -- λ> activitieRows
> -- [{id: 0, activity: football},{id: 0, activity: dancing},{id: 1,
> activity: racing}]
> -- λ> main
> -- {id: 1, name: "Joy", age: 28, activity: racing}
> -- {id: 0, name: "Jon", age: 23, activity: football}
> -- {id: 0, name: "Jon", age: 23, activity: dancing}
>
> -- Code I wish worked:
>
> -- λ> mapM_ print $ innerJoinOn SId peopleRows activitieRows
> -- λ> mapM_ print $ innerJoinOn SName peopleRows activitieRows -- this
> line would give a compiler error about activitiesRows not containing 'Name
>
>
[Attachment #5 (text/html)]
<div dir="ltr"><div><div>I've since generalized a good bit, though I'm not \
sure what approach to take with mkJoinedRow.<br><br></div>Link: <a \
href="https://github.com/codygman/vinyl-experiments/blob/master/src/Main.hs">https://g \
ithub.com/codygman/vinyl-experiments/blob/master/src/Main.hs</a><br><br></div>code: \
<br><br>{-# LANGUAGE ConstraintKinds, PartialTypeSignatures #-}<br>{-# LANGUAGE \
DataKinds, PolyKinds, TypeOperators, TypeFamilies, FlexibleContexts, \
FlexibleInstances#-}<br>{-# LANGUAGE NoMonomorphismRestriction, GADTs, \
TypeSynonymInstances, TemplateHaskell, StandaloneDeriving #-}<br>{-# LANGUAGE \
TypeOperators, ScopedTypeVariables, DeriveDataTypeable, KindSignatures #-}<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>import \
Data.Typeable<br>import GHC.Exts (Constraint)<br><br>-- TODO might end up going this \
route<br>-- type JoinOn a fields = (a ∈ fields)<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>-- TODO leave \
these as Attr's to compare so compariso works in the general case<br>isInIdx \
field leftIdx rightRow = any (== True) . map (== unAttrRightRow) $ leftIdx<br> \
where unAttrRightRow = rightRow ^. rlens field . unAttr<br><br>-- TODO generalize \
mkJoinedRow if possible or require a typeclass instance of mkJoinedRow<br>-- TODO \
maybe we can just append fields or something<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>innerJoinOn field people activities = do<br> let peopleIdx =(\r -> r \
^. rlens field . unAttr) <$> people<br> let filteredActivites = filter \
(isInIdx field peopleIdx) activities<br> join $ map (\p -> mkJoinedRow field \
filteredActivites p) people<br><br>main :: IO ()<br>main = mapM_ print $ innerJoinOn \
SId 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>-- λ> mapM_ print $ innerJoinOn SId peopleRows \
activitieRows<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></div><div \
class="gmail_extra"><br><div class="gmail_quote">On Sun, Aug 21, 2016 at 2:16 PM, \
Cody Goodman <span dir="ltr"><<a href="mailto:codygman.consulting@gmail.com" \
target="_blank">codygman.consulting@gmail.com</a>></span> wrote:<br><blockquote \
class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc \
solid;padding-left:1ex"><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" \
target="_blank">https://github.com/codygman/<wbr>vinyl-experiments/blob/master/<wbr>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" target="_blank">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> <wbr> RElem<br> \
<wbr> r1<br> <wbr> \
['Id, 'Name, 'Age]<br> \
<wbr> (RIndex r1 ['Id, 'Name, 'Age]),<br> \
<wbr> RElem<br> <wbr> \
r1<br> <wbr> \
['Id, 'ActivityName]<br> \
<wbr> (RIndex r1 ['Id, 'ActivityName]),<br> \
<wbr> 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> </blockquote></div><br></div>
[Attachment #6 (text/plain)]
_______________________________________________
Haskell-Cafe mailing list
To (un)subscribe, modify options or view archives go to:
http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
Only members subscribed via the mailman list are allowed to post.
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic