diff --git a/.travis.yml b/.travis.yml index 62f4a71..a472305 100644 --- a/.travis.yml +++ b/.travis.yml @@ -37,6 +37,8 @@ script: - stack test -- esqueleto:postgresql - stack test -- esqueleto:sqlite - stack test -- esqueleto:mysql || exit 0 # TODO: Remove that exit 0 when mysql tests are checking correctly + - cd test/expected-compile-failures/ + - bash test.sh cache: directories: diff --git a/Makefile b/Makefile index d432c26..4c75b77 100644 --- a/Makefile +++ b/Makefile @@ -23,7 +23,9 @@ test-ghci: test-ghcid: ghcid -c "stack ghci --ghci-options -fobject-code esqueleto:test:sqlite" -# sudo -u postgres createuser -s - esqueleto-test +init-pgsql: + sudo -u postgres -- createuser -s esqutest + reset-pgsql: -sudo -u postgres dropdb esqutest -sudo -u postgres dropuser esqutest diff --git a/esqueleto.cabal b/esqueleto.cabal index 1a7aab9..524adad 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: e6538d431870626b3bae78c5b1550ed237765c220c20c8eecd207e4dcd901a16 +-- hash: c5408ff1923a2a70cf9c7b5590f83d724453768845c1dd1d92888c177dfad357 name: esqueleto version: 2.6.0 @@ -30,6 +30,16 @@ source-repository head location: git://github.com/bitemyapp/esqueleto.git library + exposed-modules: + Database.Esqueleto + Database.Esqueleto.Internal.Language + Database.Esqueleto.Internal.Sql + Database.Esqueleto.MySQL + Database.Esqueleto.PostgreSQL + Database.Esqueleto.SQLite + other-modules: + Database.Esqueleto.Internal.PersistentImport + Paths_esqueleto hs-source-dirs: src/ build-depends: @@ -50,21 +60,14 @@ library ghc-options: -Wall -Wno-redundant-constraints else ghc-options: -Wall - exposed-modules: - Database.Esqueleto - Database.Esqueleto.Internal.Language - Database.Esqueleto.Internal.Sql - Database.Esqueleto.MySQL - Database.Esqueleto.PostgreSQL - Database.Esqueleto.SQLite - other-modules: - Database.Esqueleto.Internal.PersistentImport - Paths_esqueleto default-language: Haskell2010 test-suite mysql type: exitcode-stdio-1.0 main-is: MySQL/Test.hs + other-modules: + Common.Test + Paths_esqueleto hs-source-dirs: test ghc-options: -Wall @@ -89,14 +92,14 @@ test-suite mysql , transformers >=0.2 , unliftio , unordered-containers >=0.2 - other-modules: - Common.Test - Paths_esqueleto default-language: Haskell2010 test-suite postgresql type: exitcode-stdio-1.0 main-is: PostgreSQL/Test.hs + other-modules: + Common.Test + Paths_esqueleto hs-source-dirs: test ghc-options: -Wall @@ -121,14 +124,14 @@ test-suite postgresql , transformers >=0.2 , unliftio , unordered-containers >=0.2 - other-modules: - Common.Test - Paths_esqueleto default-language: Haskell2010 test-suite sqlite type: exitcode-stdio-1.0 main-is: SQLite/Test.hs + other-modules: + Common.Test + Paths_esqueleto hs-source-dirs: test ghc-options: -Wall @@ -151,7 +154,4 @@ test-suite sqlite , transformers >=0.2 , unliftio , unordered-containers >=0.2 - other-modules: - Common.Test - Paths_esqueleto default-language: Haskell2010 diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 16a24e9..7f2e0c9 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -987,27 +987,21 @@ deleteCount = rawEsqueleto DELETE -- @ update :: - ( PersistEntityBackend val ~ backend - , PersistEntity val - , PersistUniqueWrite backend - , PersistQueryWrite backend - , BackendCompatible SqlBackend backend - , PersistEntity val - , MonadIO m + ( MonadIO m, PersistEntity val + , BackendCompatible SqlBackend (PersistEntityBackend val) ) => (SqlExpr (Entity val) -> SqlQuery ()) - -> R.ReaderT backend m () + -> SqlWriteT m () update = void . updateCount -- | Same as 'update', but returns the number of rows affected. -updateCount :: ( MonadIO m - , PersistEntity val - , PersistEntityBackend val ~ backend - , BackendCompatible SqlBackend backend - , PersistQueryWrite backend - , PersistUniqueWrite backend) - => (SqlExpr (Entity val) -> SqlQuery ()) - -> R.ReaderT backend m Int64 +updateCount + :: + ( MonadIO m, PersistEntity val + , BackendCompatible SqlBackend (PersistEntityBackend val) + ) + => (SqlExpr (Entity val) -> SqlQuery ()) + -> SqlWriteT m Int64 updateCount = rawEsqueleto UPDATE . from diff --git a/test/Common/Test.hs b/test/Common/Test.hs index 34c9c87..d5cac2c 100644 --- a/test/Common/Test.hs +++ b/test/Common/Test.hs @@ -219,7 +219,6 @@ testSelect run = do liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ] - testSelectSource :: Run -> Spec testSelectSource run = do describe "selectSource" $ do @@ -1057,6 +1056,31 @@ testUpdate run = do , (Entity p3k p3, Value 7) ] +-- we only care that this compiles. check that SqlWriteT doesn't fail on +-- updates. +testSqlWriteT :: MonadIO m => SqlWriteT m () +testSqlWriteT = + update $ \p -> do + set p [ PersonAge =. just (val 6) ] + +-- we only care that this compiles. checks that the SqlWriteT monad can run +-- select queries. +testSqlWriteTRead :: MonadIO m => SqlWriteT m [(Value (Key Lord), Value Int)] +testSqlWriteTRead = + select $ + from $ \ ( lord `InnerJoin` deed ) -> do + on $ lord ^. LordId ==. deed ^. DeedOwnerId + groupBy (lord ^. LordId) + return (lord ^. LordId, count $ deed ^. DeedId) + +-- we only care that this compiles checks that SqlReadT allows +testSqlReadT :: MonadIO m => SqlReadT m [(Value (Key Lord), Value Int)] +testSqlReadT = + select $ + from $ \ ( lord `InnerJoin` deed ) -> do + on $ lord ^. LordId ==. deed ^. DeedOwnerId + groupBy (lord ^. LordId) + return (lord ^. LordId, count $ deed ^. DeedId) testListOfValues :: Run -> Spec testListOfValues run = do diff --git a/test/expected-compile-failures/.gitignore b/test/expected-compile-failures/.gitignore new file mode 100644 index 0000000..16bd5fb --- /dev/null +++ b/test/expected-compile-failures/.gitignore @@ -0,0 +1,3 @@ +.stack-work/ +expected-compile-failures.cabal +*~ \ No newline at end of file diff --git a/test/expected-compile-failures/README.md b/test/expected-compile-failures/README.md new file mode 100644 index 0000000..b04a1cd --- /dev/null +++ b/test/expected-compile-failures/README.md @@ -0,0 +1,6 @@ +# expected-compile-failures + +This subdirectory contains a stack project for expected compilation failures. To +add a new "test case", create a new `executable` stanza in the `package.yaml` +file. The Travis CI test script ([`test.sh`](test.sh)) will attempt to compile +the executable and will exit with an error if it successfully compiled. diff --git a/test/expected-compile-failures/Setup.hs b/test/expected-compile-failures/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/test/expected-compile-failures/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/test/expected-compile-failures/package.yaml b/test/expected-compile-failures/package.yaml new file mode 100644 index 0000000..f4f83e2 --- /dev/null +++ b/test/expected-compile-failures/package.yaml @@ -0,0 +1,55 @@ +name: expected-compile-failures +version: 0.1.0.0 +github: bitemyapp/esqueleto +license: BSD3 +author: Matt Parsons +maintainer: parsonsmatt@gmail.com +copyright: 2018 Matt Parsons + +extra-source-files: +- README.md + +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- esqueleto +- persistent +- persistent-template + +default-extensions: +- FlexibleContexts +- FlexibleInstances +- GADTs +- GeneralizedNewtypeDeriving +- MultiParamTypeClasses +- NoMonomorphismRestriction +- OverloadedStrings +- QuasiQuotes +- ScopedTypeVariables +- StandaloneDeriving +- TemplateHaskell +- TypeFamilies + +library: + source-dirs: src + +executables: + update-with-read-role: + main: Main.hs + source-dirs: update-read-role + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - expected-compile-failures + write-with-read-role: + main: Main.hs + source-dirs: write-read-role + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - expected-compile-failures diff --git a/test/expected-compile-failures/src/Lib.hs b/test/expected-compile-failures/src/Lib.hs new file mode 100644 index 0000000..677f7d6 --- /dev/null +++ b/test/expected-compile-failures/src/Lib.hs @@ -0,0 +1,31 @@ +module Lib where + +import Control.Monad.IO.Class (MonadIO) +import Database.Persist.Sql (SqlReadT) +import Database.Esqueleto (SqlExpr, SqlQuery, from, + val, (<#), insertSelect, (<&>), (^.)) +import Database.Esqueleto.Internal.Language (Insertion) +import Database.Persist.TH (mkDeleteCascade, + mkMigrate, mkPersist, + persistLowerCase, share, + sqlSettings) + +share [ mkPersist sqlSettings + , mkDeleteCascade sqlSettings + , mkMigrate "migrateAll"] [persistLowerCase| + Person + name String + age Int Maybe + born Int Maybe + deriving Eq Show + BlogPost + title String + authorId PersonId + deriving Eq Show + Follow + follower PersonId + followed PersonId + deriving Eq Show +|] + + diff --git a/test/expected-compile-failures/stack-8.2.yaml b/test/expected-compile-failures/stack-8.2.yaml new file mode 100644 index 0000000..40f35b2 --- /dev/null +++ b/test/expected-compile-failures/stack-8.2.yaml @@ -0,0 +1,14 @@ +resolver: lts-10.6 + +extra-deps: +- persistent-2.8.1 +- persistent-mysql-2.8.1 +- persistent-postgresql-2.8.1 +- persistent-sqlite-2.8.1 +- conduit-1.3.0 +- conduit-extra-1.3.0 +- resourcet-1.2.0 + +packages: +- . +- ../../../esqueleto diff --git a/test/expected-compile-failures/stack-8.4.yaml b/test/expected-compile-failures/stack-8.4.yaml new file mode 100644 index 0000000..87439c0 --- /dev/null +++ b/test/expected-compile-failures/stack-8.4.yaml @@ -0,0 +1,5 @@ +resolver: lts-12.24 + +packages: +- . +- ../../../esqueleto diff --git a/test/expected-compile-failures/stack-8.6.yaml b/test/expected-compile-failures/stack-8.6.yaml new file mode 100644 index 0000000..023cdae --- /dev/null +++ b/test/expected-compile-failures/stack-8.6.yaml @@ -0,0 +1,11 @@ +resolver: nightly-2018-12-18 + +extra-deps: +- persistent-postgresql-2.8.2.0 +- postgresql-simple-0.5.4.0 + +allow-newer: true + +packages: +- . +- ../../../esqueleto diff --git a/test/expected-compile-failures/stack.yaml b/test/expected-compile-failures/stack.yaml new file mode 100644 index 0000000..87439c0 --- /dev/null +++ b/test/expected-compile-failures/stack.yaml @@ -0,0 +1,5 @@ +resolver: lts-12.24 + +packages: +- . +- ../../../esqueleto diff --git a/test/expected-compile-failures/test.sh b/test/expected-compile-failures/test.sh new file mode 100644 index 0000000..9430449 --- /dev/null +++ b/test/expected-compile-failures/test.sh @@ -0,0 +1,14 @@ +#!/bin/env bash + +# This script attempts to build each executable in the package, which should all +# fail with a compiler error. If any executable builds successfully, then we exit +# the script. + +# We have to use 2>&1 because `stack ide targets` outputs to stderr for some +# reason. +for target in $(stack ide targets 2>&1 | grep exe); do + echo "Building target: $target" + if stack build --fast $target; then + exit 1 + fi +done diff --git a/test/expected-compile-failures/update-read-role/Main.hs b/test/expected-compile-failures/update-read-role/Main.hs new file mode 100644 index 0000000..d4160f4 --- /dev/null +++ b/test/expected-compile-failures/update-read-role/Main.hs @@ -0,0 +1,25 @@ +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + +module Main where + +import Control.Monad.IO.Class (MonadIO) +import Database.Esqueleto +import Database.Esqueleto.Internal.Language (Insertion) +import Database.Persist.Sql (SqlWriteT) +import Database.Persist.TH (mkDeleteCascade, + mkMigrate, mkPersist, + persistLowerCase, share, + sqlSettings) + +import Lib + +main :: IO () +main = pure () + +updateQuery :: SqlExpr (Entity Person) -> SqlQuery () +updateQuery = \p -> do + set p [ PersonAge =. just (val 123) -. p ^. PersonBorn ] + where_ $ isNothing (p ^. PersonAge) + +shouldFail :: MonadIO m => SqlReadT m () +shouldFail = update updateQuery diff --git a/test/expected-compile-failures/write-read-role/Main.hs b/test/expected-compile-failures/write-read-role/Main.hs new file mode 100644 index 0000000..bd8b7e8 --- /dev/null +++ b/test/expected-compile-failures/write-read-role/Main.hs @@ -0,0 +1,27 @@ +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + +module Main where + +import Control.Monad.IO.Class (MonadIO) +import Database.Esqueleto (SqlExpr, SqlQuery, from, + insertSelect, val, (<#), + (<&>), (^.)) +import Database.Esqueleto.Internal.Language (Insertion) +import Database.Persist.Sql (SqlReadT) +import Database.Persist.TH (mkDeleteCascade, + mkMigrate, mkPersist, + persistLowerCase, share, + sqlSettings) + +import Lib + +main :: IO () +main = pure () + +insertQuery :: SqlQuery (SqlExpr (Insertion BlogPost)) +insertQuery = + from $ \p -> + return $ BlogPost <# (val "Group Blog Post") <&> (p ^. PersonId) + +shouldFail :: MonadIO m => SqlReadT m () +shouldFail = insertSelect insertQuery