diff --git a/.gitignore b/.gitignore index 4e5c416..a64d82e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,4 @@ /dist* *~ +.cabal-sandbox/ +cabal.sandbox.config diff --git a/esqueleto.cabal b/esqueleto.cabal index 2dfcb67..052331b 100644 --- a/esqueleto.cabal +++ b/esqueleto.cabal @@ -1,38 +1,37 @@ name: esqueleto version: 2.0.0 -synopsis: Bare bones, type-safe EDSL for SQL queries on persistent backends. +synopsis: Type-safe EDSL for SQL queries on persistent backends. homepage: https://github.com/meteficha/esqueleto license: BSD3 license-file: LICENSE author: Felipe Lessa maintainer: felipe.lessa@gmail.com -copyright: (c) 2012 Felipe Almeida Lessa +copyright: (c) 2012-2014 Felipe Almeida Lessa category: Database build-type: Simple cabal-version: >=1.8 description: - @persistent@ is a library for type-safe data serialization. It - has many kinds of backends, such as SQL backends - (@persistent-mysql@, @persistent-postgresql@, - @persistent-sqlite@) and NoSQL backends (@persistent-mongoDB@). - . - While @persistent@ is a nice library for storing and retrieving - records, currently it has a poor interface for SQL backends - compared to SQL itself. For example, it's extremely hard to do - a type-safe @JOIN@ on a many-to-one relation, and simply - impossible to do any other kinds of @JOIN@s (including for the - very common many-to-many relations). Users have the option of - writing raw SQL, but that's error prone and not type-checked. - . @esqueleto@ is a bare bones, type-safe EDSL for SQL queries that works with unmodified @persistent@ SQL backends. Its - language closely resembles SQL, so (a) you don't have to learn - new concepts, just new syntax, and (b) it's fairly easy to + language closely resembles SQL, so you don't have to learn + new concepts, just new syntax, and it's fairly easy to predict the generated SQL and optimize it for your backend. Most kinds of errors committed when writing SQL are caught as compile-time errors---although it is possible to write type-checked @esqueleto@ queries that fail at runtime. . + @persistent@ is a library for type-safe data serialization. It + has many kinds of backends, such as SQL backends + (@persistent-mysql@, @persistent-postgresql@, + @persistent-sqlite@) and NoSQL backends (@persistent-mongoDB@). + While @persistent@ is a nice library for storing and retrieving + records, including with filters, it does not try to support + some of the features that are specific to SQL backends. In + particular, @esqueleto@ is the recommended library for + type-safe @JOIN@s on @persistent@ SQL backends. (The + alternative is using raw SQL, but that's error prone and does + not offer any composability.) + . Currently, @SELECT@s, @UPDATE@s, @INSERT@s and @DELETE@s are supported. Not all SQL features are available, but most of them can be easily added (especially functions), so please open an issue or send a pull request if @@ -63,15 +62,15 @@ library other-modules: Database.Esqueleto.Internal.PersistentImport build-depends: - base >= 4.5 && < 4.7 - , text == 0.11.* + base >= 4.5 && < 4.8 + , text >= 0.11 , persistent >= 2.0 && < 2.1 , transformers >= 0.2 , unordered-containers >= 0.2 , tagged >= 0.2 , monad-logger - , conduit + , conduit >= 1.1 , resourcet >= 1.1 hs-source-dirs: src/ ghc-options: -Wall @@ -84,13 +83,14 @@ test-suite test build-depends: -- Library dependencies used on the tests. No need to -- specify versions since they'll use the same as above. - base, persistent, transformers, conduit, text + base, persistent, transformers, resourcet, text -- Test-only dependencies + , conduit >= 1.1 , containers , HUnit , QuickCheck - , hspec >= 1.3 && < 1.8 + , hspec >= 1.8 , persistent-sqlite >= 2.0 && < 2.1 , persistent-template >= 2.0 && < 2.1 , monad-control @@ -114,4 +114,3 @@ test-suite test , persistent-mysql >= 2.0 cpp-options: -DWITH_MYSQL - diff --git a/src/Database/Esqueleto.hs b/src/Database/Esqueleto.hs index d6cf63c..4c78a71 100644 --- a/src/Database/Esqueleto.hs +++ b/src/Database/Esqueleto.hs @@ -38,7 +38,7 @@ module Database.Esqueleto -- $gettingstarted -- * @esqueleto@'s Language - Esqueleto( where_, on, groupBy, orderBy, asc, desc, limit, offset, having + Esqueleto( where_, on, groupBy, orderBy, rand, asc, desc, limit, offset, having , sub_select, sub_selectDistinct, (^.), (?.) , val, isNothing, just, nothing, joinV, countRows, count, not_ , (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.) @@ -51,6 +51,7 @@ module Database.Esqueleto , set, (=.), (+=.), (-=.), (*=.), (/=.) ) , from , Value(..) + , unValue , ValueList(..) , OrderBy -- ** Joins @@ -239,7 +240,7 @@ import qualified Database.Persist -- -- Since @age@ is an optional @Person@ field, we use 'just' lift -- @val 18 :: SqlExpr (Value Int)@ into @just (val 18) :: --- SqlExpr (Value (Just Int))@. +-- SqlExpr (Value (Maybe Int))@. -- -- Implicit joins are represented by tuples. For example, to get -- the list of all blog posts and their authors, we could write: diff --git a/src/Database/Esqueleto/Internal/Language.hs b/src/Database/Esqueleto/Internal/Language.hs index ac398b2..b71f066 100644 --- a/src/Database/Esqueleto/Internal/Language.hs +++ b/src/Database/Esqueleto/Internal/Language.hs @@ -16,6 +16,7 @@ module Database.Esqueleto.Internal.Language Esqueleto(..) , from , Value(..) + , unValue , ValueList(..) , SomeValue(..) , ToSomeValues(..) @@ -174,6 +175,11 @@ class (Functor query, Applicative query, Monad query) => -- | @OFFSET@. Usually used with 'limit'. offset :: Int64 -> query () + -- | @ORDER BY random()@ clause. + -- + -- /Since: 1.3.10/ + rand :: expr OrderBy + -- | @HAVING@. -- -- /Since: 1.2.2/ @@ -237,12 +243,12 @@ class (Functor query, Applicative query, Monad query) => (*.) :: PersistField a => expr (Value a) -> expr (Value a) -> expr (Value a) - random_ :: PersistField a => expr (Value a) - round_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) - ceiling_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) - floor_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value b) + random_ :: (PersistField a, Num a) => expr (Value a) + round_ :: (PersistField a, Num a, PersistField b, Num b) => expr (Value a) -> expr (Value b) + ceiling_ :: (PersistField a, Num a, PersistField b, Num b) => expr (Value a) -> expr (Value b) + floor_ :: (PersistField a, Num a, PersistField b, Num b) => expr (Value a) -> expr (Value b) - sum_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) + sum_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value (Maybe b)) min_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) max_ :: (PersistField a) => expr (Value a) -> expr (Value (Maybe a)) avg_ :: (PersistField a, PersistField b) => expr (Value a) -> expr (Value (Maybe b)) @@ -329,13 +335,22 @@ infixr 2 ||., `InnerJoin`, `CrossJoin`, `LeftOuterJoin`, `RightOuterJoin`, `Full -- @('^.')@ or @('?.')@ to get a 'Value' from an 'Entity'. data Value a = Value a deriving (Eq, Ord, Show, Typeable) -- Note: because of GHC bug #6124 we use @data@ instead of @newtype@. +-- --- | A list of single values. There's a limited set of funcitons +-- | Unwrap a 'Value'. +-- +-- /Since: 1.4.1/ +unValue :: Value a -> a +unValue (Value a) = a + + +-- | A list of single values. There's a limited set of functions -- able to work with this data type (such as 'subList_select', -- 'valList', 'in_' and 'exists'). data ValueList a = ValueList a deriving (Eq, Ord, Show, Typeable) -- Note: because of GHC bug #6124 we use @data@ instead of @newtype@. +-- -- | A wrapper type for for any @expr (Value a)@ for all a. diff --git a/src/Database/Esqueleto/Internal/Sql.hs b/src/Database/Esqueleto/Internal/Sql.hs index 732dd03..ad695f6 100644 --- a/src/Database/Esqueleto/Internal/Sql.hs +++ b/src/Database/Esqueleto/Internal/Sql.hs @@ -1,4 +1,5 @@ {-# LANGUAGE ConstraintKinds + , EmptyDataDecls , FlexibleContexts , FlexibleInstances , FunctionalDependencies @@ -29,6 +30,7 @@ module Database.Esqueleto.Internal.Sql , unsafeSqlBinOp , unsafeSqlValue , unsafeSqlFunction + , unsafeSqlExtractSubField , UnsafeSqlFunctionArgument , rawSelectSource , runSource @@ -40,6 +42,7 @@ module Database.Esqueleto.Internal.Sql , IdentInfo , SqlSelect(..) , veryUnsafeCoerceSqlExprValue + , veryUnsafeCoerceSqlExprValueList ) where import Control.Applicative (Applicative(..), (<$>), (<$)) @@ -48,13 +51,12 @@ import Control.Exception (throw, throwIO) import Control.Monad (ap, MonadPlus(..), liftM) import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.Class (lift) -import qualified Control.Monad.Trans.Resource as Res +import qualified Control.Monad.Trans.Reader as R import Data.Int (Int64) import Data.List (intersperse) import Data.Monoid (Monoid(..), (<>)) import Data.Proxy (Proxy(..)) import Database.Esqueleto.Internal.PersistentImport -import qualified Control.Monad.Trans.Reader as R import qualified Control.Monad.Trans.State as S import qualified Control.Monad.Trans.Writer as W import qualified Data.Conduit as C @@ -63,7 +65,6 @@ import qualified Data.HashSet as HS import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB -import qualified Data.Text.Lazy.Builder.Int as TLBI import Data.Acquire (with, allocateAcquire, Acquire) import Control.Monad.Trans.Resource (MonadResource) @@ -256,6 +257,7 @@ data SqlExpr a where -- A 'SqlExpr' accepted only by 'orderBy'. EOrderBy :: OrderByType -> SqlExpr (Value a) -> SqlExpr OrderBy + EOrderRandom :: SqlExpr OrderBy -- A 'SqlExpr' accepted only by 'set'. ESet :: (SqlExpr (Entity val) -> SqlExpr (Value ())) -> SqlExpr (Update val) @@ -265,6 +267,10 @@ data SqlExpr a where -- Used by 'insertSelect'. EInsert :: Proxy a -> (IdentInfo -> (TLB.Builder, [PersistValue])) -> SqlExpr (Insertion a) + EInsertFinal :: PersistEntity a => SqlExpr (Insertion a) -> SqlExpr InsertFinal + +-- | Phantom type used to mark a @INSERT INTO@ query. +data InsertFinal data NeedParens = Parens | Never @@ -318,6 +324,8 @@ instance Esqueleto SqlQuery SqlExpr SqlBackend where asc = EOrderBy ASC desc = EOrderBy DESC + rand = EOrderRandom + limit n = Q $ W.tell mempty { sdLimitClause = Limit (Just n) Nothing } offset n = Q $ W.tell mempty { sdLimitClause = Limit Nothing (Just n) } @@ -418,7 +426,7 @@ setAux field mkVal = ESet $ \ent -> unsafeSqlBinOp " = " name (mkVal ent) where name = ERaw Never $ \info -> (fieldName info field, mempty) sub :: PersistField a => Mode -> SqlQuery (SqlExpr (Value a)) -> SqlExpr (Value a) -sub mode query = ERaw Parens $ \info -> toRawSql mode pureQuery info query +sub mode query = ERaw Parens $ \info -> toRawSql mode info query fromDBName :: IdentInfo -> DBName -> TLB.Builder fromDBName (conn, _) = TLB.fromText . connEscapeName conn @@ -476,6 +484,19 @@ unsafeSqlFunction name arg = uncommas' $ map (\(ERaw _ f) -> f info) $ toArgList arg in (name <> parens argsTLB, argsVals) +-- | (Internal) An unsafe SQL function to extract a subfield from a compound +-- field, e.g. datetime. See 'unsafeSqlBinOp' for warnings. +-- +-- Since: 1.3.6. +unsafeSqlExtractSubField :: UnsafeSqlFunctionArgument a => + TLB.Builder -> a -> SqlExpr (Value b) +unsafeSqlExtractSubField subField arg = + ERaw Never $ \info -> + let (argsTLB, argsVals) = + uncommas' $ map (\(ERaw _ f) -> f info) $ toArgList arg + in ("EXTRACT" <> parens (subField <> " FROM " <> argsTLB), argsVals) + + class UnsafeSqlFunctionArgument a where toArgList :: a -> [SqlExpr (Value ())] instance (a ~ Value b) => UnsafeSqlFunctionArgument (SqlExpr a) where @@ -500,6 +521,7 @@ instance ( UnsafeSqlFunctionArgument a toArgList = toArgList . from4 + -- | (Internal) Coerce a value's type from 'SqlExpr (Value a)' to -- 'SqlExpr (Value b)'. You should /not/ use this function -- unless you know what you're doing! @@ -536,7 +558,7 @@ rawSelectSource mode query = run conn = uncurry rawQueryRes $ first builderToText $ - toRawSql mode pureQuery (conn, initialIdentState) query + toRawSql mode (conn, initialIdentState) query massage = do mrow <- C.await @@ -649,15 +671,15 @@ runSource src = src C.$$ CL.consume -- | (Internal) Execute an @esqueleto@ statement inside -- @persistent@'s 'SqlPersistT' monad. -rawEsqueleto :: ( MonadIO m ) +rawEsqueleto :: ( MonadIO m, SqlSelect a r ) => Mode - -> SqlQuery () + -> SqlQuery a -> SqlPersistT m Int64 rawEsqueleto mode query = do conn <- R.ask uncurry rawExecuteCount $ first builderToText $ - toRawSql mode pureQuery (conn, initialIdentState) query + toRawSql mode (conn, initialIdentState) query -- | Execute an @esqueleto@ @DELETE@ query inside @persistent@'s @@ -737,8 +759,8 @@ builderToText = TL.toStrict . TLB.toLazyTextWith defaultChunkSize -- @esqueleto@, instead of manually using this function (which is -- possible but tedious), you may just turn on query logging of -- @persistent@. -toRawSql :: SqlSelect a r => Mode -> QueryType a -> IdentInfo -> SqlQuery a -> (TLB.Builder, [PersistValue]) -toRawSql mode qt (conn, firstIdentState) query = +toRawSql :: SqlSelect a r => Mode -> IdentInfo -> SqlQuery a -> (TLB.Builder, [PersistValue]) +toRawSql mode (conn, firstIdentState) query = let ((ret, sd), finalIdentState) = flip S.runState firstIdentState $ W.runWriterT $ @@ -756,36 +778,27 @@ toRawSql mode qt (conn, firstIdentState) query = -- appear on the expressions below. info = (conn, finalIdentState) in mconcat - [ makeInsert qt ret - , makeSelect info mode ret - , makeFrom info mode fromClauses - , makeSet info setClauses - , makeWhere info whereClauses - , makeGroupBy info groupByClause - , makeHaving info havingClause - , makeOrderBy info orderByClauses - , makeLimit info limitClause + [ makeInsertInto info mode ret + , makeSelect info mode ret + , makeFrom info mode fromClauses + , makeSet info setClauses + , makeWhere info whereClauses + , makeGroupBy info groupByClause + , makeHaving info havingClause + , makeOrderBy info orderByClauses + , makeLimit info limitClause orderByClauses ] -- | (Internal) Mode of query being converted by 'toRawSql'. -data Mode = SELECT | SELECT_DISTINCT | DELETE | UPDATE +data Mode = + SELECT + | SELECT_DISTINCT + | DELETE + | UPDATE + | INSERT_INTO Mode + -- ^ 'Mode' should be either 'SELECT' or 'SELECT_DISTINCT'. -newtype QueryType a = QueryType { unQueryType :: a -> TLB.Builder } - -pureQuery :: QueryType a -pureQuery = QueryType (const mempty) - -insertQuery :: PersistEntity a => QueryType (SqlExpr (Insertion a)) -insertQuery = QueryType $ \(EInsert p _)-> - let def = entityDef p - unName = TLB.fromText . unDBName - fields = uncommas $ map (unName . fieldDB) (entityFields def) - table = unName . entityDB . entityDef $ p - in "INSERT INTO " <> table <> parens fields <> "\n" - -makeInsert :: QueryType a -> a -> (TLB.Builder, [PersistValue]) -makeInsert q a = (unQueryType q a, []) uncommas :: [TLB.Builder] -> TLB.Builder uncommas = mconcat . intersperse ", " . filter (/= mempty) @@ -794,14 +807,21 @@ uncommas' :: Monoid a => [(TLB.Builder, a)] -> (TLB.Builder, a) uncommas' = (uncommas *** mconcat) . unzip +makeInsertInto :: SqlSelect a r => IdentInfo -> Mode -> a -> (TLB.Builder, [PersistValue]) +makeInsertInto info (INSERT_INTO _) ret = sqlInsertInto info ret +makeInsertInto _ _ _ = mempty + + makeSelect :: SqlSelect a r => IdentInfo -> Mode -> a -> (TLB.Builder, [PersistValue]) -makeSelect info mode ret = - case mode of - SELECT -> withCols "SELECT " - SELECT_DISTINCT -> withCols "SELECT DISTINCT " - DELETE -> plain "DELETE " - UPDATE -> plain "UPDATE " +makeSelect info mode_ ret = process mode_ where + process mode = + case mode of + SELECT -> withCols "SELECT " + SELECT_DISTINCT -> withCols "SELECT DISTINCT " + DELETE -> plain "DELETE " + UPDATE -> plain "UPDATE " + INSERT_INTO mode' -> process mode' withCols v = first (v <>) (sqlSelectCols info ret) plain v = (v, []) @@ -873,27 +893,19 @@ makeOrderBy :: IdentInfo -> [OrderByClause] -> (TLB.Builder, [PersistValue]) makeOrderBy _ [] = mempty makeOrderBy info os = first ("\nORDER BY " <>) $ uncommas' (map mk os) where + mk :: OrderByClause -> (TLB.Builder, [PersistValue]) mk (EOrderBy t (ERaw p f)) = first ((<> orderByType t) . parensM p) (f info) + mk EOrderRandom = first ((<> "RANDOM()")) mempty orderByType ASC = " ASC" orderByType DESC = " DESC" -makeLimit :: IdentInfo -> LimitClause -> (TLB.Builder, [PersistValue]) -makeLimit _ (Limit Nothing Nothing) = mempty -makeLimit _ (Limit Nothing (Just 0)) = mempty -makeLimit info (Limit ml mo) = (ret, mempty) - where - ret = TLB.singleton '\n' <> (limitTLB <> offsetTLB) - - limitTLB = - case ml of - Just l -> "LIMIT " <> TLBI.decimal l - Nothing -> TLB.fromText (connNoLimit $ fst info) - - offsetTLB = - case mo of - Just o -> " OFFSET " <> TLBI.decimal o - Nothing -> mempty +makeLimit :: IdentInfo -> LimitClause -> [OrderByClause] -> (TLB.Builder, [PersistValue]) +makeLimit (conn,_) (Limit ml mo) orderByClauses = + let limitRaw = connLimitOffset conn (v ml, v mo) hasOrderClause "\n" + hasOrderClause = not (null orderByClauses) + v = maybe 0 fromIntegral + in (TLB.fromText limitRaw, mempty) parens :: TLB.Builder -> TLB.Builder @@ -921,14 +933,25 @@ class SqlSelect a r | a -> r, r -> a where -- | Transform a row of the result into the data type. sqlSelectProcessRow :: [PersistValue] -> Either T.Text r + -- | Create @INSERT INTO@ clause instead. + sqlInsertInto :: IdentInfo -> a -> (TLB.Builder, [PersistValue]) + sqlInsertInto = error "Type does not support sqlInsertInto." --- | You may return an insertion of some PersistEntity -instance PersistEntity a => SqlSelect (SqlExpr (Insertion a)) (Insertion a) where - sqlSelectCols info (EInsert _ f) = f info - sqlSelectColCount = const 0 + +-- | @INSERT INTO@ hack. +instance SqlSelect (SqlExpr InsertFinal) InsertFinal where + sqlInsertInto info (EInsertFinal (EInsert p _)) = + let fields = uncommas $ + map (fromDBName info . fieldDB) $ + entityFields $ + entityDef p + table = fromDBName info . entityDB . entityDef $ p + in ("INSERT INTO " <> table <> parens fields <> "\n", []) + sqlSelectCols info (EInsertFinal (EInsert _ f)) = f info + sqlSelectColCount = const 0 sqlSelectProcessRow = const (Right (error msg)) where - msg = "sqlSelectProcessRow/SqlSelect (SqlExpr (Insertion a)) (Insertion a): never here" + msg = "sqlSelectProcessRow/SqlSelect/InsertionFinal: never here" -- | Not useful for 'select', but used for 'update' and 'delete'. @@ -1480,19 +1503,18 @@ 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, -- | Insert a 'PersistField' for every selected value. -insertSelect :: (MonadIO m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) => +insertSelect :: (MonadIO m, PersistEntity a) => SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () insertSelect = insertGeneralSelect SELECT -- | Insert a 'PersistField' for every unique selected value. -insertSelectDistinct :: (MonadIO m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) => +insertSelectDistinct :: (MonadIO m, PersistEntity a) => SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () insertSelectDistinct = insertGeneralSelect SELECT_DISTINCT -insertGeneralSelect :: (MonadIO m, SqlSelect (SqlExpr (Insertion a)) r, PersistEntity a) => +insertGeneralSelect :: (MonadIO m, PersistEntity a) => Mode -> SqlQuery (SqlExpr (Insertion a)) -> SqlPersistT m () -insertGeneralSelect mode query = do - conn <- R.ask - uncurry rawExecute $ first builderToText $ toRawSql mode insertQuery (conn, initialIdentState) query +insertGeneralSelect mode = + liftM (const ()) . rawEsqueleto (INSERT_INTO mode) . fmap EInsertFinal diff --git a/test/Test.hs b/test/Test.hs index ace8342..da572bc 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -21,7 +21,6 @@ import Control.Monad.Logger (MonadLogger(..), runStderrLoggingT, runNoLoggingT) import Control.Monad.Trans.Control (MonadBaseControl(..)) import Control.Monad.Trans.Reader (ReaderT) import Database.Esqueleto -import Database.Persist.Sqlite (withSqliteConn) #if defined (WITH_POSTGRESQL) import Database.Persist.Postgresql (withPostgresqlConn) #elif defined (WITH_MYSQL) @@ -31,11 +30,13 @@ import Database.Persist.MySQL ( withMySQLConn , connectUser , connectPassword , defaultConnectInfo) +#else +import Database.Persist.Sqlite (withSqliteConn) #endif import Database.Persist.TH import Test.Hspec -import qualified Data.Conduit as C +import qualified Control.Monad.Trans.Resource as R import qualified Data.Set as S import qualified Data.List as L @@ -122,8 +123,8 @@ main = do run $ do p1k <- insert p1 p2k <- insert p2 - f1k <- insert (Follow p1k p2k) - f2k <- insert (Follow p2k p1k) + _f1k <- insert (Follow p1k p2k) + _f2k <- insert (Follow p2k p1k) ret <- select $ from $ \followA -> do let subquery = @@ -138,8 +139,8 @@ main = do run $ do p1k <- insert p1 p2k <- insert p2 - f1k <- insert (Follow p1k p2k) - f2k <- insert (Follow p2k p1k) + _f1k <- insert (Follow p1k p2k) + _f2k <- insert (Follow p2k p1k) ret <- select $ from $ \followA -> do where_ $ exists $ @@ -324,7 +325,13 @@ main = do ret <- select $ from $ \p-> return $ joinV $ sum_ (p ^. PersonAge) +#if defined(WITH_POSTGRESQL) + liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Rational ) ] +#elif defined(WITH_MYSQL) + liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Double ) ] +#else liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Int) ] +#endif it "works with avg_" $ run $ do @@ -362,9 +369,9 @@ main = do it "works with random_" $ run $ do #if defined(WITH_POSTGRESQL) || defined(WITH_MYSQL) - ret <- select $ return (random_ :: SqlExpr (Value Double)) + _ <- select $ return (random_ :: SqlExpr (Value Double)) #else - ret <- select $ return (random_ :: SqlExpr (Value Int)) + _ <- select $ return (random_ :: SqlExpr (Value Int)) #endif return () @@ -524,10 +531,10 @@ main = do it "works with asc random_" $ run $ do - p1e <- insert' p1 - p2e <- insert' p2 - p3e <- insert' p3 - p4e <- insert' p4 + _p1e <- insert' p1 + _p2e <- insert' p2 + _p3e <- insert' p3 + _p4e <- insert' p4 rets <- fmap S.fromList $ replicateM 11 $ @@ -674,7 +681,7 @@ main = do it "GROUP BY works with HAVING" $ run $ do p1k <- insert p1 - p2k <- insert p2 + _p2k <- insert p2 p3k <- insert p3 replicateM_ 3 (insert $ BlogPost "" p1k) replicateM_ 7 (insert $ BlogPost "" p3k) @@ -694,7 +701,7 @@ main = do run $ do p1k <- insert p1 p2k <- insert p2 - p3k <- insert p3 + _p3k <- insert p3 ret <- select $ from $ \p -> do where_ (p ^. PersonName `in_` valList (personName <$> [p1, p2])) @@ -704,9 +711,9 @@ main = do it "IN works for valList (null list)" $ run $ do - p1k <- insert p1 - p2k <- insert p2 - p3k <- insert p3 + _p1k <- insert p1 + _p2k <- insert p2 + _p3k <- insert p3 ret <- select $ from $ \p -> do where_ (p ^. PersonName `in_` valList []) @@ -716,7 +723,7 @@ main = do it "IN works for subList_select" $ run $ do p1k <- insert p1 - p2k <- insert p2 + _p2k <- insert p2 p3k <- insert p3 _ <- insert (BlogPost "" p1k) _ <- insert (BlogPost "" p3k) @@ -750,7 +757,7 @@ main = do it "EXISTS works for subList_select" $ run $ do p1k <- insert p1 - p2k <- insert p2 + _p2k <- insert p2 p3k <- insert p3 _ <- insert (BlogPost "" p1k) _ <- insert (BlogPost "" p3k) @@ -786,9 +793,29 @@ main = do _ <- insert p3 insertSelect $ from $ \p -> do return $ BlogPost <# val "FakePost" <&> (p ^. PersonId) - ret <- select $ from (\(b::(SqlExpr (Entity BlogPost))) -> return countRows) + ret <- select $ from (\(_::(SqlExpr (Entity BlogPost))) -> return countRows) liftIO $ ret `shouldBe` [Value (3::Int)] + describe "rand works" $ do + it "returns result in random order" $ + run $ do + replicateM_ 20 $ do + _ <- insert p1 + _ <- insert p2 + _ <- insert p3 + _ <- insert p4 + _ <- insert $ Person "Jane" Nothing + _ <- insert $ Person "Mark" Nothing + _ <- insert $ Person "Sarah" Nothing + insert $ Person "Paul" Nothing + ret1 <- fmap (map unValue) $ select $ from $ \p -> do + orderBy [rand] + return (p ^. PersonId) + ret2 <- fmap (map unValue) $ select $ from $ \p -> do + orderBy [rand] + return (p ^. PersonId) + + liftIO $ (ret1 == ret2) `shouldBe` False ---------------------------------------------------------------------- @@ -802,7 +829,7 @@ insert' v = flip Entity v <$> insert v type RunDbMonad m = ( MonadBaseControl IO m, MonadIO m, MonadLogger m - , C.MonadUnsafeIO m, C.MonadThrow m ) + , R.MonadThrow m ) #if defined (WITH_POSTGRESQL) || defined (WITH_MYSQL) -- With SQLite and in-memory databases, a separate connection implies a @@ -811,7 +838,7 @@ type RunDbMonad m = ( MonadBaseControl IO m, MonadIO m, MonadLogger m -- TODO: there is certainly a better way... cleanDB :: (forall m. RunDbMonad m - => SqlPersistT (C.ResourceT m) ()) + => SqlPersistT (R.ResourceT m) ()) cleanDB = do delete $ from $ \(blogpost :: SqlExpr (Entity BlogPost))-> return () delete $ from $ \(follow :: SqlExpr (Entity Follow)) -> return () @@ -819,7 +846,7 @@ cleanDB = do #endif -run, runSilent, runVerbose :: (forall m. RunDbMonad m => SqlPersistT (C.ResourceT m) a) -> IO a +run, runSilent, runVerbose :: (forall m. RunDbMonad m => SqlPersistT (R.ResourceT m) a) -> IO a runSilent act = runNoLoggingT $ run_worker act runVerbose act = runStderrLoggingT $ run_worker act run = @@ -832,9 +859,9 @@ verbose :: Bool verbose = True -run_worker :: RunDbMonad m => SqlPersistT (C.ResourceT m) a -> m a +run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a run_worker act = - C.runResourceT . + R.runResourceT . #if defined(WITH_POSTGRESQL) withPostgresqlConn "host=localhost port=5432 user=test dbname=test" . #elif defined (WITH_MYSQL)