haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'master' into patch-1

Browse Source
This commit is contained in:
Chris Allen 2019-09-24 09:55:19 -05:00
commit 9775af6f3c
10 changed files with 83 additions and 81 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.travis.yml
View File

@ -16,7 +16,7 @@ addons:
env: env:
global: global:
- PGPORT=5433 - PGPORT=5432
matrix: matrix:
- GHCVER=8.2 - GHCVER=8.2
- GHCVER=8.4 - GHCVER=8.4
@ -28,7 +28,7 @@ install:
- export PATH=$HOME/.local/bin:$PATH - export PATH=$HOME/.local/bin:$PATH
- travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack'
- stack --version - stack --version
- echo "CREATE USER esqutest WITH PASSWORD 'esqutest';" | psql postgres - psql -c "CREATE USER esqutest WITH PASSWORD 'esqutest';" -U postgres
- createdb -O esqutest esqutest - createdb -O esqutest esqutest
- mysql -e 'CREATE DATABASE esqutest;' - mysql -e 'CREATE DATABASE esqutest;'

1
examples/.gitignore vendored Normal file
View File

@ -0,0 +1 @@
*.cabal

19
examples/Blog.hs
View File

@ -9,8 +9,8 @@ module Blog
( runBlogT ( runBlogT
) where ) where
-------------------------------------------------------------------------------
import Control.Monad.Base (MonadBase (..)) import Control.Monad.Base (MonadBase (..))
import Control.Monad.IO.Unlift (MonadUnliftIO(..), wrappedWithRunInIO)
import Control.Monad.Logger (MonadLogger, NoLoggingT (..)) import Control.Monad.Logger (MonadLogger, NoLoggingT (..))
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..), import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..),
@ -18,30 +18,32 @@ import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..),
defaultLiftBaseWith, defaultLiftBaseWith,
defaultRestoreM) defaultRestoreM)
import Database.Persist.Postgresql (ConnectionString) import Database.Persist.Postgresql (ConnectionString)
-------------------------------------------------------------------------------
newtype BlogT m a = BlogT { unBlogT :: NoLoggingT (ReaderT ConnectionString m) a } newtype BlogT m a = BlogT { unBlogT :: NoLoggingT (ReaderT ConnectionString m) a }
deriving (Functor, Applicative, Monad, MonadLogger, MonadReader ConnectionString, MonadIO) deriving ( Functor
, Applicative
, Monad
, MonadLogger
, MonadReader ConnectionString
, MonadIO
)
instance MonadUnliftIO m => MonadUnliftIO (BlogT m) where
withRunInIO = wrappedWithRunInIO BlogT unBlogT
-------------------------------------------------------------------------------
instance MonadTrans BlogT where instance MonadTrans BlogT where
lift = BlogT . lift . lift lift = BlogT . lift . lift
-------------------------------------------------------------------------------
deriving instance (MonadBase b m) => MonadBase b (BlogT m) deriving instance (MonadBase b m) => MonadBase b (BlogT m)
-------------------------------------------------------------------------------
instance MonadBaseControl b m => MonadBaseControl b (BlogT m) where instance MonadBaseControl b m => MonadBaseControl b (BlogT m) where
type StM (BlogT m) a = ComposeSt BlogT m a type StM (BlogT m) a = ComposeSt BlogT m a
liftBaseWith = defaultLiftBaseWith liftBaseWith = defaultLiftBaseWith
restoreM = defaultRestoreM restoreM = defaultRestoreM
-------------------------------------------------------------------------------
instance MonadTransControl BlogT where instance MonadTransControl BlogT where
type StT BlogT a = StT NoLoggingT (StT (ReaderT ConnectionString) a) type StT BlogT a = StT NoLoggingT (StT (ReaderT ConnectionString) a)
liftWith f = BlogT $ liftWith $ \run -> liftWith f = BlogT $ liftWith $ \run ->
@ -50,7 +52,6 @@ instance MonadTransControl BlogT where
restoreT = BlogT . restoreT . restoreT restoreT = BlogT . restoreT . restoreT
-------------------------------------------------------------------------------
runBlogT :: ConnectionString -> BlogT m a -> m a runBlogT :: ConnectionString -> BlogT m a -> m a
runBlogT backend (BlogT m) = runBlogT backend (BlogT m) =
runReaderT (runNoLoggingT m) backend runReaderT (runNoLoggingT m) backend

