Merge pull request #109 from bitemyapp/matt/prepare-for-release

Prepare for release

.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:

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

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

src/Database/Esqueleto/Internal/Sql.hs

@@ -987,27 +987,21 @@ deleteCount = rawEsqueleto DELETE
 -- @
 update
   ::
-  ( PersistEntityBackend val ~ backend
+  ( MonadIO m, PersistEntity val
-  , PersistEntity val
+  , BackendCompatible SqlBackend (PersistEntityBackend val)
-  , PersistUniqueWrite backend
-  , PersistQueryWrite backend
-  , BackendCompatible SqlBackend backend
-  , PersistEntity val
-  , MonadIO m
   )
   => (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
+updateCount
-               , PersistEntity val
+  ::
-               , PersistEntityBackend val ~ backend
+  ( MonadIO m, PersistEntity val
-               , BackendCompatible SqlBackend backend
+  , BackendCompatible SqlBackend (PersistEntityBackend val)
-               , PersistQueryWrite backend
+  )
-               , PersistUniqueWrite backend)
+  => (SqlExpr (Entity val) -> SqlQuery ())
-            => (SqlExpr (Entity val) -> SqlQuery ())
+  -> SqlWriteT m Int64
-            -> R.ReaderT backend m Int64
 updateCount = rawEsqueleto UPDATE . from
 
 

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

test/expected-compile-failures/.gitignore

@@ -0,0 +1,3 @@
+.stack-work/
+expected-compile-failures.cabal
+*~

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.

test/expected-compile-failures/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

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 <https://github.com/bitemyapp/esqueleto/test/expected-compile-failures#readme>
+
+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

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
+|]
+
+

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

test/expected-compile-failures/stack-8.4.yaml

@@ -0,0 +1,5 @@
+resolver: lts-12.24
+
+packages:
+- .
+- ../../../esqueleto

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

test/expected-compile-failures/stack.yaml

@@ -0,0 +1,5 @@
+resolver: lts-12.24
+
+packages:
+- .
+- ../../../esqueleto

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

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

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