mirror of
https://github.com/khibino/haskell-relational-record.git
synced 2024-12-18 01:02:04 +03:00
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
|