haskell/esqueleto
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge pull request #58 from erikd/master

Browse Source 
Implement orderBy [rand] expression
This commit is contained in:
Felipe Lessa 2014-04-08 19:30:20 -03:00
commit 0f87220ce1
5 changed files with 46 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
esqueleto.cabal
View File

@ -71,7 +71,7 @@ library
, tagged >= 0.2
, monad-logger
, conduit
, conduit >= 1.1
, resourcet
hs-source-dirs: src/
ghc-options: -Wall

2
src/Database/Esqueleto.hs
View File

@ -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_
, (==.), (>=.), (>.), (<=.), (<.), (!=.), (&&.), (||.)

3
src/Database/Esqueleto/Internal/Language.hs
View File

@ -174,6 +174,9 @@ class (Functor query, Applicative query, Monad query) =>
-- | @OFFSET@. Usually used with 'limit'.
offset :: Int64 -> query ()
-- | @ORDER BY random()@ clause.
rand :: expr OrderBy
-- | @HAVING@.
--
-- /Since: 1.2.2/

5
src/Database/Esqueleto/Internal/Sql.hs
View File

@ -256,6 +256,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)
@ -322,6 +323,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) }
@ -903,7 +906,9 @@ 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"

54
test/Test.hs
View File

@ -122,8 +122,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 +138,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 $
@ -368,9 +368,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 ()
@ -530,10 +530,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 $
@ -680,7 +680,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)
@ -700,7 +700,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]))
@ -710,9 +710,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 [])
@ -722,7 +722,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)
@ -756,7 +756,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)
@ -792,9 +792,24 @@ 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
_ <- insert p1
_ <- insert p2
_ <- insert p3
_ <- insert p4
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
----------------------------------------------------------------------
@ -859,3 +874,6 @@ run_worker act =
#else
(runMigrationSilent migrateAll >>) $ act
#endif
unValue :: Value a -> a
unValue (Value a) = a