join.hs

type Join a b = Map (Key a) (Entity a, Collection b)

type Collection a = Map (Key a) (Entity a)

innerJoin
  :: ( PersistEntity val1
     , PersistEntity val2
     , PersistField typ
     , PersistEntityBackend val1 ~ SqlBackend
     , PersistEntityBackend val2 ~ SqlBackend
     , Monad m, MonadResource m
     )
  => EntityField val1 typ
  -> EntityField val2 typ
  -> SqlPersistT m (Join val1 val2)
innerJoin x y = selectSource q $$ foldlC k mempty
  where
    q = from $ \(m `InnerJoin` a) -> do
        on (m ^. x ==. a ^. y)
        pure (m, a)
    k acc (m, a) =
        Map.insertWith h (entityKey m) (m, Map.singleton (entityKey a) a) acc
    h (m, a) (_, b) = (m, Map.union a b)