Update example.

relational-join-HDBC-pgTest/relational-join-HDBC-pgTest.cabal

@@ -21,6 +21,7 @@ Executable sample1
                        , names-th
                        , DB-record
                        , relational-join
+                       , HDBC
                        , HDBC-session
                        , HDBC-postgresql
                        , relational-query-HDBC

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

@@ -1,6 +1,10 @@
 {-# LANGUAGE MonadComprehensions #-}
+{-# LANGUAGE FlexibleContexts #-}
+
+import Database.Record
 
 import Database.Relational.Query
+import Database.HDBC (IConnection, SqlValue)
 
 import qualified User
 import User (User, user)
@@ -12,27 +16,58 @@ import PgTestDataSource (connect)
 import Database.HDBC.Record.Query (runQuery)
 import Database.HDBC.Session (withConnectionIO)
 
-um :: Relation (User, Maybe Membership)
-um =  relation $
-      [ u >*< m
-      | u <- query      user
-      , m <- queryMaybe membership
-      , () <- on $ just (u ! User.id') .=. m !? userId'
-      ]
 
-r0 :: Relation (Maybe User, Maybe Group)
-r0 =  relation $
-      [ (um' !? fst') >*< g
-      | um' <- queryMaybe um
-      , g   <- queryMaybe group
-      , ()  <- on $ flatten (um' !? snd') !? groupId' .=. g !? Group.id'
-      ]
+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 ""
 
 run :: IO ()
 run =  withConnectionIO connect
        (\conn -> do
-           records  <- runQuery conn () (fromRelation r0)
-           mapM_ print records)
+           runAndPrint conn userGroup0
+           runAndPrint conn userGroup1
+       )
 
 main :: IO ()
 main =  run