Consolidate Tests (#261)
* Consolidate Tests * stylish-haskell * woops * lol
This commit is contained in:
parent
b295bc6a5f
commit
e145be999a
@ -80,105 +80,49 @@ library
|
|||||||
-Wmonomorphism-restriction
|
-Wmonomorphism-restriction
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
test-suite mysql
|
test-suite specs
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: MySQL/Test.hs
|
main-is: Spec.hs
|
||||||
other-modules:
|
|
||||||
Common.Test
|
|
||||||
Paths_esqueleto
|
|
||||||
hs-source-dirs:
|
|
||||||
test
|
|
||||||
ghc-options: -Wall
|
|
||||||
build-depends:
|
|
||||||
base >=4.8 && <5.0
|
|
||||||
, attoparsec
|
|
||||||
, blaze-html
|
|
||||||
, bytestring
|
|
||||||
, conduit >=1.3
|
|
||||||
, containers
|
|
||||||
, esqueleto
|
|
||||||
, exceptions
|
|
||||||
, hspec
|
|
||||||
, monad-logger
|
|
||||||
, mtl
|
|
||||||
, mysql
|
|
||||||
, mysql-simple
|
|
||||||
, persistent
|
|
||||||
, persistent-mysql
|
|
||||||
, resourcet >=1.2
|
|
||||||
, tagged >=0.2
|
|
||||||
, text >=0.11 && <1.3
|
|
||||||
, time
|
|
||||||
, transformers >=0.2
|
|
||||||
, unliftio
|
|
||||||
, unordered-containers >=0.2
|
|
||||||
default-language: Haskell2010
|
|
||||||
|
|
||||||
test-suite postgresql
|
|
||||||
type: exitcode-stdio-1.0
|
|
||||||
main-is: PostgreSQL/Test.hs
|
|
||||||
other-modules:
|
other-modules:
|
||||||
Common.Test
|
Common.Test
|
||||||
|
Common.Test.Models
|
||||||
|
Common.Test.Import
|
||||||
|
Common.Test.Select
|
||||||
PostgreSQL.MigrateJSON
|
PostgreSQL.MigrateJSON
|
||||||
Paths_esqueleto
|
SQLite.Test
|
||||||
|
PostgreSQL.Test
|
||||||
|
MySQL.Test
|
||||||
|
default-extensions:
|
||||||
|
RankNTypes
|
||||||
hs-source-dirs:
|
hs-source-dirs:
|
||||||
test
|
test
|
||||||
ghc-options: -Wall -threaded
|
ghc-options: -Wall -threaded
|
||||||
build-depends:
|
build-depends:
|
||||||
base >=4.8 && <5.0
|
base >=4.8 && <5.0
|
||||||
, aeson
|
, aeson
|
||||||
, attoparsec
|
|
||||||
, blaze-html
|
|
||||||
, bytestring
|
|
||||||
, conduit >=1.3
|
|
||||||
, containers
|
|
||||||
, esqueleto
|
|
||||||
, exceptions
|
|
||||||
, hspec
|
|
||||||
, monad-logger
|
|
||||||
, mtl
|
|
||||||
, persistent
|
|
||||||
, persistent-postgresql
|
|
||||||
, postgresql-libpq
|
|
||||||
, postgresql-simple
|
, postgresql-simple
|
||||||
, resourcet >=1.2
|
|
||||||
, tagged >=0.2
|
|
||||||
, text >=0.11 && <1.3
|
|
||||||
, time
|
|
||||||
, transformers >=0.2
|
|
||||||
, unliftio
|
|
||||||
, unordered-containers >=0.2
|
|
||||||
, vector
|
|
||||||
default-language: Haskell2010
|
|
||||||
|
|
||||||
test-suite sqlite
|
|
||||||
type: exitcode-stdio-1.0
|
|
||||||
main-is: SQLite/Test.hs
|
|
||||||
other-modules:
|
|
||||||
Common.Test
|
|
||||||
Paths_esqueleto
|
|
||||||
hs-source-dirs:
|
|
||||||
test
|
|
||||||
ghc-options: -Wall -threaded
|
|
||||||
build-depends:
|
|
||||||
base >=4.8 && <5.0
|
|
||||||
, attoparsec
|
, attoparsec
|
||||||
, blaze-html
|
, blaze-html
|
||||||
, bytestring
|
, bytestring
|
||||||
, conduit >=1.3
|
, conduit
|
||||||
, containers
|
, containers
|
||||||
, esqueleto
|
, esqueleto
|
||||||
, exceptions
|
, exceptions
|
||||||
, hspec
|
, hspec
|
||||||
|
, hspec-core
|
||||||
, monad-logger
|
, monad-logger
|
||||||
, mtl
|
, mtl
|
||||||
|
, mysql
|
||||||
|
, mysql-simple
|
||||||
, persistent
|
, persistent
|
||||||
|
, persistent-mysql
|
||||||
, persistent-sqlite
|
, persistent-sqlite
|
||||||
, resourcet >=1.2
|
, persistent-postgresql
|
||||||
, tagged >=0.2
|
, resourcet
|
||||||
, text >=0.11 && <1.3
|
, tagged
|
||||||
|
, text
|
||||||
, time
|
, time
|
||||||
, transformers >=0.2
|
, transformers
|
||||||
, unliftio
|
, unliftio
|
||||||
, unordered-containers >=0.2
|
, unordered-containers
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|||||||
@ -64,6 +64,8 @@ module Common.Test
|
|||||||
, Key(..)
|
, Key(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
import Common.Test.Import hiding (from, on)
|
||||||
|
|
||||||
import Control.Monad (forM_, replicateM, replicateM_, void)
|
import Control.Monad (forM_, replicateM, replicateM_, void)
|
||||||
import Control.Monad.Catch (MonadCatch)
|
import Control.Monad.Catch (MonadCatch)
|
||||||
import Control.Monad.Reader (ask)
|
import Control.Monad.Reader (ask)
|
||||||
@ -73,7 +75,8 @@ import Data.Time
|
|||||||
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 (MonadLoggerIO(..), MonadLogger(..), NoLoggingT, runNoLoggingT)
|
import Control.Monad.Logger
|
||||||
|
(MonadLogger(..), MonadLoggerIO(..), NoLoggingT, runNoLoggingT)
|
||||||
import Control.Monad.Trans.Reader (ReaderT)
|
import Control.Monad.Trans.Reader (ReaderT)
|
||||||
import qualified Data.Attoparsec.Text as AP
|
import qualified Data.Attoparsec.Text as AP
|
||||||
import Data.Char (toLower, toUpper)
|
import Data.Char (toLower, toUpper)
|
||||||
@ -96,167 +99,9 @@ import qualified Database.Esqueleto.Internal.ExprParser as P
|
|||||||
import qualified Database.Esqueleto.Internal.Internal as EI
|
import qualified Database.Esqueleto.Internal.Internal as EI
|
||||||
import qualified UnliftIO.Resource as R
|
import qualified UnliftIO.Resource as R
|
||||||
|
|
||||||
|
import Common.Test.Select
|
||||||
|
|
||||||
-- Test schema
|
-- Test schema
|
||||||
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
|
|
||||||
Foo
|
|
||||||
name Int
|
|
||||||
Primary name
|
|
||||||
deriving Show Eq Ord
|
|
||||||
Bar
|
|
||||||
quux FooId
|
|
||||||
deriving Show Eq Ord
|
|
||||||
Baz
|
|
||||||
blargh FooId
|
|
||||||
deriving Show Eq
|
|
||||||
Shoop
|
|
||||||
baz BazId
|
|
||||||
deriving Show Eq
|
|
||||||
Asdf
|
|
||||||
shoop ShoopId
|
|
||||||
deriving Show Eq
|
|
||||||
Another
|
|
||||||
why BazId
|
|
||||||
YetAnother
|
|
||||||
argh ShoopId
|
|
||||||
|
|
||||||
Person
|
|
||||||
name String
|
|
||||||
age Int Maybe
|
|
||||||
weight Int Maybe
|
|
||||||
favNum Int
|
|
||||||
deriving Eq Show Ord
|
|
||||||
BlogPost
|
|
||||||
title String
|
|
||||||
authorId PersonId
|
|
||||||
deriving Eq Show
|
|
||||||
Comment
|
|
||||||
body String
|
|
||||||
blog BlogPostId
|
|
||||||
deriving Eq Show
|
|
||||||
CommentReply
|
|
||||||
body String
|
|
||||||
comment CommentId
|
|
||||||
Profile
|
|
||||||
name String
|
|
||||||
person PersonId
|
|
||||||
deriving Eq Show
|
|
||||||
Reply
|
|
||||||
guy PersonId
|
|
||||||
body String
|
|
||||||
deriving Eq Show
|
|
||||||
|
|
||||||
Lord
|
|
||||||
county String maxlen=100
|
|
||||||
dogs Int Maybe
|
|
||||||
Primary county
|
|
||||||
deriving Eq Show
|
|
||||||
|
|
||||||
Deed
|
|
||||||
contract String maxlen=100
|
|
||||||
ownerId LordId maxlen=100
|
|
||||||
Primary contract
|
|
||||||
deriving Eq Show
|
|
||||||
|
|
||||||
Follow
|
|
||||||
follower PersonId
|
|
||||||
followed PersonId
|
|
||||||
deriving Eq Show
|
|
||||||
|
|
||||||
CcList
|
|
||||||
names [String]
|
|
||||||
|
|
||||||
Frontcover
|
|
||||||
number Int
|
|
||||||
title String
|
|
||||||
Primary number
|
|
||||||
deriving Eq Show
|
|
||||||
Article
|
|
||||||
title String
|
|
||||||
frontcoverNumber Int
|
|
||||||
Foreign Frontcover fkfrontcover frontcoverNumber
|
|
||||||
deriving Eq Show
|
|
||||||
ArticleMetadata
|
|
||||||
articleId ArticleId
|
|
||||||
Primary articleId
|
|
||||||
deriving Eq Show
|
|
||||||
Tag
|
|
||||||
name String maxlen=100
|
|
||||||
Primary name
|
|
||||||
deriving Eq Show
|
|
||||||
ArticleTag
|
|
||||||
articleId ArticleId
|
|
||||||
tagId TagId maxlen=100
|
|
||||||
Primary articleId tagId
|
|
||||||
deriving Eq Show
|
|
||||||
Article2
|
|
||||||
title String
|
|
||||||
frontcoverId FrontcoverId
|
|
||||||
deriving Eq Show
|
|
||||||
Point
|
|
||||||
x Int
|
|
||||||
y Int
|
|
||||||
name String
|
|
||||||
Primary x y
|
|
||||||
deriving Eq Show
|
|
||||||
Circle
|
|
||||||
centerX Int
|
|
||||||
centerY Int
|
|
||||||
name String
|
|
||||||
Foreign Point fkpoint centerX centerY
|
|
||||||
deriving Eq Show
|
|
||||||
Numbers
|
|
||||||
int Int
|
|
||||||
double Double
|
|
||||||
deriving Eq Show
|
|
||||||
|
|
||||||
JoinOne
|
|
||||||
name String
|
|
||||||
deriving Eq Show
|
|
||||||
|
|
||||||
JoinTwo
|
|
||||||
joinOne JoinOneId
|
|
||||||
name String
|
|
||||||
deriving Eq Show
|
|
||||||
|
|
||||||
JoinThree
|
|
||||||
joinTwo JoinTwoId
|
|
||||||
name String
|
|
||||||
deriving Eq Show
|
|
||||||
|
|
||||||
JoinFour
|
|
||||||
name String
|
|
||||||
joinThree JoinThreeId
|
|
||||||
deriving Eq Show
|
|
||||||
|
|
||||||
JoinOther
|
|
||||||
name String
|
|
||||||
deriving Eq Show
|
|
||||||
|
|
||||||
JoinMany
|
|
||||||
name String
|
|
||||||
joinOther JoinOtherId
|
|
||||||
joinOne JoinOneId
|
|
||||||
deriving Eq Show
|
|
||||||
|
|
||||||
DateTruncTest
|
|
||||||
created UTCTime
|
|
||||||
deriving Eq Show
|
|
||||||
|]
|
|
||||||
|
|
||||||
-- Unique Test schema
|
|
||||||
share [mkPersist sqlSettings, mkMigrate "migrateUnique"] [persistUpperCase|
|
|
||||||
OneUnique
|
|
||||||
name String
|
|
||||||
value Int
|
|
||||||
UniqueValue value
|
|
||||||
deriving Eq Show
|
|
||||||
|]
|
|
||||||
|
|
||||||
|
|
||||||
instance ToBaseId ArticleMetadata where
|
|
||||||
type BaseEnt ArticleMetadata = Article
|
|
||||||
toBaseIdWitness articleId = ArticleMetadataKey articleId
|
|
||||||
|
|
||||||
-- | this could be achieved with S.fromList, but not all lists
|
-- | this could be achieved with S.fromList, but not all lists
|
||||||
-- have Ord instances
|
-- have Ord instances
|
||||||
sameElementsAs :: Eq a => [a] -> [a] -> Bool
|
sameElementsAs :: Eq a => [a] -> [a] -> Bool
|
||||||
@ -305,29 +150,6 @@ u3 = OneUnique "Third" 0
|
|||||||
u4 :: OneUnique
|
u4 :: OneUnique
|
||||||
u4 = OneUnique "First" 2
|
u4 = OneUnique "First" 2
|
||||||
|
|
||||||
testSelect :: Run -> Spec
|
|
||||||
testSelect run = do
|
|
||||||
describe "select" $ do
|
|
||||||
it "works for a single value" $
|
|
||||||
run $ do
|
|
||||||
ret <- select $ return $ val (3 :: Int)
|
|
||||||
liftIO $ ret `shouldBe` [ Value 3 ]
|
|
||||||
|
|
||||||
it "works for a pair of a single value and ()" $
|
|
||||||
run $ do
|
|
||||||
ret <- select $ return (val (3 :: Int), ())
|
|
||||||
liftIO $ ret `shouldBe` [ (Value 3, ()) ]
|
|
||||||
|
|
||||||
it "works for a single ()" $
|
|
||||||
run $ do
|
|
||||||
ret <- select $ return ()
|
|
||||||
liftIO $ ret `shouldBe` [ () ]
|
|
||||||
|
|
||||||
it "works for a single NULL value" $
|
|
||||||
run $ do
|
|
||||||
ret <- select $ return nothing
|
|
||||||
liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ]
|
|
||||||
|
|
||||||
testSubSelect :: Run -> Spec
|
testSubSelect :: Run -> Spec
|
||||||
testSubSelect run = do
|
testSubSelect run = do
|
||||||
let setup :: MonadIO m => SqlPersistT m ()
|
let setup :: MonadIO m => SqlPersistT m ()
|
||||||
@ -2463,28 +2285,28 @@ listsEqualOn a b f = map f a `shouldBe` map f b
|
|||||||
|
|
||||||
tests :: Run -> Spec
|
tests :: Run -> Spec
|
||||||
tests run = do
|
tests run = do
|
||||||
describe "Tests that are common to all backends" $ do
|
describe "Esqueleto" $ do
|
||||||
testSelect run
|
testSelect run
|
||||||
testSubSelect run
|
testSubSelect run
|
||||||
testSelectSource run
|
testSelectSource run
|
||||||
testSelectFrom run
|
testSelectFrom run
|
||||||
testSelectJoin run
|
testSelectJoin run
|
||||||
testSelectSubQuery run
|
testSelectSubQuery run
|
||||||
testSelectWhere run
|
testSelectWhere run
|
||||||
testSelectOrderBy run
|
testSelectOrderBy run
|
||||||
testSelectDistinct run
|
testSelectDistinct run
|
||||||
testCoasleceDefault run
|
testCoasleceDefault run
|
||||||
testDelete run
|
testDelete run
|
||||||
testUpdate run
|
testUpdate run
|
||||||
testListOfValues run
|
testListOfValues run
|
||||||
testListFields run
|
testListFields run
|
||||||
testInsertsBySelect run
|
testInsertsBySelect run
|
||||||
testMathFunctions run
|
testMathFunctions run
|
||||||
testCase run
|
testCase run
|
||||||
testCountingRows run
|
testCountingRows run
|
||||||
testRenderSql run
|
testRenderSql run
|
||||||
testOnClauseOrder run
|
testOnClauseOrder run
|
||||||
testExperimentalFrom run
|
testExperimentalFrom run
|
||||||
|
|
||||||
|
|
||||||
insert' :: ( Functor m
|
insert' :: ( Functor m
|
||||||
@ -2496,20 +2318,6 @@ insert' :: ( Functor m
|
|||||||
insert' v = flip Entity v <$> insert v
|
insert' v = flip Entity v <$> insert v
|
||||||
|
|
||||||
|
|
||||||
type RunDbMonad m = ( MonadUnliftIO m
|
|
||||||
, MonadIO m
|
|
||||||
, MonadLoggerIO m
|
|
||||||
, MonadLogger m
|
|
||||||
, MonadCatch m )
|
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ >= 806
|
|
||||||
type Run = forall a. (forall m. (RunDbMonad m, MonadFail m) => SqlPersistT (R.ResourceT m) a) -> IO a
|
|
||||||
#else
|
|
||||||
type Run = forall a. (forall m. (RunDbMonad m) => SqlPersistT (R.ResourceT m) a) -> IO a
|
|
||||||
#endif
|
|
||||||
|
|
||||||
type WithConn m a = RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a
|
|
||||||
|
|
||||||
-- With SQLite and in-memory databases, a separate connection implies a
|
-- With SQLite and in-memory databases, a separate connection implies a
|
||||||
-- separate database. With 'actual databases', the data is persistent and
|
-- separate database. With 'actual databases', the data is persistent and
|
||||||
-- thus must be cleaned after each test.
|
-- thus must be cleaned after each test.
|
||||||
|
|||||||
47
test/Common/Test/Import.hs
Normal file
47
test/Common/Test/Import.hs
Normal file
@ -0,0 +1,47 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE ConstraintKinds #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
|
{-# LANGUAGE EmptyDataDecls #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE GADTs #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE PartialTypeSignatures #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE TypeSynonymInstances #-}
|
||||||
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
|
|
||||||
|
module Common.Test.Import
|
||||||
|
( module Common.Test.Import
|
||||||
|
, module X
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Control.Monad.Fail
|
||||||
|
import Common.Test.Models as X
|
||||||
|
import Control.Monad.Catch (MonadCatch)
|
||||||
|
import Control.Monad.Logger (MonadLogger(..), MonadLoggerIO(..))
|
||||||
|
import Database.Esqueleto.Experimental as X
|
||||||
|
import Test.Hspec as X
|
||||||
|
import UnliftIO as X
|
||||||
|
import qualified UnliftIO.Resource as R
|
||||||
|
|
||||||
|
type RunDbMonad m =
|
||||||
|
( MonadUnliftIO m
|
||||||
|
, MonadIO m
|
||||||
|
, MonadLoggerIO m
|
||||||
|
, MonadLogger m
|
||||||
|
, MonadCatch m
|
||||||
|
)
|
||||||
|
|
||||||
|
type Run = forall a. (forall m. (RunDbMonad m, MonadFail m) => SqlPersistT (R.ResourceT m) a) -> IO a
|
||||||
|
|
||||||
|
type WithConn m a = RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a
|
||||||
189
test/Common/Test/Models.hs
Normal file
189
test/Common/Test/Models.hs
Normal file
@ -0,0 +1,189 @@
|
|||||||
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE ConstraintKinds #-}
|
||||||
|
{-# LANGUAGE DataKinds #-}
|
||||||
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
|
{-# LANGUAGE DerivingStrategies #-}
|
||||||
|
{-# LANGUAGE EmptyDataDecls #-}
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE GADTs #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE PartialTypeSignatures #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE StandaloneDeriving #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE TypeSynonymInstances #-}
|
||||||
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
|
|
||||||
|
module Common.Test.Models where
|
||||||
|
|
||||||
|
import Data.Time
|
||||||
|
import Database.Esqueleto.Experimental
|
||||||
|
import Database.Persist.Sql
|
||||||
|
import Database.Persist.TH
|
||||||
|
|
||||||
|
share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistUpperCase|
|
||||||
|
Foo
|
||||||
|
name Int
|
||||||
|
Primary name
|
||||||
|
deriving Show Eq Ord
|
||||||
|
Bar
|
||||||
|
quux FooId
|
||||||
|
deriving Show Eq Ord
|
||||||
|
Baz
|
||||||
|
blargh FooId
|
||||||
|
deriving Show Eq
|
||||||
|
Shoop
|
||||||
|
baz BazId
|
||||||
|
deriving Show Eq
|
||||||
|
Asdf
|
||||||
|
shoop ShoopId
|
||||||
|
deriving Show Eq
|
||||||
|
Another
|
||||||
|
why BazId
|
||||||
|
YetAnother
|
||||||
|
argh ShoopId
|
||||||
|
|
||||||
|
Person
|
||||||
|
name String
|
||||||
|
age Int Maybe
|
||||||
|
weight Int Maybe
|
||||||
|
favNum Int
|
||||||
|
deriving Eq Show Ord
|
||||||
|
BlogPost
|
||||||
|
title String
|
||||||
|
authorId PersonId
|
||||||
|
deriving Eq Show
|
||||||
|
Comment
|
||||||
|
body String
|
||||||
|
blog BlogPostId
|
||||||
|
deriving Eq Show
|
||||||
|
CommentReply
|
||||||
|
body String
|
||||||
|
comment CommentId
|
||||||
|
Profile
|
||||||
|
name String
|
||||||
|
person PersonId
|
||||||
|
deriving Eq Show
|
||||||
|
Reply
|
||||||
|
guy PersonId
|
||||||
|
body String
|
||||||
|
deriving Eq Show
|
||||||
|
|
||||||
|
Lord
|
||||||
|
county String maxlen=100
|
||||||
|
dogs Int Maybe
|
||||||
|
Primary county
|
||||||
|
deriving Eq Show
|
||||||
|
|
||||||
|
Deed
|
||||||
|
contract String maxlen=100
|
||||||
|
ownerId LordId maxlen=100
|
||||||
|
Primary contract
|
||||||
|
deriving Eq Show
|
||||||
|
|
||||||
|
Follow
|
||||||
|
follower PersonId
|
||||||
|
followed PersonId
|
||||||
|
deriving Eq Show
|
||||||
|
|
||||||
|
CcList
|
||||||
|
names [String]
|
||||||
|
|
||||||
|
Frontcover
|
||||||
|
number Int
|
||||||
|
title String
|
||||||
|
Primary number
|
||||||
|
deriving Eq Show
|
||||||
|
Article
|
||||||
|
title String
|
||||||
|
frontcoverNumber Int
|
||||||
|
Foreign Frontcover fkfrontcover frontcoverNumber
|
||||||
|
deriving Eq Show
|
||||||
|
ArticleMetadata
|
||||||
|
articleId ArticleId
|
||||||
|
Primary articleId
|
||||||
|
deriving Eq Show
|
||||||
|
Tag
|
||||||
|
name String maxlen=100
|
||||||
|
Primary name
|
||||||
|
deriving Eq Show
|
||||||
|
ArticleTag
|
||||||
|
articleId ArticleId
|
||||||
|
tagId TagId maxlen=100
|
||||||
|
Primary articleId tagId
|
||||||
|
deriving Eq Show
|
||||||
|
Article2
|
||||||
|
title String
|
||||||
|
frontcoverId FrontcoverId
|
||||||
|
deriving Eq Show
|
||||||
|
Point
|
||||||
|
x Int
|
||||||
|
y Int
|
||||||
|
name String
|
||||||
|
Primary x y
|
||||||
|
deriving Eq Show
|
||||||
|
Circle
|
||||||
|
centerX Int
|
||||||
|
centerY Int
|
||||||
|
name String
|
||||||
|
Foreign Point fkpoint centerX centerY
|
||||||
|
deriving Eq Show
|
||||||
|
Numbers
|
||||||
|
int Int
|
||||||
|
double Double
|
||||||
|
deriving Eq Show
|
||||||
|
|
||||||
|
JoinOne
|
||||||
|
name String
|
||||||
|
deriving Eq Show
|
||||||
|
|
||||||
|
JoinTwo
|
||||||
|
joinOne JoinOneId
|
||||||
|
name String
|
||||||
|
deriving Eq Show
|
||||||
|
|
||||||
|
JoinThree
|
||||||
|
joinTwo JoinTwoId
|
||||||
|
name String
|
||||||
|
deriving Eq Show
|
||||||
|
|
||||||
|
JoinFour
|
||||||
|
name String
|
||||||
|
joinThree JoinThreeId
|
||||||
|
deriving Eq Show
|
||||||
|
|
||||||
|
JoinOther
|
||||||
|
name String
|
||||||
|
deriving Eq Show
|
||||||
|
|
||||||
|
JoinMany
|
||||||
|
name String
|
||||||
|
joinOther JoinOtherId
|
||||||
|
joinOne JoinOneId
|
||||||
|
deriving Eq Show
|
||||||
|
|
||||||
|
DateTruncTest
|
||||||
|
created UTCTime
|
||||||
|
deriving Eq Show
|
||||||
|
|]
|
||||||
|
|
||||||
|
-- Unique Test schema
|
||||||
|
share [mkPersist sqlSettings, mkMigrate "migrateUnique"] [persistUpperCase|
|
||||||
|
OneUnique
|
||||||
|
name String
|
||||||
|
value Int
|
||||||
|
UniqueValue value
|
||||||
|
deriving Eq Show
|
||||||
|
|]
|
||||||
|
|
||||||
|
|
||||||
|
instance ToBaseId ArticleMetadata where
|
||||||
|
type BaseEnt ArticleMetadata = Article
|
||||||
|
toBaseIdWitness articleId = ArticleMetadataKey articleId
|
||||||
|
|
||||||
26
test/Common/Test/Select.hs
Normal file
26
test/Common/Test/Select.hs
Normal file
@ -0,0 +1,26 @@
|
|||||||
|
module Common.Test.Select where
|
||||||
|
|
||||||
|
import Common.Test.Import
|
||||||
|
|
||||||
|
testSelect :: Run -> Spec
|
||||||
|
testSelect run = do
|
||||||
|
describe "select" $ do
|
||||||
|
it "works for a single value" $
|
||||||
|
run $ do
|
||||||
|
ret <- select $ return $ val (3 :: Int)
|
||||||
|
liftIO $ ret `shouldBe` [ Value 3 ]
|
||||||
|
|
||||||
|
it "works for a pair of a single value and ()" $
|
||||||
|
run $ do
|
||||||
|
ret <- select $ return (val (3 :: Int), ())
|
||||||
|
liftIO $ ret `shouldBe` [ (Value 3, ()) ]
|
||||||
|
|
||||||
|
it "works for a single ()" $
|
||||||
|
run $ do
|
||||||
|
ret <- select $ return ()
|
||||||
|
liftIO $ ret `shouldBe` [ () ]
|
||||||
|
|
||||||
|
it "works for a single NULL value" $
|
||||||
|
run $ do
|
||||||
|
ret <- select $ return nothing
|
||||||
|
liftIO $ ret `shouldBe` [ Value (Nothing :: Maybe Int) ]
|
||||||
@ -4,7 +4,7 @@
|
|||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
|
||||||
module Main (main) where
|
module MySQL.Test where
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
@ -194,28 +194,23 @@ testMysqlUnionWithLimits = do
|
|||||||
ret <- select $ Experimental.from $ q1 `union_` q2
|
ret <- select $ Experimental.from $ q1 `union_` q2
|
||||||
liftIO $ ret `shouldMatchList` [Value 1, Value 2, Value 4, Value 5]
|
liftIO $ ret `shouldMatchList` [Value 1, Value 2, Value 4, Value 5]
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
main :: IO ()
|
spec = do
|
||||||
main = do
|
|
||||||
hspec $ do
|
|
||||||
tests run
|
tests run
|
||||||
|
|
||||||
describe "Test MySQL locking" $ do
|
describe "Test MySQL locking" $ do
|
||||||
testLocking withConn
|
testLocking withConn
|
||||||
|
|
||||||
describe "MySQL specific tests" $ do
|
describe "MySQL specific tests" $ do
|
||||||
-- definitely doesn't work at the moment
|
-- definitely doesn't work at the moment
|
||||||
-- testMysqlRandom
|
-- testMysqlRandom
|
||||||
testMysqlSum
|
testMysqlSum
|
||||||
testMysqlTwoAscFields
|
testMysqlTwoAscFields
|
||||||
testMysqlOneAscOneDesc
|
testMysqlOneAscOneDesc
|
||||||
testMysqlCoalesce
|
testMysqlCoalesce
|
||||||
testMysqlUpdate
|
testMysqlUpdate
|
||||||
testMysqlTextFunctions
|
testMysqlTextFunctions
|
||||||
testMysqlUnionWithLimits
|
testMysqlUnionWithLimits
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
run, runSilent, runVerbose :: Run
|
run, runSilent, runVerbose :: Run
|
||||||
runSilent act = runNoLoggingT $ run_worker act
|
runSilent act = runNoLoggingT $ run_worker act
|
||||||
|
|||||||
@ -8,7 +8,8 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeApplications #-}
|
{-# LANGUAGE TypeApplications #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
module Main (main) where
|
|
||||||
|
module PostgreSQL.Test where
|
||||||
|
|
||||||
import Control.Arrow ((&&&))
|
import Control.Arrow ((&&&))
|
||||||
import Control.Monad (void, when)
|
import Control.Monad (void, when)
|
||||||
@ -1393,40 +1394,39 @@ selectJSON f = select $ from $ \v -> do
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
main :: IO ()
|
spec :: Spec
|
||||||
main = do
|
spec = do
|
||||||
hspec $ do
|
tests run
|
||||||
tests run
|
|
||||||
|
|
||||||
describe "Test PostgreSQL locking" $ do
|
describe "Test PostgreSQL locking" $ do
|
||||||
testLocking withConn
|
testLocking withConn
|
||||||
|
|
||||||
describe "PostgreSQL specific tests" $ do
|
describe "PostgreSQL specific tests" $ do
|
||||||
testAscRandom random_ run
|
testAscRandom random_ run
|
||||||
testRandomMath run
|
testRandomMath run
|
||||||
testSelectDistinctOn
|
testSelectDistinctOn
|
||||||
testPostgresModule
|
testPostgresModule
|
||||||
testPostgresqlOneAscOneDesc
|
testPostgresqlOneAscOneDesc
|
||||||
testPostgresqlTwoAscFields
|
testPostgresqlTwoAscFields
|
||||||
testPostgresqlSum
|
testPostgresqlSum
|
||||||
testPostgresqlRandom
|
testPostgresqlRandom
|
||||||
testPostgresqlUpdate
|
testPostgresqlUpdate
|
||||||
testPostgresqlCoalesce
|
testPostgresqlCoalesce
|
||||||
testPostgresqlTextFunctions
|
testPostgresqlTextFunctions
|
||||||
testInsertUniqueViolation
|
testInsertUniqueViolation
|
||||||
testUpsert
|
testUpsert
|
||||||
testInsertSelectWithConflict
|
testInsertSelectWithConflict
|
||||||
testFilterWhere
|
testFilterWhere
|
||||||
testCommonTableExpressions
|
testCommonTableExpressions
|
||||||
describe "PostgreSQL JSON tests" $ do
|
describe "PostgreSQL JSON tests" $ do
|
||||||
-- NOTE: We only clean the table once, so we
|
-- NOTE: We only clean the table once, so we
|
||||||
-- can use its contents across all JSON tests
|
-- can use its contents across all JSON tests
|
||||||
it "MIGRATE AND CLEAN JSON TABLE" $ run $ do
|
it "MIGRATE AND CLEAN JSON TABLE" $ run $ do
|
||||||
void $ runMigrationSilent migrateJSON
|
void $ runMigrationSilent migrateJSON
|
||||||
cleanJSON
|
cleanJSON
|
||||||
testJSONInsertions
|
testJSONInsertions
|
||||||
testJSONOperators
|
testJSONOperators
|
||||||
testLateralQuery
|
testLateralQuery
|
||||||
|
|
||||||
run, runSilent, runVerbose :: Run
|
run, runSilent, runVerbose :: Run
|
||||||
runSilent act = runNoLoggingT $ run_worker act
|
runSilent act = runNoLoggingT $ run_worker act
|
||||||
|
|||||||
@ -4,7 +4,7 @@
|
|||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
|
||||||
module Main (main) where
|
module SQLite.Test where
|
||||||
|
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
import Control.Monad.IO.Class (MonadIO(liftIO))
|
import Control.Monad.IO.Class (MonadIO(liftIO))
|
||||||
@ -19,9 +19,6 @@ import Test.Hspec
|
|||||||
|
|
||||||
import Common.Test
|
import Common.Test
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
testSqliteRandom :: Spec
|
testSqliteRandom :: Spec
|
||||||
testSqliteRandom = do
|
testSqliteRandom = do
|
||||||
it "works with random_" $
|
it "works with random_" $
|
||||||
@ -162,7 +159,10 @@ testSqliteTextFunctions = do
|
|||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
hspec $ do
|
hspec spec
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = do
|
||||||
tests run
|
tests run
|
||||||
|
|
||||||
describe "Test SQLite locking" $ do
|
describe "Test SQLite locking" $ do
|
||||||
|
|||||||
22
test/Spec.hs
Normal file
22
test/Spec.hs
Normal file
@ -0,0 +1,22 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import Test.Hspec
|
||||||
|
import Test.Hspec.Core.Spec
|
||||||
|
|
||||||
|
import qualified SQLite.Test as SQLite
|
||||||
|
import qualified MySQL.Test as MySQL
|
||||||
|
import qualified PostgreSQL.Test as Postgres
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = hspec spec
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec = do
|
||||||
|
parallel $ describe "Esqueleto" $ do
|
||||||
|
describe "SQLite" $ do
|
||||||
|
sequential $ SQLite.spec
|
||||||
|
describe "MySQL" $ do
|
||||||
|
sequential $ MySQL.spec
|
||||||
|
describe "Postgresql" $ do
|
||||||
|
sequential $ Postgres.spec
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user