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

Add stylish-haskell.yaml, update spacing to 4 in configs

Browse Source
This commit is contained in:
parsonsmatt 2020-10-28 13:18:23 -06:00
parent 8adab239df
commit b5de5d81c7
3 changed files with 483 additions and 522 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
.editorconfig
View File

@ -11,8 +11,8 @@ insert_final_newline = true
[*.{hs,md,php}] [*.{hs,md,php}]
indent_style = space indent_style = space
indent_size = 2 indent_size = 4
tab_width = 2 tab_width = 4
end_of_line = lf end_of_line = lf
charset = utf-8 charset = utf-8
trim_trailing_whitespace = true trim_trailing_whitespace = true

39
.stylish-haskell.yaml Normal file
View File

@ -0,0 +1,39 @@
steps:
- imports:
align: none
list_align: with_module_name
pad_module_names: false
long_list_align: new_line_multiline
empty_list_align: inherit
list_padding: 7 # length "import "
separate_lists: false
space_surround: false
- language_pragmas:
style: vertical
align: false
remove_redundant: true
- simple_align:
cases: false
top_level_patterns: false
records: false
- trailing_whitespace: {}
indent: 4
columns: 80
newline: native
language_extensions:
- BlockArguments
- DataKinds
- DeriveGeneric
- DerivingStrategies
- DerivingVia
- ExplicitForAll
- FlexibleContexts
- MultiParamTypeClasses
- NamedFieldPuns
- OverloadedStrings
- QuantifiedConstraints
- RecordWildCards
- ScopedTypeVariables
- TemplateHaskell
- TypeApplications
- ViewPatterns

342
test/Common/Test.hs
View File

