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

74 lines
1.9 KiB
Haskell
Raw Normal View History

2013-05-13 10:16:00 +04:00
{-# LANGUAGE MonadComprehensions #-}
2013-05-20 02:45:45 +04:00
{-# LANGUAGE FlexibleContexts #-}
import Database.Record
2013-05-13 10:16:00 +04:00
import Database.Relational.Query
2013-05-20 02:45:45 +04:00
import Database.HDBC (IConnection, SqlValue)
2013-05-13 10:16:00 +04:00
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)
2013-05-20 02:45:45 +04:00
groupMemberShip :: QueryJoin (Projection (Maybe Membership, Group))
groupMemberShip =
[ m >*< g
| m <- queryMaybe membership
, g <- query group
, () <- on $ m !? groupId' .=. just (g ! Group.id')
]
userGroup0 :: Relation (Maybe User, Maybe Group)
userGroup0 =
relation $
[ u >*< mg !? snd'
| u <- queryMaybe user
, mg <- queryMaybe $ relation groupMemberShip
-- Call one subquery via relation layer
-- Simple implementation.
-- Complex SQL. Nested table form joins.
, () <- on $ u !? User.id' .=. flatten (mg !? fst') !? userId'
, () <- asc $ u !? User.id'
]
userGroup1 :: Relation (Maybe User, Maybe Group)
userGroup1 =
relation $
[ u >*< mg !? snd'
| u <- queryMaybe user
, mg <- queryMergeMaybe groupMemberShip
-- Directly merge another QueryJoin monad.
-- Complex implementation.
-- Simple SQL. Flat table form joins.
, () <- on $ u !? User.id' .=. flatten (mg !? fst') !? userId'
, () <- asc $ u !? User.id'
]
runAndPrint :: (Show a, IConnection conn, FromSql SqlValue a) => conn -> Relation a -> IO ()
runAndPrint conn rel = do
putStrLn $ "SQL: " ++ show rel
records <- runQuery conn () (fromRelation rel)
mapM_ print records
putStrLn ""
2013-05-13 10:16:00 +04:00
run :: IO ()
run = withConnectionIO connect
(\conn -> do
2013-05-20 02:45:45 +04:00
runAndPrint conn userGroup0
runAndPrint conn userGroup1
)
2013-05-13 10:16:00 +04:00
main :: IO ()
main = run