Allow ‘persistent-2.6’ and ‘base-4.9’

This commit is contained in:
mrkkrp 2017-01-11 00:50:56 +03:00
parent 42bcb97f41
commit eaa7c1057f
7 changed files with 28 additions and 42 deletions

View File

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

View File

@ -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

View File

@ -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

View File

@ -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, (=.), (+=.), (-=.), (*=.), (/=.)
, (==.), (!=.), (<.), (>.), (<=.), (>=.), (<-.), (/<-.), (||.)

View File

@ -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) =>

View File

@ -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

View File

@ -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