From 5ebfb3aa49bee90e22055b1ce45997427353aaaf Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Tue, 18 Dec 2018 13:08:26 -0700 Subject: [PATCH 1/6] Resolve merge --- esqueleto.cabal | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) 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 From a4376be4ae98412a09e0f346dff20bfd650088fb Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Tue, 18 Dec 2018 15:48:49 -0700 Subject: [PATCH 2/6] Make init-pgsql makefile command --- Makefile | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) 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 From 5ef82d94ac4e8a9a8162939dae2218e9b2c608d0 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Tue, 18 Dec 2018 16:05:37 -0700 Subject: [PATCH 3/6] Add test for write-read-role --- .travis.yml | 2 + test/expected-compile-failures/.gitignore | 3 ++ test/expected-compile-failures/ChangeLog.md | 3 ++ test/expected-compile-failures/LICENSE | 30 +++++++++++ test/expected-compile-failures/README.md | 1 + test/expected-compile-failures/Setup.hs | 2 + test/expected-compile-failures/package.yaml | 33 ++++++++++++ test/expected-compile-failures/src/Lib.hs | 1 + test/expected-compile-failures/stack.yaml | 5 ++ test/expected-compile-failures/test.sh | 5 ++ .../write-read-role/Main.hs | 53 +++++++++++++++++++ 11 files changed, 138 insertions(+) create mode 100644 test/expected-compile-failures/.gitignore create mode 100644 test/expected-compile-failures/ChangeLog.md create mode 100644 test/expected-compile-failures/LICENSE create mode 100644 test/expected-compile-failures/README.md create mode 100644 test/expected-compile-failures/Setup.hs create mode 100644 test/expected-compile-failures/package.yaml create mode 100644 test/expected-compile-failures/src/Lib.hs create mode 100644 test/expected-compile-failures/stack.yaml create mode 100644 test/expected-compile-failures/test.sh create mode 100644 test/expected-compile-failures/write-read-role/Main.hs 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/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/ChangeLog.md b/test/expected-compile-failures/ChangeLog.md new file mode 100644 index 0000000..12b97e7 --- /dev/null +++ b/test/expected-compile-failures/ChangeLog.md @@ -0,0 +1,3 @@ +# Changelog for expected-compile-failures + +## Unreleased changes diff --git a/test/expected-compile-failures/LICENSE b/test/expected-compile-failures/LICENSE new file mode 100644 index 0000000..e037c72 --- /dev/null +++ b/test/expected-compile-failures/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2018 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/test/expected-compile-failures/README.md b/test/expected-compile-failures/README.md new file mode 100644 index 0000000..c44e534 --- /dev/null +++ b/test/expected-compile-failures/README.md @@ -0,0 +1 @@ +# expected-compile-failures 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..c69b2d2 --- /dev/null +++ b/test/expected-compile-failures/package.yaml @@ -0,0 +1,33 @@ +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 +- ChangeLog.md + +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- esqueleto +- persistent +- persistent-template + +library: + source-dirs: src + +executables: + 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..6d85a26 --- /dev/null +++ b/test/expected-compile-failures/src/Lib.hs @@ -0,0 +1 @@ +module Lib where 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..f68ca52 --- /dev/null +++ b/test/expected-compile-failures/test.sh @@ -0,0 +1,5 @@ +#!/bin/env bash + +STACK_YAML=stack.yaml + +stack build --fast expected-compile-failures:exe:write-with-read-role && exit 1 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..6d258cd --- /dev/null +++ b/test/expected-compile-failures/write-read-role/Main.hs @@ -0,0 +1,53 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + +module Main 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) + +main :: IO () +main = pure () + +share [ mkPersist sqlSettings + , mkDeleteCascade sqlSettings + , mkMigrate "migrateAll"] [persistLowerCase| + Person + name String + age Int Maybe + deriving Eq Show + BlogPost + title String + authorId PersonId + deriving Eq Show + Follow + follower PersonId + followed PersonId + deriving Eq Show +|] + +writeQuery :: SqlQuery (SqlExpr (Insertion BlogPost)) +writeQuery = + from $ \p -> + return $ BlogPost <# (val "Group Blog Post") <&> (p ^. PersonId) + +shouldFail :: MonadIO m => SqlReadT m () +shouldFail = insertSelect writeQuery From 4541870aab627affd9c3e11deed04458e50dcea1 Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Tue, 18 Dec 2018 17:07:00 -0700 Subject: [PATCH 4/6] Add separate stack.yaml to not redownload GHC --- test/expected-compile-failures/stack-8.2.yaml | 14 ++++++++++++++ test/expected-compile-failures/stack-8.4.yaml | 5 +++++ test/expected-compile-failures/stack-8.6.yaml | 11 +++++++++++ test/expected-compile-failures/test.sh | 8 +++++--- 4 files changed, 35 insertions(+), 3 deletions(-) create mode 100644 test/expected-compile-failures/stack-8.2.yaml create mode 100644 test/expected-compile-failures/stack-8.4.yaml create mode 100644 test/expected-compile-failures/stack-8.6.yaml 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/test.sh b/test/expected-compile-failures/test.sh index f68ca52..f56db51 100644 --- a/test/expected-compile-failures/test.sh +++ b/test/expected-compile-failures/test.sh @@ -1,5 +1,7 @@ #!/bin/env bash -STACK_YAML=stack.yaml - -stack build --fast expected-compile-failures:exe:write-with-read-role && exit 1 +if stack build --fast expected-compile-failures:exe:write-with-read-role; then + exit 1 +else + exit 0 +fi From 01604be570468c7f405d42ea10491bd0d7f1a9ce Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 19 Dec 2018 09:50:10 -0700 Subject: [PATCH 5/6] Add more tests --- src/Database/Esqueleto/Internal/Sql.hs | 26 +++++------- test/Common/Test.hs | 26 +++++++++++- test/expected-compile-failures/package.yaml | 23 +++++++++++ test/expected-compile-failures/src/Lib.hs | 30 ++++++++++++++ test/expected-compile-failures/test.sh | 17 +++++--- .../update-read-role/Main.hs | 41 +++++++++++++++++++ .../write-read-role/Main.hs | 37 +++-------------- 7 files changed, 146 insertions(+), 54 deletions(-) create mode 100644 test/expected-compile-failures/update-read-role/Main.hs 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/package.yaml b/test/expected-compile-failures/package.yaml index c69b2d2..97dcc27 100644 --- a/test/expected-compile-failures/package.yaml +++ b/test/expected-compile-failures/package.yaml @@ -18,10 +18,33 @@ dependencies: - 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 diff --git a/test/expected-compile-failures/src/Lib.hs b/test/expected-compile-failures/src/Lib.hs index 6d85a26..677f7d6 100644 --- a/test/expected-compile-failures/src/Lib.hs +++ b/test/expected-compile-failures/src/Lib.hs @@ -1 +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/test.sh b/test/expected-compile-failures/test.sh index f56db51..9430449 100644 --- a/test/expected-compile-failures/test.sh +++ b/test/expected-compile-failures/test.sh @@ -1,7 +1,14 @@ #!/bin/env bash -if stack build --fast expected-compile-failures:exe:write-with-read-role; then - exit 1 -else - exit 0 -fi +# 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..149f58a --- /dev/null +++ b/test/expected-compile-failures/update-read-role/Main.hs @@ -0,0 +1,41 @@ +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + +module Main where + +import Control.Monad.IO.Class (MonadIO) +import Database.Persist.Sql (SqlWriteT) +import Database.Esqueleto + +import Database.Esqueleto.Internal.Language (Insertion) +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) + +-- Currently gives the error: +-- +-- /home/matt/Projects/esqueleto/test/expected-compile-failures/update-read-role/Main.hs:26:14 +-- : error: +-- • Couldn't match type ‘backend’ with ‘SqlBackend’ +-- arising from a use of ‘update’ +-- ‘backend’ is a rigid type variable bound by +-- the type signature for: +-- shouldFail :: SqlReadT m () +-- at update-read-role/Main.hs:26:1-31 +-- • In the expression: update updateQuery +-- In an equation for ‘shouldFail’: shouldFail = update updateQuery +-- | +-- 26 | shouldFail = update updateQuery +-- | ^^^^^^^^^^^^^^^^^^ +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 index 6d258cd..ddefd92 100644 --- a/test/expected-compile-failures/write-read-role/Main.hs +++ b/test/expected-compile-failures/write-read-role/Main.hs @@ -1,15 +1,3 @@ -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoMonomorphismRestriction #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE StandaloneDeriving #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-unused-top-binds #-} module Main where @@ -24,30 +12,15 @@ import Database.Persist.TH (mkDeleteCascade, persistLowerCase, share, sqlSettings) +import Lib + main :: IO () main = pure () -share [ mkPersist sqlSettings - , mkDeleteCascade sqlSettings - , mkMigrate "migrateAll"] [persistLowerCase| - Person - name String - age Int Maybe - deriving Eq Show - BlogPost - title String - authorId PersonId - deriving Eq Show - Follow - follower PersonId - followed PersonId - deriving Eq Show -|] - -writeQuery :: SqlQuery (SqlExpr (Insertion BlogPost)) -writeQuery = +insertQuery :: SqlQuery (SqlExpr (Insertion BlogPost)) +insertQuery = from $ \p -> return $ BlogPost <# (val "Group Blog Post") <&> (p ^. PersonId) shouldFail :: MonadIO m => SqlReadT m () -shouldFail = insertSelect writeQuery +shouldFail = insertSelect insertQuery From cecebcd2ecbf5dd9d74c7109f9fc8e04315f0d1a Mon Sep 17 00:00:00 2001 From: parsonsmatt Date: Wed, 19 Dec 2018 09:54:14 -0700 Subject: [PATCH 6/6] Clean up the test project --- test/expected-compile-failures/ChangeLog.md | 3 -- test/expected-compile-failures/LICENSE | 30 ------------------- test/expected-compile-failures/README.md | 5 ++++ test/expected-compile-failures/package.yaml | 1 - .../update-read-role/Main.hs | 22 ++------------ .../write-read-role/Main.hs | 9 +++--- 6 files changed, 13 insertions(+), 57 deletions(-) delete mode 100644 test/expected-compile-failures/ChangeLog.md delete mode 100644 test/expected-compile-failures/LICENSE diff --git a/test/expected-compile-failures/ChangeLog.md b/test/expected-compile-failures/ChangeLog.md deleted file mode 100644 index 12b97e7..0000000 --- a/test/expected-compile-failures/ChangeLog.md +++ /dev/null @@ -1,3 +0,0 @@ -# Changelog for expected-compile-failures - -## Unreleased changes diff --git a/test/expected-compile-failures/LICENSE b/test/expected-compile-failures/LICENSE deleted file mode 100644 index e037c72..0000000 --- a/test/expected-compile-failures/LICENSE +++ /dev/null @@ -1,30 +0,0 @@ -Copyright Author name here (c) 2018 - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - - * Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - * Redistributions in binary form must reproduce the above - copyright notice, this list of conditions and the following - disclaimer in the documentation and/or other materials provided - with the distribution. - - * Neither the name of Author name here nor the names of other - contributors may be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, -DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY -THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/test/expected-compile-failures/README.md b/test/expected-compile-failures/README.md index c44e534..b04a1cd 100644 --- a/test/expected-compile-failures/README.md +++ b/test/expected-compile-failures/README.md @@ -1 +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/package.yaml b/test/expected-compile-failures/package.yaml index 97dcc27..f4f83e2 100644 --- a/test/expected-compile-failures/package.yaml +++ b/test/expected-compile-failures/package.yaml @@ -8,7 +8,6 @@ copyright: 2018 Matt Parsons extra-source-files: - README.md -- ChangeLog.md description: Please see the README on GitHub at diff --git a/test/expected-compile-failures/update-read-role/Main.hs b/test/expected-compile-failures/update-read-role/Main.hs index 149f58a..d4160f4 100644 --- a/test/expected-compile-failures/update-read-role/Main.hs +++ b/test/expected-compile-failures/update-read-role/Main.hs @@ -2,17 +2,16 @@ module Main where -import Control.Monad.IO.Class (MonadIO) -import Database.Persist.Sql (SqlWriteT) +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 +import Lib main :: IO () main = pure () @@ -22,20 +21,5 @@ updateQuery = \p -> do set p [ PersonAge =. just (val 123) -. p ^. PersonBorn ] where_ $ isNothing (p ^. PersonAge) --- Currently gives the error: --- --- /home/matt/Projects/esqueleto/test/expected-compile-failures/update-read-role/Main.hs:26:14 --- : error: --- • Couldn't match type ‘backend’ with ‘SqlBackend’ --- arising from a use of ‘update’ --- ‘backend’ is a rigid type variable bound by --- the type signature for: --- shouldFail :: SqlReadT m () --- at update-read-role/Main.hs:26:1-31 --- • In the expression: update updateQuery --- In an equation for ‘shouldFail’: shouldFail = update updateQuery --- | --- 26 | shouldFail = update updateQuery --- | ^^^^^^^^^^^^^^^^^^ 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 index ddefd92..bd8b7e8 100644 --- a/test/expected-compile-failures/write-read-role/Main.hs +++ b/test/expected-compile-failures/write-read-role/Main.hs @@ -2,17 +2,18 @@ module Main where -import Control.Monad.IO.Class (MonadIO) -import Database.Persist.Sql (SqlReadT) +import Control.Monad.IO.Class (MonadIO) import Database.Esqueleto (SqlExpr, SqlQuery, from, - val, (<#), insertSelect, (<&>), (^.)) + 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 +import Lib main :: IO () main = pure ()