From eaa7c1057f7586acd252c7eac2ae62f04a34f331 Mon Sep 17 00:00:00 2001 From: mrkkrp Date: Wed, 11 Jan 2017 00:50:56 +0300 Subject: [PATCH] =?UTF-8?q?Allow=20=E2=80=98persistent-2.6=E2=80=99=20and?= =?UTF-8?q?=20=E2=80=98base-4.9=E2=80=99?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .travis.yml | 10 +++--- esqueleto.cabal | 9 +++-- src/Database/Esqueleto/Internal/Language.hs | 2 -- .../Esqueleto/Internal/PersistentImport.hs | 2 +- src/Database/Esqueleto/Internal/Sql.hs | 33 ++++++++----------- stack-8.0.yaml | 4 +-- test/Test.hs | 10 ++---- 7 files changed, 28 insertions(+), 42 deletions(-) diff --git a/.travis.yml b/.travis.yml index 1dd5b62..ae66637 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,3 +1,5 @@ +language: c + sudo: false services: @@ -13,15 +15,13 @@ addons: env: - GHCVER=7.10 - # - GHCVER=8.0 # ehhh + - GHCVER=8.0 install: - # stack - export STACK_YAML=stack-$GHCVER.yaml - mkdir -p ~/.local/bin - - travis_retry curl -L https://github.com/commercialhaskell/stack/releases/download/v0.1.4.0/stack-0.1.4.0-x86_64-linux.tar.gz | tar -xvzf - - - mv stack ~/.local/bin - - export PATH=~/.local/bin:$PATH + - export PATH=$HOME/.local/bin:$PATH + - travis_retry curl -L https://www.stackage.org/stack/linux-x86_64 | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' - stack --version script: diff --git a/esqueleto.cabal b/esqueleto.cabal index d40015f..49e683a 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -63,10 +63,10 @@ library other-modules: Database.Esqueleto.Internal.PersistentImport build-depends: - base >= 4.5 && < 4.9 + base >= 4.5 && < 5.0 , bytestring , text >= 0.11 && < 1.3 - , persistent >= 2.5 && < 2.6 + , persistent >= 2.5 && < 2.7 , transformers >= 0.2 , unordered-containers >= 0.2 , tagged >= 0.2 @@ -76,7 +76,10 @@ library , resourcet >= 1.1 , blaze-html hs-source-dirs: src/ - ghc-options: -Wall + if impl(ghc >= 8.0) + ghc-options: -Wall -Wno-redundant-constraints + else + ghc-options: -Wall test-suite test type: exitcode-stdio-1.0 diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index 0dd4ce8..b3188da 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -44,7 +44,6 @@ module Database.Esqueleto.Internal.Language , else_ ) where -import Control.Applicative (Applicative(..), (<$>)) import Control.Exception (Exception) import Data.Int (Int64) import Data.Typeable (Typeable) @@ -52,7 +51,6 @@ import Database.Esqueleto.Internal.PersistentImport import Text.Blaze.Html (Html) import qualified Data.ByteString as B -import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Lazy as TL diff --git a/src/Database/Esqueleto/Internal/PersistentImport.hs b/src/Database/Esqueleto/Internal/PersistentImport.hs index 4cd7a57..0475e31 100644 --- a/src/Database/Esqueleto/Internal/PersistentImport.hs +++ b/src/Database/Esqueleto/Internal/PersistentImport.hs @@ -5,7 +5,7 @@ module Database.Esqueleto.Internal.PersistentImport ) where import Database.Persist.Sql hiding - ( BackendSpecificFilter, Filter(..), PersistQuery(..), SelectOpt(..) + ( BackendSpecificFilter, Filter(..), PersistQuery, SelectOpt(..) , Update(..), delete, deleteWhereCount, updateWhereCount, selectList , selectKeysList, deleteCascadeWhere, (=.), (+=.), (-=.), (*=.), (/=.) , (==.), (!=.), (<.), (>.), (<=.), (>=.), (<-.), (/<-.), (||.) diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 24beb9a..97779c2 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -51,17 +51,16 @@ module Database.Esqueleto.Internal.Sql , veryUnsafeCoerceSqlExprValueList ) where -import Control.Applicative (Applicative(..), (<$>), (<$)) import Control.Arrow ((***), first) import Control.Exception (throw, throwIO) -import Control.Monad (ap, MonadPlus(..), liftM) +import Control.Monad (ap, MonadPlus(..), join, void) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Resource (MonadResource) import Data.Acquire (with, allocateAcquire, Acquire) import Data.Int (Int64) import Data.List (intersperse) -import Data.Monoid (Last(..), Monoid(..), (<>)) +import Data.Monoid (Last(..), (<>)) import Data.Proxy (Proxy(..)) import Database.Esqueleto.Internal.PersistentImport import Database.Persist.Sql.Util (entityColumnNames, entityColumnCount, parseEntityValues, isIdField, hasCompositeKey) @@ -648,7 +647,7 @@ unsafeSqlBinOpComposite op sep a b = ERaw Parens $ compose (listify a) (listify deconstruct :: (TLB.Builder, [PersistValue]) -> ([TLB.Builder], [PersistValue]) deconstruct ("?", [PersistList vals]) = (replicate (length vals) "?", vals) - deconstruct (b, []) = (TLB.fromLazyText <$> TL.splitOn "," (TLB.toLazyText b), []) + deconstruct (b', []) = (TLB.fromLazyText <$> TL.splitOn "," (TLB.toLazyText b'), []) deconstruct x = err $ "cannot deconstruct " ++ show x ++ "." compose f1 f2 info @@ -667,7 +666,7 @@ unsafeSqlBinOpComposite op sep a b = ERaw Parens $ compose (listify a) (listify -- | (Internal) A raw SQL value. The same warning from -- 'unsafeSqlBinOp' applies to this function as well. unsafeSqlValue :: TLB.Builder -> SqlExpr (Value a) -unsafeSqlValue v = ERaw Never $ \_ -> (v, mempty) +unsafeSqlValue v = ERaw Never $ const (v, mempty) {-# INLINE unsafeSqlValue #-} @@ -784,12 +783,9 @@ selectSource :: ( SqlSelect a r , MonadResource m ) => SqlQuery a -> C.Source (SqlPersistT m) r -selectSource query = do - src <- lift $ do - res <- rawSelectSource SELECT query - fmap snd $ allocateAcquire res - src - +selectSource query = join . lift $ do + res <- rawSelectSource SELECT query + snd <$> allocateAcquire res -- | Execute an @esqueleto@ @SELECT@ query inside @persistent@'s -- 'SqlPersistT' monad and return a list of rows. @@ -910,8 +906,7 @@ rawEsqueleto mode query = do delete :: ( MonadIO m ) => SqlQuery () -> SqlWriteT m () -delete = liftM (const ()) . deleteCount - +delete = void . deleteCount -- | Same as 'delete', but returns the number of rows affected. deleteCount :: ( MonadIO m ) @@ -936,8 +931,7 @@ update :: ( MonadIO m , SqlEntity val ) => (SqlExpr (Entity val) -> SqlQuery ()) -> SqlWriteT m () -update = liftM (const ()) . updateCount - +update = void . updateCount -- | Same as 'update', but returns the number of rows affected. updateCount :: ( MonadIO m @@ -1037,7 +1031,7 @@ makeSelect info mode_ distinctClause ret = process mode_ DistinctOn exprs -> first (("SELECT DISTINCT ON (" <>) . (<> ") ")) $ uncommas' (processExpr <$> exprs) where processExpr (EDistinctOn f) = materializeExpr info f - withCols v = v <> (sqlSelectCols info ret) + withCols v = v <> sqlSelectCols info ret plain v = (v, []) @@ -1122,7 +1116,7 @@ makeOrderBy info os = first ("\nORDER BY " <>) . uncommas' $ concatMap mk os let fs = f info vals = repeat [] in zip (map (<> orderByType t) fs) vals - mk EOrderRandom = [first ((<> "RANDOM()")) mempty] + mk EOrderRandom = [first (<> "RANDOM()") mempty] orderByType ASC = " ASC" orderByType DESC = " DESC" @@ -1215,8 +1209,7 @@ instance PersistEntity a => SqlSelect (SqlExpr (Entity a)) (Entity a) where in (process ed, mempty) sqlSelectColCount = entityColumnCount . entityDef . getEntityVal sqlSelectProcessRow = parseEntityValues ed - where ed = entityDef $ getEntityVal $ (Proxy :: Proxy (SqlExpr (Entity a))) - + where ed = entityDef $ getEntityVal (Proxy :: Proxy (SqlExpr (Entity a))) getEntityVal :: Proxy (SqlExpr (Entity a)) -> Proxy a getEntityVal = const Proxy @@ -1749,7 +1742,7 @@ to16 ((a,b),(c,d),(e,f),(g,h),(i,j),(k,l),(m,n),(o,p)) = (a,b,c,d,e,f,g,h,i,j,k, -- /Since: 2.4.2/ insertSelect :: (MonadIO m, PersistEntity a) => SqlQuery (SqlExpr (Insertion a)) -> SqlWriteT m () -insertSelect = liftM (const ()) . insertSelectCount +insertSelect = void . insertSelectCount -- | Insert a 'PersistField' for every selected value, return the count afterward insertSelectCount :: (MonadIO m, PersistEntity a) => diff --git a/stack-8.0.yaml b/stack-8.0.yaml index 18aa3f7..a12a96f 100644 --- a/stack-8.0.yaml +++ b/stack-8.0.yaml @@ -1,10 +1,9 @@ -flags: {} +resolver: nightly-2017-01-10 packages: - '.' extra-deps: - doctest-prop-0.2.0.1 - quickcheck-properties-0.1 - # - http-client-0.5.0 # - fail-4.9.0.0 # - http-types-0.9 @@ -13,4 +12,3 @@ extra-deps: # - semigroups-0.18.0.1 # - uri-bytestring-0.1.9 # - temporary-resourcet-0.1.0.0 -resolver: nightly-2016-08-20 diff --git a/test/Test.hs b/test/Test.hs index 619e539..795ad03 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -18,18 +18,13 @@ #-} module Main (main) where -import Control.Applicative ((<$>)) -import Control.Arrow ((&&&)) -import Control.Exception (IOException) import Control.Monad (forM_, replicateM, replicateM_, void) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT) import Control.Monad.Trans.Control (MonadBaseControl(..)) import Control.Monad.Trans.Reader (ReaderT) import Data.Char (toLower, toUpper) -import Data.List (sortBy) import Data.Monoid ((<>)) -import Data.Ord (comparing) import Database.Esqueleto #if defined (WITH_POSTGRESQL) import Database.Persist.Postgresql (withPostgresqlConn) @@ -53,7 +48,6 @@ import qualified Control.Monad.Trans.Resource as R import qualified Data.List as L import qualified Data.Set as S import qualified Data.Text.Lazy.Builder as TLB -import qualified Database.Esqueleto.PostgreSQL as EP import qualified Database.Esqueleto.Internal.Sql as EI @@ -154,7 +148,7 @@ main = do it "works for a single NULL value" $ run $ do - ret <- select $ return $ nothing + ret <- select $ return nothing liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ] describe "select/from" $ do @@ -289,7 +283,7 @@ main = do number = 101 Right thePk = keyFromValues [toPersistValue number] fcPk <- insert fc - [Entity _ ret] <- select $ from $ return + [Entity _ ret] <- select $ from return liftIO $ do ret `shouldBe` fc fcPk `shouldBe` thePk