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