diff --git a/examples/.gitignore b/examples/.gitignore new file mode 100644 index 0000000..d43d807 --- /dev/null +++ b/examples/.gitignore @@ -0,0 +1 @@ +*.cabal diff --git a/examples/Blog.hs b/examples/Blog.hs index 38ecc05..c593c6d 100644 --- a/examples/Blog.hs +++ b/examples/Blog.hs @@ -9,8 +9,8 @@ module Blog ( runBlogT ) where -------------------------------------------------------------------------------- import Control.Monad.Base (MonadBase (..)) +import Control.Monad.IO.Unlift (MonadUnliftIO(..), wrappedWithRunInIO) import Control.Monad.Logger (MonadLogger, NoLoggingT (..)) import Control.Monad.Reader import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..), @@ -18,30 +18,32 @@ import Control.Monad.Trans.Control (ComposeSt, MonadBaseControl (..), defaultLiftBaseWith, defaultRestoreM) import Database.Persist.Postgresql (ConnectionString) -------------------------------------------------------------------------------- - 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 lift = BlogT . lift . lift -------------------------------------------------------------------------------- deriving instance (MonadBase b m) => MonadBase b (BlogT m) -------------------------------------------------------------------------------- instance MonadBaseControl b m => MonadBaseControl b (BlogT m) where type StM (BlogT m) a = ComposeSt BlogT m a liftBaseWith = defaultLiftBaseWith restoreM = defaultRestoreM -------------------------------------------------------------------------------- instance MonadTransControl BlogT where type StT BlogT a = StT NoLoggingT (StT (ReaderT ConnectionString) a) liftWith f = BlogT $ liftWith $ \run -> @@ -50,7 +52,6 @@ instance MonadTransControl BlogT where restoreT = BlogT . restoreT . restoreT -------------------------------------------------------------------------------- runBlogT :: ConnectionString -> BlogT m a -> m a runBlogT backend (BlogT m) = runReaderT (runNoLoggingT m) backend diff --git a/examples/Main.hs b/examples/Main.hs index cb2e00a..d1dd822 100644 --- a/examples/Main.hs +++ b/examples/Main.hs @@ -9,17 +9,18 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} module Main ( main ) where -------------------------------------------------------------------------------- import Blog import Control.Monad (void) import Control.Monad (forM_) import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.IO.Unlift (MonadUnliftIO) import Control.Monad.Logger (MonadLogger) import Control.Monad.Reader (MonadReader (..), runReaderT) import Control.Monad.Trans.Control (MonadBaseControl) @@ -27,10 +28,15 @@ import Data.Monoid ((<>)) import Database.Esqueleto import Database.Persist.Postgresql (ConnectionString, withPostgresqlConn) -import Database.Persist.TH (mkDeleteCascade, mkMigrate, - mkPersist, persistLowerCase, - share, sqlSettings) -------------------------------------------------------------------------------- +import Database.Persist.TH ( AtLeastOneUniqueKey(..) + , OnlyOneUniqueKey(..) + , mkDeleteCascade + , mkMigrate + , mkPersist + , persistLowerCase + , share + , sqlSettings + ) share [ mkPersist sqlSettings @@ -50,8 +56,6 @@ share [ mkPersist sqlSettings deriving Eq Show |] - -------------------------------------------------------------------------------- putPersons :: (MonadIO m, MonadLogger m) => SqlPersistT m () putPersons = do @@ -65,7 +69,6 @@ putPersons = do liftIO $ mapM_ (putStrLn . ("Name: " ++) . personName . entityVal) people -------------------------------------------------------------------------------- getJohns :: (MonadIO m, MonadLogger m) => SqlReadT m [Entity Person] getJohns = @@ -76,7 +79,6 @@ getJohns = return p -------------------------------------------------------------------------------- getAdults :: (MonadIO m, MonadLogger m) => SqlReadT m [Entity Person] getAdults = @@ -87,7 +89,6 @@ getAdults = return p -------------------------------------------------------------------------------- getBlogPostsByAuthors :: (MonadIO m, MonadLogger m) => SqlReadT m [(Entity BlogPost, Entity Person)] getBlogPostsByAuthors = @@ -99,7 +100,6 @@ getBlogPostsByAuthors = return (b, p) -------------------------------------------------------------------------------- getAuthorMaybePosts :: (MonadIO m, MonadLogger m) => SqlReadT m [(Entity Person, Maybe (Entity BlogPost))] getAuthorMaybePosts = @@ -113,7 +113,6 @@ getAuthorMaybePosts = return (p, mb) -------------------------------------------------------------------------------- followers :: (MonadIO m, MonadLogger m) => SqlReadT m [(Entity Person, Entity Follow, Entity Person)] followers = @@ -128,7 +127,6 @@ followers = return (p1, f, p2) -------------------------------------------------------------------------------- updateJoao :: (MonadIO m, MonadLogger m) => SqlWriteT m () updateJoao = @@ -138,7 +136,6 @@ updateJoao = where_ (p ^. PersonName ==. val "Joao") -------------------------------------------------------------------------------- deleteYoungsters :: (MonadIO m, MonadLogger m) => SqlPersistT m () deleteYoungsters = do @@ -154,7 +151,6 @@ deleteYoungsters = do forM_ youngsters (deleteCascade . entityKey) -------------------------------------------------------------------------------- insertBlogPosts :: (MonadIO m, MonadLogger m) => SqlWriteT m () insertBlogPosts = @@ -163,10 +159,10 @@ insertBlogPosts = return $ BlogPost <# (val "Group Blog Post") <&> (p ^. PersonId) -------------------------------------------------------------------------------- runDB :: (MonadReader ConnectionString m, MonadIO m, MonadBaseControl IO m, + MonadUnliftIO m, MonadLogger m) => SqlPersistT m a -> m a runDB query = do @@ -175,7 +171,6 @@ runDB query = do withPostgresqlConn conn $ \backend -> runReaderT query backend -------------------------------------------------------------------------------- setupDb :: (MonadIO m, MonadLogger m) => SqlPersistT m () setupDb = do @@ -197,7 +192,6 @@ setupDb = do void $ insert $ Follow joao sean -------------------------------------------------------------------------------- cleanDb :: (MonadIO m, MonadLogger m) => SqlPersistT m () cleanDb = do @@ -208,7 +202,6 @@ cleanDb = do where dropTable tableName = rawExecute ("DROP TABLE " <> tableName) [] -------------------------------------------------------------------------------- main :: IO () main = do -- Connection string for the postrgesql database diff --git a/examples/package.yaml b/examples/package.yaml index b6b1c96..7ccde97 100644 --- a/examples/package.yaml +++ b/examples/package.yaml @@ -2,12 +2,14 @@ name: esqueleto-examples version: '0.0.0.0' category: Database author: Fintan Halpenny -maintainer: fintan.halpenny@gmail.com -copyright: 2017, Chris Allen +maintainer: cma@bitemyapp.com +copyright: 2019, Chris Allen license: BSD3 -github: FintanH/esqueleto +github: bitemyapp/esqueleto + extra-source-files: - README.md + dependencies: - base - esqueleto @@ -18,17 +20,22 @@ dependencies: - monad-logger - monad-control - transformers-base +- unliftio-core + ghc-options: -- -Wall -- -threaded -- -rtsopts -- -with-rtsopts=-N +- '-Wall' +- '-threaded' +- '-rtsopts' +- '-with-rtsopts=-N' + when: -- condition: flag(werror) - ghc-options: -Werror + - condition: flag(werror) + ghc-options: '-Werror' executables: blog-example: + other-modules: + - Blog main: Main.hs flags: diff --git a/src/Database/Esqueleto/Internal/Internal.hs b/src/Database/Esqueleto/Internal/Internal.hs index 92469fa..56d164c 100644 --- a/src/Database/Esqueleto/Internal/Internal.hs +++ b/src/Database/Esqueleto/Internal/Internal.hs @@ -730,8 +730,9 @@ case_ = unsafeSqlCase -- Bar -- barNum Int -- Foo --- Id BarId +-- bar BarId -- fooNum Int +-- Primary bar -- @ -- -- For this example, declare: diff --git a/stack-8.2.yaml b/stack-8.2.yaml index d2e6d69..3577eef 100644 --- a/stack-8.2.yaml +++ b/stack-8.2.yaml @@ -1,26 +1,25 @@ resolver: lts-10.6 packages: -- '.' -# - examples + - '.' extra-deps: -- aeson-1.4.1.0 -- aeson-compat-0.3.8 -- attoparsec-0.13.2.2 -- case-insensitive-1.2.0.11 -- conduit-1.3.0 -- conduit-extra-1.3.0 -- hashable-1.2.7.0 -- monad-logger-0.3.28.1 -- persistent-2.10.0 -- persistent-mysql-2.10.0 -- persistent-postgresql-2.10.0 -- persistent-sqlite-2.10.0 -- persistent-template-2.7.0 -- postgresql-libpq-0.9.4.2 -- postgresql-simple-0.6.1 -- resourcet-1.2.0 -- scientific-0.3.6.2 -- text-1.2.3.0 -- unliftio-0.2.0.0 + - aeson-1.4.1.0 + - aeson-compat-0.3.8 + - attoparsec-0.13.2.2 + - case-insensitive-1.2.0.11 + - conduit-1.3.0 + - conduit-extra-1.3.0 + - hashable-1.2.7.0 + - monad-logger-0.3.28.1 + - persistent-2.10.0 + - persistent-mysql-2.10.0 + - persistent-postgresql-2.10.0 + - persistent-sqlite-2.10.0 + - persistent-template-2.7.0 + - postgresql-libpq-0.9.4.2 + - postgresql-simple-0.6.1 + - resourcet-1.2.0 + - scientific-0.3.6.2 + - text-1.2.3.0 + - unliftio-0.2.0.0 diff --git a/stack-8.4.yaml b/stack-8.4.yaml index b700aeb..23839a7 100644 --- a/stack-8.4.yaml +++ b/stack-8.4.yaml @@ -1,16 +1,15 @@ resolver: lts-12.2 packages: -- '.' + - '.' extra-deps: -- aeson-1.4.1.0 -- persistent-2.10.0 -- persistent-postgresql-2.10.0 -- persistent-sqlite-2.10.0 -- persistent-mysql-2.10.0 -- persistent-template-2.7.0 -- postgresql-libpq-0.9.4.2 -- postgresql-simple-0.6.1 -- transformers-0.5.5.2 -allow-newer: true + - aeson-1.4.1.0 + - persistent-2.10.0 + - persistent-postgresql-2.10.0 + - persistent-sqlite-2.10.0 + - persistent-mysql-2.10.0 + - persistent-template-2.7.0 + - postgresql-libpq-0.9.4.2 + - postgresql-simple-0.6.1 + - transformers-0.5.5.2 diff --git a/stack-8.6.yaml b/stack-8.6.yaml index ce889a4..3d1a4d4 100644 --- a/stack-8.6.yaml +++ b/stack-8.6.yaml @@ -1,12 +1,13 @@ resolver: lts-13.6 packages: -- '.' + - '.' + - 'examples' extra-deps: -- persistent-2.10.0 -- persistent-template-2.7.0 -- persistent-mysql-2.10.0 -- persistent-postgresql-2.10.0 -- postgresql-simple-0.6.1 -- persistent-sqlite-2.10.0 + - persistent-2.10.0 + - persistent-template-2.7.0 + - persistent-mysql-2.10.0 + - persistent-postgresql-2.10.0 + - persistent-sqlite-2.10.0 + - postgresql-simple-0.6.1