khibino/haskell-relational-record
1
1
Fork 0
mirror of https://github.com/khibino/haskell-relational-record.git synced 2024-12-12 12:09:08 +03:00
Code Issues Projects Releases Wiki Activity

Update example.

Browse Source
This commit is contained in:
Kei Hibino 2013-05-21 10:56:08 +09:00
parent 9cad683fd6
commit bcd05bd348
1 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
relational-join-HDBC-pgTest/sample/1/querySample.hs
View File

@ -17,8 +17,9 @@ import Database.HDBC.Record.Query (runQuery)
import Database.HDBC.Session (withConnectionIO) import Database.HDBC.Session (withConnectionIO)
groupMemberShip :: QueryJoin (Projection (Maybe Membership, Group)) groupMemberShip :: Relation (Maybe Membership, Group)
groupMemberShip = groupMemberShip =
relation $
[ m >*< g [ m >*< g
| m <- queryMaybe membership | m <- queryMaybe membership
, g <- query group , g <- query group
@ -30,30 +31,30 @@ userGroup0 =
relation $ relation $
[ u >*< mg !? snd' [ u >*< mg !? snd'
| u <- queryMaybe user | u <- queryMaybe user
, mg <- queryMaybe $ relation groupMemberShip , mg <- queryMaybe $ nested groupMemberShip
-- Call one subquery via relation layer -- Call one subquery via relation layer
-- Simple implementation. -- Simple implementation.
-- Complex SQL. Nested table form joins. -- Nested SQL. Nested table form joins.
, () <- on $ u !? User.id' .=. flatten (mg !? fst') !? userId' , () <- on $ u !? User.id' .=. flatten (mg !? fst') !? userId'
, () <- asc $ u !? User.id' , () <- asc $ u !? User.id'
] ]
-- userGroup1 :: Relation (Maybe User, Maybe Group) userGroup1 :: Relation (Maybe User, Maybe Group)
-- userGroup1 = userGroup1 =
-- relation $ relation $
-- [ u >*< mg !? snd' [ u >*< mg !? snd'
-- | u <- queryMaybe user | u <- queryMaybe user
-- , mg <- queryMergeMaybe groupMemberShip , mg <- queryMaybe groupMemberShip
-- -- Directly merge another QueryJoin monad. -- Directly merge another QueryJoin monad.
-- -- Complex implementation. -- Complex implementation.
-- -- Simple SQL. Flat table form joins. -- Flat SQL. Flat table form joins.
-- , () <- on $ u !? User.id' .=. flatten (mg !? fst') !? userId' , () <- on $ u !? User.id' .=. flatten (mg !? fst') !? userId'
-- , () <- asc $ u !? User.id' , () <- asc $ u !? User.id'
-- ] ]
runAndPrint :: (Show a, IConnection conn, FromSql SqlValue a) => conn -> Relation a -> IO () runAndPrint :: (Show a, IConnection conn, FromSql SqlValue a) => conn -> Relation a -> IO ()
runAndPrint conn rel = do runAndPrint conn rel = do
@ -66,7 +67,7 @@ run :: IO ()
run = withConnectionIO connect run = withConnectionIO connect
(\conn -> do (\conn -> do
runAndPrint conn userGroup0 runAndPrint conn userGroup0
-- runAndPrint conn userGroup1 runAndPrint conn userGroup1
) )
main :: IO () main :: IO ()