mirror of
https://github.com/khibino/haskell-relational-record.git
synced 2024-12-18 09:12:47 +03:00
7e98380848
--HG-- rename : schema-th/pgTest/PgTest.hs => relational-join-HDBC-pgTest/pgTest/PgTest.hs rename : schema-th/pgTest/PgTestDataSource.hs => relational-join-HDBC-pgTest/pgTest/PgTestDataSource.hs rename : schema-th/pgTest/runCreate.sh => relational-join-HDBC-pgTest/pgTest/runCreate.sh rename : schema-th/pgTest/runDrop.sh => relational-join-HDBC-pgTest/pgTest/runDrop.sh rename : schema-th/sample/1/Group.hs => relational-join-HDBC-pgTest/sample/1/Group.hs rename : schema-th/sample/1/Membership.hs => relational-join-HDBC-pgTest/sample/1/Membership.hs rename : schema-th/sample/1/README => relational-join-HDBC-pgTest/sample/1/README rename : schema-th/sample/1/User.hs => relational-join-HDBC-pgTest/sample/1/User.hs rename : schema-th/sample/1/create.sh => relational-join-HDBC-pgTest/sample/1/create.sh rename : schema-th/sample/1/drop.sh => relational-join-HDBC-pgTest/sample/1/drop.sh rename : schema-th/sample/1/querySample.hs => relational-join-HDBC-pgTest/sample/1/querySample.hs
39 lines
954 B
Haskell
39 lines
954 B
Haskell
{-# LANGUAGE MonadComprehensions #-}
|
|
|
|
import Database.Relational.Query
|
|
|
|
import qualified User
|
|
import User (User, user)
|
|
import qualified Group
|
|
import Group (Group, group)
|
|
import Membership (Membership, groupId', userId', membership)
|
|
|
|
import PgTestDataSource (connect)
|
|
import Database.HDBC.Record.Query (runQuery)
|
|
import Database.HDBC.Session (withConnectionIO)
|
|
|
|
um :: Relation (User, Maybe Membership)
|
|
um = relation $
|
|
[ u >*< m
|
|
| u <- inner user
|
|
, m <- outer membership
|
|
, () <- on $ just (u ! User.id') .=. m !? userId'
|
|
]
|
|
|
|
r0 :: Relation (Maybe User, Maybe Group)
|
|
r0 = relation $
|
|
[ (um' !? fst') >*< g
|
|
| um' <- outer um
|
|
, g <- outer group
|
|
, () <- on $ flatten (um' !? snd') !? groupId' .=. g !? Group.id'
|
|
]
|
|
|
|
run :: IO ()
|
|
run = withConnectionIO connect
|
|
(\conn -> do
|
|
records <- runQuery conn () (fromRelation r0)
|
|
mapM_ print records)
|
|
|
|
main :: IO ()
|
|
main = run
|