haskell-relational-record/relational-join-HDBC-pgTest/sample/1/querySample.hs

39 lines
954 B
Haskell
Raw Normal View History

2013-05-13 10:16:00 +04:00
{-# 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