Guest User

Untitled

a guest
Dec 11th, 2018
98
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 6.38 KB | None | 0 0
  1. {-# LANGUAGE DeriveGeneric #-}
  2. {-# LANGUAGE OverloadedStrings #-}
  3. {-# LANGUAGE FlexibleInstances #-}
  4. {-# LANGUAGE TypeFamilies #-}
  5. {-# LANGUAGE TypeApplications #-}
  6. {-# LANGUAGE StandaloneDeriving #-}
  7. {-# LANGUAGE TypeSynonymInstances #-}
  8. {-# LANGUAGE MultiParamTypeClasses #-}
  9. {-# LANGUAGE PartialTypeSignatures #-}
  10. {-# LANGUAGE ImpredicativeTypes #-}
  11. module BeamTutorial where
  12.  
  13. import Database.Beam
  14. import Database.Beam.Postgres (connect, defaultConnectInfo, runBeamPostgresDebug, PgSelectSyntax)
  15.  
  16. import Data.Text (Text)
  17.  
  18. data UserT f = User
  19. { _userEmail :: Columnar f Text
  20. , _userFirstName :: Columnar f Text
  21. , _userLastName :: Columnar f Text
  22. , _userPassword :: Columnar f Text
  23. } deriving Generic
  24.  
  25. type User = UserT Identity
  26. type UserId = PrimaryKey UserT Identity
  27.  
  28. deriving instance Show User
  29. deriving instance Eq User
  30. instance Beamable UserT
  31. instance Table UserT where
  32. data PrimaryKey UserT f = UserId (Columnar f Text) deriving Generic
  33. primaryKey = UserId . _userEmail
  34. instance Beamable (PrimaryKey UserT)
  35.  
  36. -- userKey = UserId "john@doe.org"
  37.  
  38. data ShoppingCartDb f = ShoppingCartDb
  39. { _shoppingCartUsers :: f (TableEntity UserT)
  40. , _shoppingCartUserAddresses :: f (TableEntity AddressT)
  41. } deriving Generic
  42.  
  43. instance Database be ShoppingCartDb
  44.  
  45. shoppingCartDb :: DatabaseSettings be ShoppingCartDb
  46. shoppingCartDb = defaultDbSettings `withDbModification`
  47. dbModification {
  48. _shoppingCartUserAddresses =
  49. modifyTable (\_ -> "addresses") $
  50. tableModification {
  51. _addressLine1 = fieldNamed "address1",
  52. _addressLine2 = fieldNamed "address2"
  53. }
  54. }
  55.  
  56.  
  57. test :: IO ()
  58. test = do
  59. conn <- connect defaultConnectInfo
  60.  
  61. putStrLn "Sorted Users"
  62. queryUsersSort conn
  63.  
  64. -- putStrLn "Bounded Users"
  65. -- queryBounded conn
  66.  
  67. putStrLn "Count"
  68. queryCount conn
  69.  
  70. putStrLn "Count Names"
  71. queryCountNames conn
  72.  
  73.  
  74.  
  75. where
  76. addUsers conn = do
  77. runBeamPostgresDebug putStrLn conn $ runInsert $
  78. insert (_shoppingCartUsers shoppingCartDb) $
  79. insertValues [ User "james@example.com" "James" "Smith" "b4cc344d25a2efe540adbf2678e2304c" {- james -}
  80. , User "betty@example.com" "Betty" "Jones" "82b054bd83ffad9b6cf8bdb98ce3cc2f" {- betty -}
  81. , User "sam@example.com" "Sam" "Taylor" "332532dcfaa1cbf61e2a266bd723612c" {- sam -} ]
  82.  
  83. queryUsers conn = do
  84. let allUsers = all_ (_shoppingCartUsers shoppingCartDb)
  85.  
  86. runBeamPostgresDebug putStrLn conn $ do
  87. users <- runSelectReturningList $ select allUsers
  88. mapM_ (liftIO . print) users
  89.  
  90.  
  91. queryUsersSort conn = do
  92. let sortUsersByFirstName = orderBy_ (\u -> (asc_ (_userFirstName u), desc_ (_userLastName u))) (all_ (_shoppingCartUsers shoppingCartDb))
  93.  
  94. runBeamPostgresDebug putStrLn conn $ do
  95. users <- runSelectReturningList $ select sortUsersByFirstName
  96. mapM_ (liftIO . putStrLn . show) users
  97.  
  98.  
  99. -- queryBounded conn = do
  100. -- let boundedQuery :: Q PgSelectSyntax _ _ _
  101. -- boundedQuery = limit_ 1 $ offset_ 1 $
  102. -- orderBy_ (asc_ . _userFirstName) $
  103. -- all_ (_shoppingCartUsers shoppingCartDb)
  104.  
  105. -- runBeamPostgresDebug putStrLn conn $ do
  106. -- users <- runSelectReturningList (select boundedQuery :: SqlSelect PgSelectSyntax _)
  107. -- mapM_ (liftIO . putStrLn . show) users
  108.  
  109.  
  110. queryCount conn = do
  111. let userCount = aggregate_ (\u -> countAll_) (all_ (_shoppingCartUsers shoppingCartDb))
  112.  
  113. runBeamPostgresDebug putStrLn conn $ do
  114. Just c <- runSelectReturningOne $ select userCount
  115. liftIO $ putStrLn ("We have " ++ show c ++ " users in the database")
  116.  
  117. queryCountNames conn = do
  118. let numberOfUsersByName = aggregate_ (\u -> (group_ (_userFirstName u), countAll_)) $
  119. all_ (_shoppingCartUsers shoppingCartDb)
  120.  
  121. runBeamPostgresDebug putStrLn conn $ do
  122. countedByName <- runSelectReturningList $ select numberOfUsersByName
  123. mapM_ (liftIO . putStrLn . show) countedByName
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132. --- part 2 --------------------------------------
  133.  
  134. data AddressT f = Address
  135. { _addressId :: C f Int
  136. , _addressLine1 :: C f Text
  137. , _addressLine2 :: C f (Maybe Text)
  138. , _addressCity :: C f Text
  139. , _addressState :: C f Text
  140. , _addressZip :: C f Text
  141.  
  142. , _addressForUser :: PrimaryKey UserT f }
  143. deriving Generic
  144. type Address = AddressT Identity
  145. deriving instance Show (PrimaryKey UserT Identity)
  146. deriving instance Show Address
  147.  
  148. instance Table AddressT where
  149. data PrimaryKey AddressT f = AddressId (Columnar f Int) deriving Generic
  150. primaryKey = AddressId . _addressId
  151. type AddressId = PrimaryKey AddressT Identity -- For convenience
  152.  
  153. instance Beamable AddressT
  154. instance Beamable (PrimaryKey AddressT)
  155.  
  156. Address (LensFor addressId) (LensFor addressLine1)
  157. (LensFor addressLine2) (LensFor addressCity)
  158. (LensFor addressState) (LensFor addressZip)
  159. (UserId (LensFor addressForUserId)) =
  160. tableLenses
  161.  
  162. User (LensFor userEmail) (LensFor userFirstName)
  163. (LensFor userLastName) (LensFor userPassword) =
  164. tableLenses
  165.  
  166.  
  167. test2 :: IO ()
  168. test2 = do
  169. conn <- connect defaultConnectInfo
  170. print "HELLO"
  171. insertUsers conn
  172. where
  173. insertUsers conn = do
  174. let james = User "james@example.com" "James" "Smith" "b4cc344d25a2efe540adbf2678e2304c"
  175. betty = User "betty@example.com" "Betty" "Jones" "82b054bd83ffad9b6cf8bdb98ce3cc2f"
  176. sam = User "sam@example.com" "Sam" "Taylor" "332532dcfaa1cbf61e2a266bd723612c"
  177. runBeamPostgresDebug putStrLn conn $ runInsert $
  178. insert (_shoppingCartUsers shoppingCartDb) $
  179. insertValues [ james, betty, sam ]
  180.  
  181. let addresses = [ Address default_ (val_ "123 Little Street") (val_ Nothing) (val_ "Boston") (val_ "MA") (val_ "12345") (pk james)
  182. , Address default_ (val_ "222 Main Street") (val_ (Just "Ste 1")) (val_ "Houston") (val_ "TX") (val_ "8888") (pk betty)
  183. , Address default_ (val_ "9999 Residence Ave") (val_ Nothing) (val_ "Sugarland") (val_ "TX") (val_ "8989") (pk betty) ]
  184.  
  185. runBeamPostgresDebug putStrLn conn $ runInsert $
  186. insert (_shoppingCartUserAddresses shoppingCartDb) $
  187. insertExpressions addresses
Add Comment
Please, Sign In to add comment