@ -1,26 +1,27 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-} {-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# OPTIONS_GHC -fno-warn-deprecations #-}
{-# LANGUAGE ConstraintKinds
, CPP, DerivingStrategies, StandaloneDeriving
, TypeApplications
, PartialTypeSignatures
, UndecidableInstances
, EmptyDataDecls
, FlexibleContexts
, FlexibleInstances
, DeriveGeneric
, GADTs
, GeneralizedNewtypeDeriving
, MultiParamTypeClasses
, OverloadedStrings
, QuasiQuotes
, Rank2Types
, TemplateHaskell
, TypeFamilies
, ScopedTypeVariables
, TypeSynonymInstances
#-}
module Common.Test module Common.Test
( tests ( tests
, testLocking , testLocking
@ -60,17 +61,18 @@ module Common.Test
, Key(..) , Key(..)
) where ) where
import Control.Monad (forM_, replicateM, replicateM_, void)
import Control.Monad.Catch (MonadCatch)
import Control.Monad.Reader (ask)
import Data.Either import Data.Either
import Data.Time import Data.Time
import Control.Monad (forM_, replicateM, replicateM_, void)
import Control.Monad.Reader (ask)
import Control.Monad.Catch (MonadCatch)
#if __GLASGOW_HASKELL__ >= 806 #if __GLASGOW_HASKELL__ >= 806
import Control.Monad.Fail (MonadFail) import Control.Monad.Fail (MonadFail)
#endif #endif
import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Logger (MonadLogger(..), NoLoggingT, runNoLoggingT) import Control.Monad.Logger (MonadLogger(..), NoLoggingT, runNoLoggingT)
import Control.Monad.Trans.Reader (ReaderT) import Control.Monad.Trans.Reader (ReaderT)
import qualified Data.Attoparsec.Text as AP
import Data.Char (toLower, toUpper) import Data.Char (toLower, toUpper)
import Data.Monoid ((<>)) import Data.Monoid ((<>))
import Database.Esqueleto import Database.Esqueleto
@ -79,18 +81,17 @@ import qualified Database.Esqueleto.Experimental as Experimental
import Database.Persist.TH import Database.Persist.TH
import Test.Hspec import Test.Hspec
import UnliftIO import UnliftIO
import qualified Data.Attoparsec.Text as AP
import Data.Conduit (ConduitT, (.|), runConduit) import Data.Conduit (ConduitT, runConduit, (.|))
import qualified Data.Conduit.List as CL import qualified Data.Conduit.List as CL
import qualified Data.List as L import qualified Data.List as L
import qualified Data.Set as S import qualified Data.Set as S
import qualified Data.Text as Text import qualified Data.Text as Text
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Internal.Lazy as TL import qualified Data.Text.Internal.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Database.Esqueleto.Internal.ExprParser as P
import qualified Database.Esqueleto.Internal.Sql as EI import qualified Database.Esqueleto.Internal.Sql as EI
import qualified UnliftIO.Resource as R import qualified UnliftIO.Resource as R
import qualified Database.Esqueleto.Internal.ExprParser as P
-- Test schema -- Test schema
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase| share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
@ -326,18 +327,17 @@ testSelect run = do
testSubSelect :: Run -> Spec testSubSelect :: Run -> Spec
testSubSelect run = do testSubSelect run = do
let let setup :: MonadIO m => SqlPersistT m ()
setup :: MonadIO m => SqlPersistT m ()
setup = do setup = do
_ <- insert $ Numbers 1 2 _ <- insert $ Numbers 1 2
_ <- insert $ Numbers 2 4 _ <- insert $ Numbers 2 4
_ <- insert $ Numbers 3 5 _ <- insert $ Numbers 3 5
_ <- insert $ Numbers 6 7 _ <- insert $ Numbers 6 7
pure () pure ()
describe "subSelect" $ do describe "subSelect" $ do
it "is safe for queries that may return multiple results" $ do it "is safe for queries that may return multiple results" $ do
let let query =
query =
from $ \n -> do from $ \n -> do
orderBy [asc (n ^. NumbersInt)] orderBy [asc (n ^. NumbersInt)]
pure (n ^. NumbersInt) pure (n ^. NumbersInt)
@ -360,8 +360,7 @@ testSubSelect run = do
v `shouldBe` [Value 1] v `shouldBe` [Value 1]
it "is safe for queries that may not return anything" $ do it "is safe for queries that may not return anything" $ do
let let query =
query =
from $ \n -> do from $ \n -> do
orderBy [asc (n ^. NumbersInt)] orderBy [asc (n ^. NumbersInt)]
limit 1 limit 1
@ -386,8 +385,7 @@ testSubSelect run = do
describe "subSelectList" $ do describe "subSelectList" $ do
it "is safe on empty databases as well as good databases" $ do it "is safe on empty databases as well as good databases" $ do
let let query =
query =
from $ \n -> do from $ \n -> do
where_ $ n ^. NumbersInt `in_` do where_ $ n ^. NumbersInt `in_` do
subSelectList $ subSelectList $
@ -408,11 +406,8 @@ testSubSelect run = do
describe "subSelectMaybe" $ do describe "subSelectMaybe" $ do
it "is equivalent to joinV . subSelect" $ do it "is equivalent to joinV . subSelect" $ do
let let query
query :: (SqlQuery (SqlExpr (Value (Maybe Int))) -> SqlExpr (Value (Maybe Int)))
:: ( SqlQuery (SqlExpr (Value (Maybe Int)))
-> SqlExpr (Value (Maybe Int))
)
-> SqlQuery (SqlExpr (Value (Maybe Int))) -> SqlQuery (SqlExpr (Value (Maybe Int)))
query selector = query selector =
from $ \n -> do from $ \n -> do
@ -497,12 +492,10 @@ testSubSelect run = do
Right xs -> Right xs ->
xs `shouldBe` [] xs `shouldBe` []
testSelectSource :: Run -> Spec testSelectSource :: Run -> Spec
testSelectSource run = do testSelectSource run = do
describe "selectSource" $ do describe "selectSource" $ do
it "works for a simple example" $ it "works for a simple example" $ run $ do
run $ do
let query = selectSource $ let query = selectSource $
from $ \person -> from $ \person ->
return person return person
@ -510,8 +503,7 @@ testSelectSource run = do
ret <- runConduit $ query .| CL.consume ret <- runConduit $ query .| CL.consume
liftIO $ ret `shouldBe` [ p1e ] liftIO $ ret `shouldBe` [ p1e ]
it "can run a query many times" $ it "can run a query many times" $ run $ do
run $ do
let query = selectSource $ let query = selectSource $
from $ \person -> from $ \person ->
return person return person
@ -524,57 +516,57 @@ testSelectSource run = do
it "works on repro" $ do it "works on repro" $ do
let selectPerson :: R.MonadResource m => String -> ConduitT () (Key Person) (SqlPersistT m) () let selectPerson :: R.MonadResource m => String -> ConduitT () (Key Person) (SqlPersistT m) ()
selectPerson name = do selectPerson name = do
let source = selectSource $ from $ \person -> do let source =
selectSource $ from $ \person -> do
where_ $ person ^. PersonName ==. val name where_ $ person ^. PersonName ==. val name
return $ person ^. PersonId return $ person ^. PersonId
source .| CL.map unValue source .| CL.map unValue
run $ do run $ do
p1e <- insert' p1 p1e <- insert' p1
p2e <- insert' p2 p2e <- insert' p2
r1 <- runConduit $ r1 <- runConduit $ selectPerson (personName p1) .| CL.consume
selectPerson (personName p1) .| CL.consume r2 <- runConduit $ selectPerson (personName p2) .| CL.consume
r2 <- runConduit $
selectPerson (personName p2) .| CL.consume
liftIO $ do liftIO $ do
r1 `shouldBe` [ entityKey p1e ] r1 `shouldBe` [ entityKey p1e ]
r2 `shouldBe` [ entityKey p2e ] r2 `shouldBe` [ entityKey p2e ]
testSelectFrom :: Run -> Spec testSelectFrom :: Run -> Spec
testSelectFrom run = do testSelectFrom run = do
describe "select/from" $ do describe "select/from" $ do
it "works for a simple example" $ it "works for a simple example" $ run $ do
run $ do
p1e <- insert' p1 p1e <- insert' p1
ret <- select $ ret <-
select $
from $ \person -> from $ \person ->
return person return person
liftIO $ ret `shouldBe` [ p1e ] liftIO $ ret `shouldBe` [ p1e ]
it "works for a simple self-join (one entity)" $ it "works for a simple self-join (one entity)" $ run $ do
run $ do
p1e <- insert' p1 p1e <- insert' p1
ret <- select $ ret <-
select $
from $ \(person1, person2) -> from $ \(person1, person2) ->
return (person1, person2) return (person1, person2)
liftIO $ ret `shouldBe` [ (p1e, p1e) ] liftIO $ ret `shouldBe` [ (p1e, p1e) ]
it "works for a simple self-join (two entities)" $ it "works for a simple self-join (two entities)" $ run $ do
run $ do
p1e <- insert' p1 p1e <- insert' p1
p2e <- insert' p2 p2e <- insert' p2
ret <- select $ ret <-
select $
from $ \(person1, person2) -> from $ \(person1, person2) ->
return (person1, person2) return (person1, person2)
liftIO $ ret `shouldSatisfy` sameElementsAs [ (p1e, p1e) liftIO $
ret
`shouldSatisfy`
sameElementsAs
[ (p1e, p1e)
, (p1e, p2e) , (p1e, p2e)
, (p2e, p1e) , (p2e, p1e)
, (p2e, p2e) ] , (p2e, p2e)
]
it "works for a self-join via sub_select" $ run $ do
it "works for a self-join via sub_select" $
run $ do
p1k <- insert p1 p1k <- insert p1
p2k <- insert p2 p2k <- insert p2
_f1k <- insert (Follow p1k p2k) _f1k <- insert (Follow p1k p2k)
@ -589,8 +581,7 @@ testSelectFrom run = do
return followA return followA
liftIO $ length ret `shouldBe` 2 liftIO $ length ret `shouldBe` 2
it "works for a self-join via exists" $ it "works for a self-join via exists" $ run $ do
run $ do
p1k <- insert p1 p1k <- insert p1
p2k <- insert p2 p2k <- insert p2
_f1k <- insert (Follow p1k p2k) _f1k <- insert (Follow p1k p2k)
@ -604,8 +595,7 @@ testSelectFrom run = do
liftIO $ length ret `shouldBe` 2 liftIO $ length ret `shouldBe` 2
it "works for a simple projection" $ it "works for a simple projection" $ run $ do
run $ do
p1k <- insert p1 p1k <- insert p1
p2k <- insert p2 p2k <- insert p2
ret <- select $ ret <- select $
@ -614,8 +604,7 @@ testSelectFrom run = do
liftIO $ ret `shouldBe` [ (Value p1k, Value (personName p1)) liftIO $ ret `shouldBe` [ (Value p1k, Value (personName p1))
, (Value p2k, Value (personName p2)) ] , (Value p2k, Value (personName p2)) ]
it "works for a simple projection with a simple implicit self-join" $ it "works for a simple projection with a simple implicit self-join" $ run $ do
run $ do
_ <- insert p1 _ <- insert p1
_ <- insert p2 _ <- insert p2
ret <- select $ ret <- select $
@ -627,31 +616,35 @@ testSelectFrom run = do
, (Value (personName p2), Value (personName p1)) , (Value (personName p2), Value (personName p1))
, (Value (personName p2), Value (personName p2)) ] , (Value (personName p2), Value (personName p2)) ]
it "works with many kinds of LIMITs and OFFSETs" $ it "works with many kinds of LIMITs and OFFSETs" $ run $ do
run $ do
[p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4] [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4]
let people = from $ \p -> do let people =
from $ \p -> do
orderBy [asc (p ^. PersonName)] orderBy [asc (p ^. PersonName)]
return p return p
ret1 <- select $ do ret1 <-
select $ do
p <- people p <- people
limit 2 limit 2
limit 1 limit 1
return p return p
liftIO $ ret1 `shouldBe` [ p1e ] liftIO $ ret1 `shouldBe` [ p1e ]
ret2 <- select $ do ret2 <-
select $ do
p <- people p <- people
limit 1 limit 1
limit 2 limit 2
return p return p
liftIO $ ret2 `shouldBe` [ p1e, p4e ] liftIO $ ret2 `shouldBe` [ p1e, p4e ]
ret3 <- select $ do ret3 <-
select $ do
p <- people p <- people
offset 3 offset 3
offset 2 offset 2
return p return p
liftIO $ ret3 `shouldBe` [ p3e, p2e ] liftIO $ ret3 `shouldBe` [ p3e, p2e ]
ret4 <- select $ do ret4 <-
select $ do
p <- people p <- people
offset 3 offset 3
limit 5 limit 5
@ -661,7 +654,8 @@ testSelectFrom run = do
limit 2 limit 2
return p return p
liftIO $ ret4 `shouldBe` [ p4e, p3e ] liftIO $ ret4 `shouldBe` [ p4e, p3e ]
ret5 <- select $ do ret5 <-
select $ do
p <- people p <- people
offset 1000 offset 1000
limit 1 limit 1
@ -670,8 +664,7 @@ testSelectFrom run = do
return p return p
liftIO $ ret5 `shouldBe` [ p1e, p4e, p3e, p2e ] liftIO $ ret5 `shouldBe` [ p1e, p4e, p3e, p2e ]
it "works with non-id primary key" $ it "works with non-id primary key" $ run $ do
run $ do
let fc = Frontcover number "" let fc = Frontcover number ""
number = 101 number = 101
Right thePk = keyFromValues [toPersistValue number] Right thePk = keyFromValues [toPersistValue number]
@ -681,8 +674,7 @@ testSelectFrom run = do
ret `shouldBe` fc ret `shouldBe` fc
fcPk `shouldBe` thePk fcPk `shouldBe` thePk
it "works when returning a custom non-composite primary key from a query" $ it "works when returning a custom non-composite primary key from a query" $ run $ do
run $ do
let name = "foo" let name = "foo"
t = Tag name t = Tag name
Right thePk = keyFromValues [toPersistValue name] Right thePk = keyFromValues [toPersistValue name]
@ -692,15 +684,12 @@ testSelectFrom run = do
ret `shouldBe` thePk ret `shouldBe` thePk
thePk `shouldBe` tagPk thePk `shouldBe` tagPk
it "works when returning a composite primary key from a query" $ it "works when returning a composite primary key from a query" $ run $ do
run $ do
let p = Point 10 20 "" let p = Point 10 20 ""
thePk <- insert p thePk <- insert p
[Value ppk] <- select $ from $ \p' -> return (p'^.PointId) [Value ppk] <- select $ from $ \p' -> return (p'^.PointId)
liftIO $ ppk `shouldBe` thePk liftIO $ ppk `shouldBe` thePk
testSelectJoin :: Run -> Spec testSelectJoin :: Run -> Spec
testSelectJoin run = do testSelectJoin run = do
describe "select:JOIN" $ do describe "select:JOIN" $ do
@ -883,10 +872,8 @@ testSelectJoin run = do
liftIO $ (entityVal <$> ps) `shouldBe` [p1] liftIO $ (entityVal <$> ps) `shouldBe` [p1]
testSelectSubQuery :: Run -> Spec testSelectSubQuery :: Run -> Spec
testSelectSubQuery run = do testSelectSubQuery run = describe "select subquery" $ do
describe "select subquery" $ do it "works" $ run $ do
it "works" $ do
run $ do
_ <- insert' p1 _ <- insert' p1
let q = do let q = do
p <- Experimental.from $ Table @Person p <- Experimental.from $ Table @Person
@ -894,8 +881,7 @@ testSelectSubQuery run = do
ret <- select $ Experimental.from $ SelectQuery q ret <- select $ Experimental.from $ SelectQuery q
liftIO $ ret `shouldBe` [ (Value $ personName p1, Value $ personAge p1) ] liftIO $ ret `shouldBe` [ (Value $ personName p1, Value $ personAge p1) ]
it "supports sub-selecting Maybe entities" $ do it "supports sub-selecting Maybe entities" $ run $ do
run $ do
l1e <- insert' l1 l1e <- insert' l1
l3e <- insert' l3 l3e <- insert' l3
l1Deeds <- mapM (\k -> insert' $ Deed k (entityKey l1e)) (map show [1..3 :: Int]) l1Deeds <- mapM (\k -> insert' $ Deed k (entityKey l1e)) (map show [1..3 :: Int])
@ -909,8 +895,7 @@ testSelectSubQuery run = do
pure (lords, deeds) pure (lords, deeds)
liftIO $ ret `shouldMatchList` ((l3e, Nothing) : l1WithDeeds) liftIO $ ret `shouldMatchList` ((l3e, Nothing) : l1WithDeeds)
it "lets you order by alias" $ do it "lets you order by alias" $ run $ do
run $ do
_ <- insert' p1 _ <- insert' p1
_ <- insert' p3 _ <- insert' p3
let q = do let q = do
@ -923,8 +908,7 @@ testSelectSubQuery run = do
ret <- select q ret <- select q
liftIO $ ret `shouldBe` [ Value $ personName p3, Value $ personName p1 ] liftIO $ ret `shouldBe` [ Value $ personName p3, Value $ personName p1 ]
it "supports groupBy" $ do it "supports groupBy" $ run $ do
run $ do
l1k <- insert l1 l1k <- insert l1
l3k <- insert l3 l3k <- insert l3
mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int]) mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int])
@ -945,8 +929,7 @@ testSelectSubQuery run = do
liftIO $ ret `shouldMatchList` [ (Value l3k, Value 7) liftIO $ ret `shouldMatchList` [ (Value l3k, Value 7)
, (Value l1k, Value 3) ] , (Value l1k, Value 3) ]
it "Can count results of aggregate query" $ do it "Can count results of aggregate query" $ run $ do
run $ do
l1k <- insert l1 l1k <- insert l1
l3k <- insert l3 l3k <- insert l3
mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int]) mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int])
@ -967,8 +950,7 @@ testSelectSubQuery run = do
liftIO $ ret `shouldMatchList` [ (Value 1) ] liftIO $ ret `shouldMatchList` [ (Value 1) ]
it "joins on subqueries" $ do it "joins on subqueries" $ run $ do
run $ do
l1k <- insert l1 l1k <- insert l1
l3k <- insert l3 l3k <- insert l3
mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int]) mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int])
@ -985,8 +967,7 @@ testSelectSubQuery run = do
liftIO $ ret `shouldMatchList` [ (Value l3k, Value 7) liftIO $ ret `shouldMatchList` [ (Value l3k, Value 7)
, (Value l1k, Value 3) ] , (Value l1k, Value 3) ]
it "flattens maybe values" $ do it "flattens maybe values" $ run $ do
run $ do
l1k <- insert l1 l1k <- insert l1
l3k <- insert l3 l3k <- insert l3
let q = do let q = do
@ -1002,8 +983,7 @@ testSelectSubQuery run = do
(ret :: [(Value (Key Lord), Value (Maybe Int))]) <- select q (ret :: [(Value (Key Lord), Value (Maybe Int))]) <- select q
liftIO $ ret `shouldMatchList` [ (Value l3k, Value (lordDogs l3)) liftIO $ ret `shouldMatchList` [ (Value l3k, Value (lordDogs l3))
, (Value l1k, Value (lordDogs l1)) ] , (Value l1k, Value (lordDogs l1)) ]
it "unions" $ do it "unions" $ run $ do
run $ do
_ <- insert p1 _ <- insert p1
_ <- insert p2 _ <- insert p2
let q = Experimental.from $ let q = Experimental.from $
@ -1025,10 +1005,8 @@ testSelectSubQuery run = do
liftIO $ names `shouldMatchList` [ (Value $ personName p1) liftIO $ names `shouldMatchList` [ (Value $ personName p1)
, (Value $ personName p2) ] , (Value $ personName p2) ]
testSelectWhere :: Run -> Spec testSelectWhere :: Run -> Spec
testSelectWhere run = do testSelectWhere run = describe "select where_" $ do
describe "select where_" $ do it "works for a simple example with (==.)" $ run $ do
it "works for a simple example with (==.)" $
run $ do
p1e <- insert' p1 p1e <- insert' p1
_ <- insert' p2 _ <- insert' p2
_ <- insert' p3 _ <- insert' p3
@ -1038,8 +1016,7 @@ testSelectWhere run = do
return p return p
liftIO $ ret `shouldBe` [ p1e ] liftIO $ ret `shouldBe` [ p1e ]
it "works for a simple example with (==.) and (||.)" $ it "works for a simple example with (==.) and (||.)" $ run $ do
run $ do
p1e <- insert' p1 p1e <- insert' p1
p2e <- insert' p2 p2e <- insert' p2
_ <- insert' p3 _ <- insert' p3
@ -1049,8 +1026,7 @@ testSelectWhere run = do
return p return p
liftIO $ ret `shouldBe` [ p1e, p2e ] liftIO $ ret `shouldBe` [ p1e, p2e ]
it "works for a simple example with (>.) [uses val . Just]" $ it "works for a simple example with (>.) [uses val . Just]" $ run $ do
run $ do
p1e <- insert' p1 p1e <- insert' p1
_ <- insert' p2 _ <- insert' p2
_ <- insert' p3 _ <- insert' p3
@ -1060,8 +1036,7 @@ testSelectWhere run = do
return p return p
liftIO $ ret `shouldBe` [ p1e ] liftIO $ ret `shouldBe` [ p1e ]
it "works for a simple example with (>.) and not_ [uses just . val]" $ it "works for a simple example with (>.) and not_ [uses just . val]" $ run $ do
run $ do
_ <- insert' p1 _ <- insert' p1
_ <- insert' p2 _ <- insert' p2
p3e <- insert' p3 p3e <- insert' p3
@ -1072,8 +1047,7 @@ testSelectWhere run = do
liftIO $ ret `shouldBe` [ p3e ] liftIO $ ret `shouldBe` [ p3e ]
describe "when using between" $ do describe "when using between" $ do
it "works for a simple example with [uses just . val]" $ it "works for a simple example with [uses just . val]" $ run $ do
run $ do
p1e <- insert' p1 p1e <- insert' p1
_ <- insert' p2 _ <- insert' p2
_ <- insert' p3 _ <- insert' p3
@ -1082,8 +1056,7 @@ testSelectWhere run = do
where_ ((p ^. PersonAge) `between` (just $ val 20, just $ val 40)) where_ ((p ^. PersonAge) `between` (just $ val 20, just $ val 40))
return p return p
liftIO $ ret `shouldBe` [ p1e ] liftIO $ ret `shouldBe` [ p1e ]
it "works for a proyected fields value" $ it "works for a proyected fields value" $ run $ do
run $ do
_ <- insert' p1 >> insert' p2 >> insert' p3 _ <- insert' p1 >> insert' p2 >> insert' p3
ret <- ret <-
select $ select $
@ -1094,8 +1067,7 @@ testSelectWhere run = do
(p ^. PersonAge, p ^. PersonWeight) (p ^. PersonAge, p ^. PersonWeight)
liftIO $ ret `shouldBe` [] liftIO $ ret `shouldBe` []
describe "when projecting composite keys" $ do describe "when projecting composite keys" $ do
it "works when using composite keys with val" $ it "works when using composite keys with val" $ run $ do
run $ do
insert_ $ Point 1 2 "" insert_ $ Point 1 2 ""
ret <- ret <-
select $ select $
@ -1106,8 +1078,7 @@ testSelectWhere run = do
( val $ PointKey 1 2 ( val $ PointKey 1 2
, val $ PointKey 5 6 ) , val $ PointKey 5 6 )
liftIO $ ret `shouldBe` [()] liftIO $ ret `shouldBe` [()]
it "works when using ECompositeKey constructor" $ it "works when using ECompositeKey constructor" $ run $ do
run $ do
insert_ $ Point 1 2 "" insert_ $ Point 1 2 ""
ret <- ret <-
select $ select $
@ -1119,8 +1090,7 @@ testSelectWhere run = do
, EI.ECompositeKey $ const ["5", "6"] ) , EI.ECompositeKey $ const ["5", "6"] )
liftIO $ ret `shouldBe` [] liftIO $ ret `shouldBe` []
it "works with avg_" $ it "works with avg_" $ run $ do
run $ do
_ <- insert' p1 _ <- insert' p1
_ <- insert' p2 _ <- insert' p2
_ <- insert' p3 _ <- insert' p3
@ -1146,8 +1116,7 @@ testSelectWhere run = do
return $ joinV $ min_ (p ^. PersonAge) return $ joinV $ min_ (p ^. PersonAge)
liftIO $ ret `shouldBe` [ Value $ Just (17 :: Int) ] liftIO $ ret `shouldBe` [ Value $ Just (17 :: Int) ]
it "works with max_" $ it "works with max_" $ run $ do
run $ do
_ <- insert' p1 _ <- insert' p1
_ <- insert' p2 _ <- insert' p2
_ <- insert' p3 _ <- insert' p3
@ -1157,8 +1126,7 @@ testSelectWhere run = do
return $ joinV $ max_ (p ^. PersonAge) return $ joinV $ max_ (p ^. PersonAge)
liftIO $ ret `shouldBe` [ Value $ Just (36 :: Int) ] liftIO $ ret `shouldBe` [ Value $ Just (36 :: Int) ]
it "works with lower_" $ it "works with lower_" $ run $ do
run $ do
p1e <- insert' p1 p1e <- insert' p1
p2e@(Entity _ bob) <- insert' $ Person "bob" (Just 36) Nothing 1 p2e@(Entity _ bob) <- insert' $ Person "bob" (Just 36) Nothing 1
@ -1176,13 +1144,11 @@ testSelectWhere run = do
return p return p
liftIO $ ret2 `shouldBe` [ p2e ] liftIO $ ret2 `shouldBe` [ p2e ]
it "works with round_" $ it "works with round_" $ run $ do
run $ do
ret <- select $ return $ round_ (val (16.2 :: Double)) ret <- select $ return $ round_ (val (16.2 :: Double))
liftIO $ ret `shouldBe` [ Value (16 :: Double) ] liftIO $ ret `shouldBe` [ Value (16 :: Double) ]
it "works with isNothing" $ it "works with isNothing" $ run $ do
run $ do
_ <- insert' p1 _ <- insert' p1
p2e <- insert' p2 p2e <- insert' p2
_ <- insert' p3 _ <- insert' p3
@ -1192,8 +1158,7 @@ testSelectWhere run = do
return p return p
liftIO $ ret `shouldBe` [ p2e ] liftIO $ ret `shouldBe` [ p2e ]
it "works with not_ . isNothing" $ it "works with not_ . isNothing" $ run $ do
run $ do
p1e <- insert' p1 p1e <- insert' p1
_ <- insert' p2 _ <- insert' p2
ret <- select $ ret <- select $
@ -1224,8 +1189,7 @@ testSelectWhere run = do
, (p4e, f42, p2e) , (p4e, f42, p2e)
, (p2e, f21, p1e) ] , (p2e, f21, p1e) ]
it "works for a many-to-many explicit join" $ it "works for a many-to-many explicit join" $ run $ do
run $ do
p1e@(Entity p1k _) <- insert' p1 p1e@(Entity p1k _) <- insert' p1
p2e@(Entity p2k _) <- insert' p2 p2e@(Entity p2k _) <- insert' p2
_ <- insert' p3 _ <- insert' p3
@ -1257,8 +1221,7 @@ testSelectWhere run = do
-- we only care that we don't have a SQL error -- we only care that we don't have a SQL error
True `shouldBe` True True `shouldBe` True
it "works for a many-to-many explicit join with LEFT OUTER JOINs" $ it "works for a many-to-many explicit join with LEFT OUTER JOINs" $ run $ do
run $ do
p1e@(Entity p1k _) <- insert' p1 p1e@(Entity p1k _) <- insert' p1
p2e@(Entity p2k _) <- insert' p2 p2e@(Entity p2k _) <- insert' p2
p3e <- insert' p3 p3e <- insert' p3
@ -1280,8 +1243,7 @@ testSelectWhere run = do
, (p3e, Nothing, Nothing) , (p3e, Nothing, Nothing)
, (p2e, Just f21, Just p1e) ] , (p2e, Just f21, Just p1e) ]
it "works with a composite primary key" $ it "works with a composite primary key" $ run $ do
run $ do
let p = Point x y "" let p = Point x y ""
x = 10 x = 10
y = 15 y = 15
@ -1294,13 +1256,9 @@ testSelectWhere run = do
ret `shouldBe` p ret `shouldBe` p
pPk `shouldBe` thePk pPk `shouldBe` thePk
testSelectOrderBy :: Run -> Spec testSelectOrderBy :: Run -> Spec
testSelectOrderBy run = do testSelectOrderBy run = describe "select/orderBy" $ do
describe "select/orderBy" $ do it "works with a single ASC field" $ run $ do
it "works with a single ASC field" $
run $ do
p1e <- insert' p1 p1e <- insert' p1
p2e <- insert' p2 p2e <- insert' p2
p3e <- insert' p3 p3e <- insert' p3
@ -1310,8 +1268,7 @@ testSelectOrderBy run = do
return p return p
liftIO $ ret `shouldBe` [ p1e, p3e, p2e ] liftIO $ ret `shouldBe` [ p1e, p3e, p2e ]
it "works with a sub_select" $ it "works with a sub_select" $ run $ do
run $ do
[p1k, p2k, p3k, p4k] <- mapM insert [p1, p2, p3, p4] [p1k, p2k, p3k, p4k] <- mapM insert [p1, p2, p3, p4]
[b1k, b2k, b3k, b4k] <- mapM (insert . BlogPost "") [p1k, p2k, p3k, p4k] [b1k, b2k, b3k, b4k] <- mapM (insert . BlogPost "") [p1k, p2k, p3k, p4k]
ret <- select $ ret <- select $
@ -1324,8 +1281,7 @@ testSelectOrderBy run = do
return (b ^. BlogPostId) return (b ^. BlogPostId)
liftIO $ ret `shouldBe` (Value <$> [b2k, b3k, b4k, b1k]) liftIO $ ret `shouldBe` (Value <$> [b2k, b3k, b4k, b1k])
it "works on a composite primary key" $ it "works on a composite primary key" $ run $ do
run $ do
let ps = [Point 2 1 "", Point 1 2 ""] let ps = [Point 2 1 "", Point 1 2 ""]
mapM_ insert ps mapM_ insert ps
eps <- select $ eps <- select $
@ -1335,10 +1291,8 @@ testSelectOrderBy run = do
liftIO $ map entityVal eps `shouldBe` reverse ps liftIO $ map entityVal eps `shouldBe` reverse ps
testAscRandom :: SqlExpr (Value Double) -> Run -> Spec testAscRandom :: SqlExpr (Value Double) -> Run -> Spec
testAscRandom rand' run = testAscRandom rand' run = describe "random_" $
describe "random_" $ it "asc random_ works" $ run $ do
it "asc random_ works" $
run $ do
_p1e <- insert' p1 _p1e <- insert' p1
_p2e <- insert' p2 _p2e <- insert' p2
_p3e <- insert' p3 _p3e <- insert' p3
@ -1383,10 +1337,8 @@ testSelectDistinct run = do
testCoasleceDefault :: Run -> Spec testCoasleceDefault :: Run -> Spec
testCoasleceDefault run = do testCoasleceDefault run = describe "coalesce/coalesceDefault" $ do
describe "coalesce/coalesceDefault" $ do it "works on a simple example" $ run $ do
it "works on a simple example" $
run $ do
mapM_ insert' [p1, p2, p3, p4, p5] mapM_ insert' [p1, p2, p3, p4, p5]
ret1 <- select $ ret1 <- select $
from $ \p -> do from $ \p -> do
@ -1410,8 +1362,7 @@ testCoasleceDefault run = do
, Value 5 , Value 5
] ]
it "works with sub-queries" $ it "works with sub-queries" $ run $ do
run $ do
p1id <- insert p1 p1id <- insert p1
p2id <- insert p2 p2id <- insert p2
p3id <- insert p3 p3id <- insert p3
@ -1433,12 +1384,9 @@ testCoasleceDefault run = do
] ]
testDelete :: Run -> Spec testDelete :: Run -> Spec
testDelete run = do testDelete run = describe "delete" $ do
describe "delete" $ it "works on a simple example" $ run $ do
it "works on a simple example" $
run $ do
p1e <- insert' p1 p1e <- insert' p1
p2e <- insert' p2 p2e <- insert' p2
p3e <- insert' p3 p3e <- insert' p3
@ -1459,14 +1407,9 @@ testDelete run = do
ret3 <- getAll ret3 <- getAll
liftIO $ (n, ret3) `shouldBe` (2, []) liftIO $ (n, ret3) `shouldBe` (2, [])
testUpdate :: Run -> Spec testUpdate :: Run -> Spec
testUpdate run = do testUpdate run = describe "update" $ do
describe "update" $ do it "works with a subexpression having COUNT(*)" $ run $ do
it "works with a subexpression having COUNT(*)" $
run $ do
p1k <- insert p1 p1k <- insert p1
p2k <- insert p2 p2k <- insert p2
p3k <- insert p3 p3k <- insert p3
@ -1504,8 +1447,7 @@ testUpdate run = do
ret `shouldBe` Point newX newY [] ret `shouldBe` Point newX newY []
-} -}
it "GROUP BY works with COUNT" $ it "GROUP BY works with COUNT" $ run $ do
run $ do
p1k <- insert p1 p1k <- insert p1
p2k <- insert p2 p2k <- insert p2
p3k <- insert p3 p3k <- insert p3
@ -1522,8 +1464,7 @@ testUpdate run = do
, (Entity p1k p1, Value 3) , (Entity p1k p1, Value 3)
, (Entity p3k p3, Value 7) ] , (Entity p3k p3, Value 7) ]
it "GROUP BY works with COUNT and InnerJoin" $ it "GROUP BY works with COUNT and InnerJoin" $ run $ do
run $ do
l1k <- insert l1 l1k <- insert l1
l3k <- insert l3 l3k <- insert l3
mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int]) mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int])
@ -1538,8 +1479,7 @@ testUpdate run = do
liftIO $ ret `shouldMatchList` [ (Value l3k, Value 7) liftIO $ ret `shouldMatchList` [ (Value l3k, Value 7)
, (Value l1k, Value 3) ] , (Value l1k, Value 3) ]
it "GROUP BY works with nested tuples" $ do it "GROUP BY works with nested tuples" $ run $ do
run $ do
l1k <- insert l1 l1k <- insert l1
l3k <- insert l3 l3k <- insert l3
mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int]) mapM_ (\k -> insert $ Deed k l1k) (map show [1..3 :: Int])
@ -1552,8 +1492,8 @@ testUpdate run = do
groupBy ((lord ^. LordId, lord ^. LordDogs), deed ^. DeedContract) groupBy ((lord ^. LordId, lord ^. LordDogs), deed ^. DeedContract)
return (lord ^. LordId, count $ deed ^. DeedId) return (lord ^. LordId, count $ deed ^. DeedId)
liftIO $ length ret `shouldBe` 10 liftIO $ length ret `shouldBe` 10
it "GROUP BY works with HAVING" $
run $ do it "GROUP BY works with HAVING" $ run $ do
p1k <- insert p1 p1k <- insert p1
_p2k <- insert p2 _p2k <- insert p2
p3k <- insert p3 p3k <- insert p3
@ -1570,7 +1510,6 @@ testUpdate run = do
liftIO $ ret `shouldBe` [ (Entity p1k p1, Value (3 :: Int)) liftIO $ ret `shouldBe` [ (Entity p1k p1, Value (3 :: Int))
, (Entity p3k p3, Value 7) ] , (Entity p3k p3, Value 7) ]
-- we only care that this compiles. check that SqlWriteT doesn't fail on -- we only care that this compiles. check that SqlWriteT doesn't fail on
-- updates. -- updates.
testSqlWriteT :: MonadIO m => SqlWriteT m () testSqlWriteT :: MonadIO m => SqlWriteT m ()
@ -1598,10 +1537,8 @@ testSqlReadT =
return (lord ^. LordId, count $ deed ^. DeedId) return (lord ^. LordId, count $ deed ^. DeedId)
testListOfValues :: Run -> Spec testListOfValues :: Run -> Spec
testListOfValues run = do testListOfValues run = describe "lists of values" $ do
describe "lists of values" $ do it "IN works for valList" $ run $ do
it "IN works for valList" $
run $ do
p1k <- insert p1 p1k <- insert p1
p2k <- insert p2 p2k <- insert p2
_p3k <- insert p3 _p3k <- insert p3
@ -1612,8 +1549,7 @@ testListOfValues run = do
liftIO $ ret `shouldBe` [ Entity p1k p1 liftIO $ ret `shouldBe` [ Entity p1k p1
, Entity p2k p2 ] , Entity p2k p2 ]
it "IN works for valList (null list)" $ it "IN works for valList (null list)" $ run $ do
run $ do
_p1k <- insert p1 _p1k <- insert p1
_p2k <- insert p2 _p2k <- insert p2
_p3k <- insert p3 _p3k <- insert p3
@ -1623,8 +1559,7 @@ testListOfValues run = do
return p return p
liftIO $ ret `shouldBe` [] liftIO $ ret `shouldBe` []
it "IN works for subList_select" $ it "IN works for subList_select" $ run $ do
run $ do
p1k <- insert p1 p1k <- insert p1
_p2k <- insert p2 _p2k <- insert p2
p3k <- insert p3 p3k <- insert p3
@ -1640,8 +1575,7 @@ testListOfValues run = do
return p return p
liftIO $ L.sort ret `shouldBe` L.sort [Entity p1k p1, Entity p3k p3] liftIO $ L.sort ret `shouldBe` L.sort [Entity p1k p1, Entity p3k p3]
it "NOT IN works for subList_select" $ it "NOT IN works for subList_select" $ run $ do
run $ do
p1k <- insert p1 p1k <- insert p1
p2k <- insert p2 p2k <- insert p2
p3k <- insert p3 p3k <- insert p3
@ -1656,8 +1590,7 @@ testListOfValues run = do
return p return p
liftIO $ ret `shouldBe` [ Entity p2k p2 ] liftIO $ ret `shouldBe` [ Entity p2k p2 ]
it "EXISTS works for subList_select" $ it "EXISTS works for subList_select" $ run $ do
run $ do
p1k <- insert p1 p1k <- insert p1
_p2k <- insert p2 _p2k <- insert p2
p3k <- insert p3 p3k <- insert p3
@ -1673,8 +1606,7 @@ testListOfValues run = do
liftIO $ ret `shouldBe` [ Entity p1k p1 liftIO $ ret `shouldBe` [ Entity p1k p1
, Entity p3k p3 ] , Entity p3k p3 ]
it "EXISTS works for subList_select" $ it "EXISTS works for subList_select" $ run $ do
run $ do
p1k <- insert p1 p1k <- insert p1
p2k <- insert p2 p2k <- insert p2
p3k <- insert p3 p3k <- insert p3
@ -1688,25 +1620,15 @@ testListOfValues run = do
return p return p
liftIO $ ret `shouldBe` [ Entity p2k p2 ] liftIO $ ret `shouldBe` [ Entity p2k p2 ]
testListFields :: Run -> Spec testListFields :: Run -> Spec
testListFields run = do testListFields run = describe "list fields" $ do
describe "list fields" $ do
-- <https://github.com/prowdsponsor/esqueleto/issues/100> -- <https://github.com/prowdsponsor/esqueleto/issues/100>
it "can update list fields" $ it "can update list fields" $ run $ do
run $ do
cclist <- insert $ CcList [] cclist <- insert $ CcList []
update $ \p -> do update $ \p -> do
set p [ CcListNames =. val ["fred"]] set p [ CcListNames =. val ["fred"]]
where_ (p ^. CcListId ==. val cclist) where_ (p ^. CcListId ==. val cclist)
testInsertsBySelect :: Run -> Spec testInsertsBySelect :: Run -> Spec
testInsertsBySelect run = do testInsertsBySelect run = do
describe "inserts by select" $ do describe "inserts by select" $ do