33
examples/Main.hs
View File

@ -9,17 +9,18 @@
{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} {-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
module Main module Main
( main ( main
) where ) where
-------------------------------------------------------------------------------
import Blog import Blog
import Control.Monad (void) import Control.Monad (void)
import Control.Monad (forM_) import Control.Monad (forM_)
import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Control.Monad.Logger (MonadLogger) import Control.Monad.Logger (MonadLogger)
import Control.Monad.Reader (MonadReader (..), runReaderT) import Control.Monad.Reader (MonadReader (..), runReaderT)
import Control.Monad.Trans.Control (MonadBaseControl) import Control.Monad.Trans.Control (MonadBaseControl)
@ -27,10 +28,15 @@ import Data.Monoid ((<>))
import Database.Esqueleto import Database.Esqueleto
import Database.Persist.Postgresql (ConnectionString, import Database.Persist.Postgresql (ConnectionString,
withPostgresqlConn) withPostgresqlConn)
import Database.Persist.TH (mkDeleteCascade, mkMigrate, import Database.Persist.TH ( AtLeastOneUniqueKey(..)
mkPersist, persistLowerCase, , OnlyOneUniqueKey(..)
share, sqlSettings) , mkDeleteCascade
------------------------------------------------------------------------------- , mkMigrate
, mkPersist
, persistLowerCase
, share
, sqlSettings
)
share [ mkPersist sqlSettings share [ mkPersist sqlSettings
@ -50,8 +56,6 @@ share [ mkPersist sqlSettings
deriving Eq Show deriving Eq Show
|] |]
-------------------------------------------------------------------------------
putPersons :: (MonadIO m, MonadLogger m) putPersons :: (MonadIO m, MonadLogger m)
=> SqlPersistT m () => SqlPersistT m ()
putPersons = do putPersons = do
@ -65,7 +69,6 @@ putPersons = do
liftIO $ mapM_ (putStrLn . ("Name: " ++) . personName . entityVal) people liftIO $ mapM_ (putStrLn . ("Name: " ++) . personName . entityVal) people
-------------------------------------------------------------------------------
getJohns :: (MonadIO m, MonadLogger m) getJohns :: (MonadIO m, MonadLogger m)
=> SqlReadT m [Entity Person] => SqlReadT m [Entity Person]
getJohns = getJohns =
@ -76,7 +79,6 @@ getJohns =
return p return p
-------------------------------------------------------------------------------
getAdults :: (MonadIO m, MonadLogger m) getAdults :: (MonadIO m, MonadLogger m)
=> SqlReadT m [Entity Person] => SqlReadT m [Entity Person]
getAdults = getAdults =
@ -87,7 +89,6 @@ getAdults =
return p return p
-------------------------------------------------------------------------------
getBlogPostsByAuthors :: (MonadIO m, MonadLogger m) getBlogPostsByAuthors :: (MonadIO m, MonadLogger m)
=> SqlReadT m [(Entity BlogPost, Entity Person)] => SqlReadT m [(Entity BlogPost, Entity Person)]
getBlogPostsByAuthors = getBlogPostsByAuthors =
@ -99,7 +100,6 @@ getBlogPostsByAuthors =
return (b, p) return (b, p)
-------------------------------------------------------------------------------
getAuthorMaybePosts :: (MonadIO m, MonadLogger m) getAuthorMaybePosts :: (MonadIO m, MonadLogger m)
=> SqlReadT m [(Entity Person, Maybe (Entity BlogPost))] => SqlReadT m [(Entity Person, Maybe (Entity BlogPost))]
getAuthorMaybePosts = getAuthorMaybePosts =
@ -113,7 +113,6 @@ getAuthorMaybePosts =
return (p, mb) return (p, mb)
-------------------------------------------------------------------------------
followers :: (MonadIO m, MonadLogger m) followers :: (MonadIO m, MonadLogger m)
=> SqlReadT m [(Entity Person, Entity Follow, Entity Person)] => SqlReadT m [(Entity Person, Entity Follow, Entity Person)]
followers = followers =
@ -128,7 +127,6 @@ followers =
return (p1, f, p2) return (p1, f, p2)
-------------------------------------------------------------------------------
updateJoao :: (MonadIO m, MonadLogger m) updateJoao :: (MonadIO m, MonadLogger m)
=> SqlWriteT m () => SqlWriteT m ()
updateJoao = updateJoao =
@ -138,7 +136,6 @@ updateJoao =
where_ (p ^. PersonName ==. val "Joao") where_ (p ^. PersonName ==. val "Joao")
-------------------------------------------------------------------------------
deleteYoungsters :: (MonadIO m, MonadLogger m) deleteYoungsters :: (MonadIO m, MonadLogger m)
=> SqlPersistT m () => SqlPersistT m ()
deleteYoungsters = do deleteYoungsters = do
@ -154,7 +151,6 @@ deleteYoungsters = do
forM_ youngsters (deleteCascade . entityKey) forM_ youngsters (deleteCascade . entityKey)
-------------------------------------------------------------------------------
insertBlogPosts :: (MonadIO m, MonadLogger m) insertBlogPosts :: (MonadIO m, MonadLogger m)
=> SqlWriteT m () => SqlWriteT m ()
insertBlogPosts = insertBlogPosts =
@ -163,10 +159,10 @@ insertBlogPosts =
return $ BlogPost <# (val "Group Blog Post") <&> (p ^. PersonId) return $ BlogPost <# (val "Group Blog Post") <&> (p ^. PersonId)
-------------------------------------------------------------------------------
runDB :: (MonadReader ConnectionString m, runDB :: (MonadReader ConnectionString m,
MonadIO m, MonadIO m,
MonadBaseControl IO m, MonadBaseControl IO m,
MonadUnliftIO m,
MonadLogger m) MonadLogger m)
=> SqlPersistT m a -> m a => SqlPersistT m a -> m a
runDB query = do runDB query = do
@ -175,7 +171,6 @@ runDB query = do
withPostgresqlConn conn $ \backend -> runReaderT query backend withPostgresqlConn conn $ \backend -> runReaderT query backend
-------------------------------------------------------------------------------
setupDb :: (MonadIO m, MonadLogger m) setupDb :: (MonadIO m, MonadLogger m)
=> SqlPersistT m () => SqlPersistT m ()
setupDb = do setupDb = do
@ -197,7 +192,6 @@ setupDb = do
void $ insert $ Follow joao sean void $ insert $ Follow joao sean
-------------------------------------------------------------------------------
cleanDb :: (MonadIO m, MonadLogger m) cleanDb :: (MonadIO m, MonadLogger m)
=> SqlPersistT m () => SqlPersistT m ()
cleanDb = do cleanDb = do
@ -208,7 +202,6 @@ cleanDb = do
where where
dropTable tableName = rawExecute ("DROP TABLE " <> tableName) [] dropTable tableName = rawExecute ("DROP TABLE " <> tableName) []
-------------------------------------------------------------------------------
main :: IO () main :: IO ()
main = do main = do
-- Connection string for the postrgesql database -- Connection string for the postrgesql database
@ -238,4 +231,4 @@ main = do
where where
say :: (MonadIO m, Show a) => a -> m () say :: (MonadIO m, Show a) => a -> m ()
say = liftIO . print say = liftIO . print
connection = "host=localhost port=5433 user=postgres dbname=esqueleto_blog_example password=***" connection = "host=localhost port=5432 user=postgres dbname=esqueleto_blog_example password=***"

25
examples/package.yaml
View File

@ -2,12 +2,14 @@ name: esqueleto-examples
version: '0.0.0.0' version: '0.0.0.0'
category: Database category: Database
author: Fintan Halpenny author: Fintan Halpenny
maintainer: fintan.halpenny@gmail.com maintainer: cma@bitemyapp.com
copyright: 2017, Chris Allen copyright: 2019, Chris Allen
license: BSD3 license: BSD3
github: FintanH/esqueleto github: bitemyapp/esqueleto
extra-source-files: extra-source-files:
- README.md - README.md
dependencies: dependencies:
- base - base
- esqueleto - esqueleto
@ -18,17 +20,22 @@ dependencies:
- monad-logger - monad-logger
- monad-control - monad-control
- transformers-base - transformers-base
- unliftio-core
ghc-options: ghc-options:
- -Wall - '-Wall'
- -threaded - '-threaded'
- -rtsopts - '-rtsopts'
- -with-rtsopts=-N - '-with-rtsopts=-N'
when: when:
- condition: flag(werror) - condition: flag(werror)
ghc-options: -Werror ghc-options: '-Werror'
executables: executables:
blog-example: blog-example:
other-modules:
- Blog
main: Main.hs main: Main.hs
flags: flags:

3
src/Database/Esqueleto/Internal/Internal.hs
View File

@ -730,8 +730,9 @@ case_ = unsafeSqlCase
-- Bar -- Bar
-- barNum Int -- barNum Int
-- Foo -- Foo
-- Id BarId -- bar BarId
-- fooNum Int -- fooNum Int
-- Primary bar
-- @ -- @
-- --
-- For this example, declare: -- For this example, declare:

41
stack-8.2.yaml
View File

@ -1,26 +1,25 @@
resolver: lts-10.6 resolver: lts-10.6
packages: packages:
- '.' - '.'
# - examples
extra-deps: extra-deps:
- aeson-1.4.1.0 - aeson-1.4.1.0
- aeson-compat-0.3.8 - aeson-compat-0.3.8
- attoparsec-0.13.2.2 - attoparsec-0.13.2.2
- case-insensitive-1.2.0.11 - case-insensitive-1.2.0.11
- conduit-1.3.0 - conduit-1.3.0
- conduit-extra-1.3.0 - conduit-extra-1.3.0
- hashable-1.2.7.0 - hashable-1.2.7.0
- monad-logger-0.3.28.1 - monad-logger-0.3.28.1
- persistent-2.10.0 - persistent-2.10.0
- persistent-mysql-2.10.0 - persistent-mysql-2.10.0
- persistent-postgresql-2.10.0 - persistent-postgresql-2.10.0
- persistent-sqlite-2.10.0 - persistent-sqlite-2.10.0
- persistent-template-2.7.0 - persistent-template-2.7.0
- postgresql-libpq-0.9.4.2 - postgresql-libpq-0.9.4.2
- postgresql-simple-0.6.1 - postgresql-simple-0.6.1
- resourcet-1.2.0 - resourcet-1.2.0
- scientific-0.3.6.2 - scientific-0.3.6.2
- text-1.2.3.0 - text-1.2.3.0
- unliftio-0.2.0.0 - unliftio-0.2.0.0

21
stack-8.4.yaml
View File

@ -1,16 +1,15 @@
resolver: lts-12.2 resolver: lts-12.2
packages: packages:
- '.' - '.'
extra-deps: extra-deps:
- aeson-1.4.1.0 - aeson-1.4.1.0
- persistent-2.10.0 - persistent-2.10.0
- persistent-postgresql-2.10.0 - persistent-postgresql-2.10.0
- persistent-sqlite-2.10.0 - persistent-sqlite-2.10.0
- persistent-mysql-2.10.0 - persistent-mysql-2.10.0
- persistent-template-2.7.0 - persistent-template-2.7.0
- postgresql-libpq-0.9.4.2 - postgresql-libpq-0.9.4.2
- postgresql-simple-0.6.1 - postgresql-simple-0.6.1
- transformers-0.5.5.2 - transformers-0.5.5.2
allow-newer: true

15
stack-8.6.yaml
View File

@ -1,12 +1,13 @@
resolver: lts-13.6 resolver: lts-13.6
packages: packages:
- '.' - '.'
- 'examples'
extra-deps: extra-deps:
- persistent-2.10.0 - persistent-2.10.0
- persistent-template-2.7.0 - persistent-template-2.7.0
- persistent-mysql-2.10.0 - persistent-mysql-2.10.0
- persistent-postgresql-2.10.0 - persistent-postgresql-2.10.0
- postgresql-simple-0.6.1 - persistent-sqlite-2.10.0
- persistent-sqlite-2.10.0 - postgresql-simple-0.6.1

2
test/PostgreSQL/Test.hs
View File

@ -1057,7 +1057,7 @@ migrateIt = do
withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a
withConn = withConn =
R.runResourceT . withPostgresqlConn "host=localhost port=5433 user=esqutest password=esqutest dbname=esqutest" R.runResourceT . withPostgresqlConn "host=localhost port=5432 user=esqutest password=esqutest dbname=esqutest"
-- | Show the SQL generated by a query -- | Show the SQL generated by a query
showQuery :: (Monad m, ES.SqlSelect a r, BackendCompatible SqlBackend backend) showQuery :: (Monad m, ES.SqlSelect a r, BackendCompatible SqlBackend backend)