persistent_preparation.hs

import Model

:set -XOverloadedStrings -XTypeFamilies -XFlexibleContexts

import Database.Persist.Sqlite

asSqlBackendReader :: ReaderT SqlBackend m a -> ReaderT SqlBackend m a
asSqlBackendReader = id

withDB :: (BaseBackend backend ~ SqlBackend,
           IsPersistBackend backend,
           MonadIO m,
           MonadBaseControl IO m) =>
          ReaderT backend (Control.Monad.Logger.NoLoggingT (ResourceT m)) a-> m a
withDB = runSqlite "rumble.sqlite3" . asSqlBackendReader

persistent_session.hs

λ> id' <- withDB . insert $ User "foo" Nothing
λ> id'
UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 1}}
λ> :t id'
id' :: Key User
λ> withDB $ get id'
Just (User {userIdent = "foo", userPassword = Nothing})
λ> e <- withDB . getBy $ UniqueUser "foo"
λ> e
Just (Entity {entityKey = UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 1}}, entityVal = User {userIdent = "foo", userPassword = Nothing}})
λ> :t e
e :: Maybe (Entity User)
λ> import Data.Maybe
λ> userIdent . entityVal $ fromJust e
"foo"
λ> withDB . getBy $ UniqueUser "missing"
Nothing
λ> fred <- withDB . insert $ User "fred" Nothing
λ> jack <- withDB . insert $ User "jack" Nothing
λ> now <- getCurrentTime
λ> now
2017-11-27 11:30:31.602778 UTC
λ> withDB . insert $ Post "Yesod" "http://www.yesodweb.com/" fred 17 now
PostKey {unPostKey = SqlBackendKey {unSqlBackendKey = 1}}
λ> withDB . insert $ Post "Haskell" "www.haskell.org/" jack 103 now
PostKey {unPostKey = SqlBackendKey {unSqlBackendKey = 2}}
λ> withDB . insert $ Post "Yesod @ Hackage" "hackage.haskell.org/package/yesod" fred 11 now
PostKey {unPostKey = SqlBackendKey {unSqlBackendKey = 3}}
λ> withDB . insert $ Post "Persistent @ Hackage" "hackage.haskell.org/package/persistent" jack 5 now
PostKey {unPostKey = SqlBackendKey {unSqlBackendKey = 4}}
λ> posts <- withDB $ selectList [PostAuthor ==. jack] []
λ> posts
[Entity {entityKey = PostKey {unPostKey = SqlBackendKey {unSqlBackendKey = 2}}, entityVal = Post {postTitle = "Haskell", postUrl = "www.haskell.org/", postAuthor = UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 3}}, postScore = 103, postCreated = 2017-11-27 11:30:31.602778 UTC}},Entity {entityKey = PostKey {unPostKey = SqlBackendKey {unSqlBackendKey = 4}}, entityVal = Post {postTitle = "Persistent @ Hackage", postUrl = "hackage.haskell.org/package/persistent", postAuthor = UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 3}}, postScore = 5, postCreated = 2017-11-27 11:30:31.602778 UTC}}]
λ> length posts
2
λ> map (postTitle . entityVal) posts
["Haskell","Persistent @ Hackage"]
λ> posts' <- withDB $ selectList [PostScore >=. 15, PostAuthor ==. fred] []
λ> map (postTitle . entityVal) posts'
["Yesod"]
λ> posts'' <- withDB $ selectList ([PostAuthor ==. fred] ||. [PostScore >. 100]) []
λ> map (postTitle . entityVal) posts''
["Yesod","Haskell","Yesod @ Hackage"]
λ> posts''' <- withDB $ selectList [] [Desc PostScore]
λ> map (postTitle . entityVal) posts'''
["Haskell","Yesod","Yesod @ Hackage","Persistent @ Hackage"]
λ> map (postScore . entityVal) posts'''
[103,17,11,5]
λ> withDB $ update jack [UserPassword =. Just "asdf"]
λ> withDB $ get jack
Just (User {userIdent = "jack", userPassword = Just "asdf"})
λ> withDB $ updateWhere [PostAuthor ==. fred] [PostScore +=. 10]
λ> posts <- withDB $ selectList [PostAuthor ==. fred] []

<interactive>:150:1-5: warning: [-Wname-shadowing]
    This binding for ‘posts’ shadows the existing binding
      defined at <interactive>:133:1
λ> posts
[Entity {entityKey = PostKey {unPostKey = SqlBackendKey {unSqlBackendKey = 1}}, entityVal = Post {postTitle = "Yesod", postUrl = "http://www.yesodweb.com/", postAuthor = UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 2}}, postScore = 27, postCreated = 2017-11-27 11:30:31.602778 UTC}},Entity {entityKey = PostKey {unPostKey = SqlBackendKey {unSqlBackendKey = 3}}, entityVal = Post {postTitle = "Yesod @ Hackage", postUrl = "hackage.haskell.org/package/yesod", postAuthor = UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 2}}, postScore = 21, postCreated = 2017-11-27 11:30:31.602778 UTC}}]
λ> map (postScore . entityVal) posts
[27,21]
λ> post = (entityKey . Prelude.head) posts
λ> post
PostKey {unPostKey = SqlBackendKey {unSqlBackendKey = 1}}
λ> withDB $ delete post
λ> posts' <- withDB $ selectList [PostAuthor ==. fred] []

<interactive>:172:1-6: warning: [-Wname-shadowing]
    This binding for ‘posts'’ shadows the existing binding
      defined at <interactive>:170:1
λ> map (postScore . entityVal) posts'
[21]
λ> withDB $ deleteWhere [PostAuthor ==. jack]
λ> posts'' <- withDB $ selectList [] [Desc PostScore]

<interactive>:175:1-7: warning: [-Wname-shadowing]
    This binding for ‘posts''’ shadows the existing binding
      defined at <interactive>:139:1
λ> map (postTitle . entityVal) posts''
["Yesod @ Hackage"]
λ> withDB . deleteBy $ UniqueUser "jack"
λ> withDB $ selectList [] [Asc UserIdent]
[Entity {entityKey = UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 1}}, entityVal = User {userIdent = "foo", userPassword = Nothing}},Entity {entityKey = UserKey {unUserKey = SqlBackendKey {unSqlBackendKey = 2}}, entityVal = User {userIdent = "fred", userPassword = Nothing}}]