packages feed

persistent-test-2.13.2.1: src/PersistentTest.hs

{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module PersistentTest
    ( module PersistentTest
    , cleanDB
    , testMigrate
    , noPrefixMigrate
    , customPrefixMigrate
    , treeMigrate
    ) where

import Control.Monad.Fail
import Control.Monad.IO.Class
import Data.Aeson
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.Functor.Constant
import Data.Functor.Identity
import qualified Data.Map as Map
import Data.Maybe (fromJust)
import Data.Proxy (Proxy (..))
import Test.HUnit hiding (Test)
import Test.Hspec.QuickCheck (prop)
import UnliftIO (MonadUnliftIO, catch)
import Web.PathPieces (PathPiece (..))

import Database.Persist
import Init
import PersistTestPetCollarType
import PersistTestPetType
import PersistentTestModels

catchPersistException :: (MonadUnliftIO m, MonadFail m) => m a -> b -> m b
catchPersistException action errValue = do
    Left res <-
        (Right `fmap` action)
            `catch` (\(_ :: PersistException) -> return $ Left errValue)
    return res

filterOrSpecs
    :: forall m backend
     . (Runner backend m)
    => RunDb backend m
    -> Spec
filterOrSpecs runDb = describe "FilterOr" $ do
    it "FilterOr []" $ runDb $ do
        let
            p = Person "z" 1 Nothing
        insert_ p
        ps <- selectList [FilterOr []] [Desc PersonAge]
        assertEmpty ps
    it "||. []" $ runDb $ do
        let
            p = Person "z" 1 Nothing
        insert_ p
        c <- count $ [PersonName ==. "a"] ||. []
        c @== (1 :: Int)

-- Test proper polymorphism
_polymorphic
    :: ( MonadFail m
       , MonadIO m
       , PersistQuery backend
       , BaseBackend backend ~ PersistEntityBackend Pet
       )
    => ReaderT backend m ()
_polymorphic = do
    ((Entity id' _) : _) <- selectList [] [LimitTo 1]
    _ <- selectList [PetOwnerId ==. id'] []
    insert_ $ Pet id' "foo" Cat
    return ()

-- Some lens stuff
type ASetter s t a b = (a -> Identity b) -> s -> Identity t

set :: ASetter s t a b -> b -> s -> t
set l b = runIdentity . (l (\_ -> Identity b))

type Getting r s t a b = (a -> Constant r b) -> s -> Constant r t

view :: s -> Getting a s t a b -> a
view s l = getConstant (l Constant s)

safeToRemoveSpec
    :: forall backend m. (Runner backend m) => RunDb backend m -> Spec
safeToRemoveSpec runDb = do
    describe "DudeWeirdColumns" $ do
        it "can insert and get" $ do
            let
                m = DudeWeirdColumns "hello"
            runDb $ do
                k <- insert m
                mval <- get k
                liftIO $ fmap dudeWeirdColumnsName mval `shouldBe` Just "hello"
        it "can putMany" $ do
            let
                ms =
                    [ DudeWeirdColumns "hello"
                    , DudeWeirdColumns "goodbyue"
                    ]
            runDb $ putMany ms

specsWith :: forall backend m. (Runner backend m) => RunDb backend m -> Spec
specsWith runDb = describe "persistent" $ do
    describe "SafeToRemove" (safeToRemoveSpec runDb)
    it "fieldLens" $ do
        let
            michael = Entity undefined $ Person "Michael" 28 Nothing :: Entity Person
            michaelP1 = Person "Michael" 29 Nothing :: Person
        view michael (fieldLens PersonAge) @?= 28
        entityVal (set (fieldLens PersonAge) 29 michael) @?= michaelP1

    it "FilterAnd []" $ runDb $ do
        let
            p = Person "z" 1 Nothing
        insert_ p
        ps <- selectList [FilterAnd []] [Desc PersonAge]
        assertNotEmpty ps

    it "Filter In" $ runDb $ do
        _ <- selectList [Filter PersonName (FilterValues ["Kostas"]) In] []
        return ()

    it "order of opts is irrelevant" $ runDb $ do
        let
            eq (a, b, _) (c, d) = (a, b) @== (c, d)
            limitOffsetOrder' :: [SelectOpt Person] -> (Int, Int, [SelectOpt Person])
            limitOffsetOrder' = limitOffsetOrder
        limitOffsetOrder' [Desc PersonAge] `eq` (0, 0)
        limitOffsetOrder' [LimitTo 2, Desc PersonAge] `eq` (2, 0)
        limitOffsetOrder' [Desc PersonAge, LimitTo 2] `eq` (2, 0)
        limitOffsetOrder' [LimitTo 2, Desc PersonAge, OffsetBy 3] `eq` (2, 3)

        insertMany_
            [ Person "z" 1 Nothing
            , Person "y" 2 Nothing
            , Person "x" 1 Nothing
            , Person "w" 2 Nothing
            , Person "v" 1 Nothing
            , Person "u" 2 Nothing
            ]

        a <-
            map (personName . entityVal)
                <$> selectList [] [Desc PersonAge, Asc PersonName, OffsetBy 2, LimitTo 3]
        a @== ["y", "v", "x"]

        b <-
            map (personName . entityVal)
                <$> selectList [] [OffsetBy 2, Desc PersonAge, LimitTo 3, Asc PersonName]
        b @== a

        c <-
            map (personName . entityVal)
                <$> selectList
                    []
                    [OffsetBy 2, Desc PersonAge, LimitTo 3, Asc PersonName, LimitTo 1, OffsetBy 1]
        c @== a

    it "passes the general tests" $ runDb $ do
        let
            mic26 = Person "Michael" 26 Nothing
        micK <- insert mic26
        results <- selectList [PersonName ==. "Michael"] []
        results @== [Entity micK mic26]

        results' <- selectList [PersonAge <. 28] []
        results' @== [Entity micK mic26]

        p28 <- updateGet micK [PersonAge =. 28]
        personAge p28 @== 28

        updateWhere [PersonName ==. "Michael"] [PersonAge =. 29]
        uc <- count [PersonName ==. "Michael"]
        uc @== 1
        Just mic29 <- get micK
        personAge mic29 @== 29

        let
            louis = Person "Louis" 55 $ Just "brown"
        ex0 <- exists [PersonName ==. "Louis"]
        ex0 @== False
        louisK <- insert louis
        ex1 <- exists [PersonName ==. "Louis"]
        ex1 @== True
        delete louisK

        let
            eli = Person "Eliezer" 2 $ Just "blue"
        insert_ eli
        pasc <- selectList [] [Asc PersonAge]
        map entityVal pasc @== [eli, mic29]

        let
            abe30 = Person "Abe" 30 $ Just "black"
        insert_ abe30
        -- pdesc <- selectList [PersonAge <. 30] [Desc PersonName]
        map entityVal pasc @== [eli, mic29]

        abes <- selectList [PersonName ==. "Abe"] []
        map entityVal abes @== [abe30]

        Just (Entity _ p3) <- getBy $ PersonNameKey "Michael"
        p3 @== mic29

        ps <- selectList [PersonColor ==. Just "blue"] []
        map entityVal ps @== [eli]

        ps2 <- selectList [PersonColor ==. Nothing] []
        map entityVal ps2 @== [mic29]

        delete micK
        Nothing <- get micK
        return ()
    it "persistIdField" $ runDb $ do
        let
            p = Person "foo" 100 (Just "blue")
            q = Person "bar" 101 Nothing
        pk <- insert p
        qk <- insert q

        mp <- selectFirst [persistIdField ==. pk] []
        fmap entityVal mp @== Just p

        mq <- selectFirst [persistIdField ==. qk] []
        fmap entityVal mq @== Just q

    it "!=." $ runDb $ do
        deleteWhere ([] :: [Filter (PersonGeneric backend)])
        let
            mic = Person "Michael" 25 Nothing
        insert_ mic
        let
            eli = Person "Eliezer" 25 (Just "Red")
        insert_ eli

        pne <- selectList [PersonName !=. "Michael"] []
        map entityVal pne @== [eli]

        ps <- selectList [PersonColor !=. Nothing] []
        map entityVal ps @== [eli]

        pnm <- selectList [PersonName !=. "Eliezer"] []
        map entityVal pnm @== [mic]

    it "Double Maybe" $ runDb $ do
        deleteWhere ([] :: [Filter (PersonMayGeneric backend)])
        let
            mic = PersonMay (Just "Michael") Nothing
        insert_ mic
        let
            eli = PersonMay (Just "Eliezer") (Just "Red")
        insert_ eli
        pe <- selectList [PersonMayName ==. Nothing, PersonMayColor ==. Nothing] []
        map entityVal pe @== []
        pne <- selectList [PersonMayName !=. Nothing, PersonMayColor !=. Nothing] []
        map entityVal pne @== [eli]

    it "and/or" $ runDb $ do
        deleteWhere ([] :: [Filter (Person1Generic backend)])
        insertMany_
            [ Person1 "Michael" 25
            , Person1 "Miriam" 25
            , Person1 "Michael" 30
            , Person1 "Michael" 35
            ]

        c10 <-
            count $
                [Person1Name ==. "Michael"] ||. [Person1Name ==. "Miriam", Person1Age ==. 25]
        c10 @== 4
        c12 <-
            count
                [ FilterOr
                    [FilterAnd [Person1Name ==. "Michael"], FilterAnd [Person1Name ==. "Miriam"]]
                ]
        c12 @== 4
        c14 <-
            count
                [ FilterOr
                    [ FilterAnd [Person1Name ==. "Michael"]
                    , FilterAnd [Person1Name ==. "Miriam"]
                    , FilterAnd [Person1Age >. 29, Person1Age <=. 30]
                    ]
                ]
        c14 @== 4

        c20 <-
            count $ [Person1Name ==. "Miriam"] ||. [Person1Age >. 29, Person1Age <=. 30]
        c20 @== 2
        c22 <- count $ [Person1Age <=. 30] ++ [Person1Age >. 29]
        c22 @== 1
        c24 <- count $ [FilterAnd [Person1Age <=. 30, Person1Age >. 29]]
        c24 @== 1
        c26 <- count $ [Person1Age <=. 30] ++ [Person1Age >. 29]
        c26 @== 1

        c34 <-
            count $
                [Person1Name ==. "Michael"]
                    ||. [Person1Name ==. "Mirieam"] ++ [Person1Age <. 35]
        c34 @== 3
        c30 <-
            count $
                ([Person1Name ==. "Michael"] ||. [Person1Name ==. "Miriam"])
                    ++ [Person1Age <. 35]
        c30 @== 3
        c36 <-
            count $
                [Person1Name ==. "Michael"]
                    ||. ([Person1Name ==. "Miriam"] ++ [Person1Age <. 35])
        c36 @== 4

        c40 <-
            count $
                ( [Person1Name ==. "Michael"]
                    ||. [Person1Name ==. "Miriam"]
                    ||. [Person1Age <. 35]
                )
        c40 @== 4

    it "deleteWhere" $ runDb $ do
        key2 <- insert $ Person "Michael2" 90 Nothing
        _ <- insert $ Person "Michael3" 90 Nothing
        let
            p91 = Person "Michael4" 91 Nothing
        key91 <- insert p91

        ps90 <- selectList [PersonAge ==. 90] []
        assertNotEmpty ps90
        deleteWhere [PersonAge ==. 90]
        ps90' <- selectList [PersonAge ==. 90] []
        assertEmpty ps90'
        Nothing <- get key2

        Just p2_91 <- get key91
        p91 @== p2_91

    it "deleteBy" $ runDb $ do
        insert_ $ Person "Michael2" 27 Nothing
        let
            p3 = Person "Michael3" 27 Nothing
        key3 <- insert p3

        ps2 <- selectList [PersonName ==. "Michael2"] []
        assertNotEmpty ps2

        deleteBy $ PersonNameKey "Michael2"
        ps2' <- selectList [PersonName ==. "Michael2"] []
        assertEmpty ps2'

        Just p32 <- get key3
        p3 @== p32

    it "delete" $ runDb $ do
        key2 <- insert $ Person "Michael2" 27 Nothing
        let
            p3 = Person "Michael3" 27 Nothing
        key3 <- insert p3

        pm2 <- selectList [PersonName ==. "Michael2"] []
        assertNotEmpty pm2
        delete key2
        pm2' <- selectList [PersonName ==. "Michael2"] []
        assertEmpty pm2'

        Just p <- get key3
        p3 @== p

    prop "toPathPiece . fromPathPiece" $ \piece ->
        let
            key1 = piece :: (BackendKey SqlBackend)
            key2 = fromJust $ fromPathPiece $ toPathPiece key1 :: (BackendKey SqlBackend)
         in
            toPathPiece key1 == toPathPiece key2

    it "replace" $ runDb $ do
        key2 <- insert $ Person "Michael2" 27 Nothing
        let
            p3 = Person "Michael3" 27 Nothing
        replace key2 p3
        Just p <- get key2
        p @== p3

        -- test replace an empty key
        delete key2
        Nothing <- get key2
        _ <- replace key2 p3
        Nothing <- get key2
        return ()

        let
            mic = Person "Michael" 25 Nothing
        micK <- insert mic
        Just p1 <- get micK
        p1 @== mic

        replace micK $ Person "Michael" 25 Nothing
        Just p2 <- get micK
        p2 @== mic

        replace micK $ Person "Michael" 26 Nothing
        Just mic26 <- get micK
        mic26 @/= mic
        personAge mic26 @== personAge mic + 1

    it "getBy" $ runDb $ do
        let
            p2 = Person "Michael2" 27 Nothing
        key2 <- insert p2
        Just (Entity k p) <- getBy $ PersonNameKey "Michael2"
        p @== p2
        k @== key2
        Nothing <- getBy $ PersonNameKey "Michael9"

        Just (Entity k' p') <- getByValue p2
        k' @== k
        p' @== p
        return ()

    it "updateGet" $ runDb $ do
        let
            p25 = Person "Michael" 25 Nothing
        key25 <- insert p25
        pBlue28 <- updateGet key25 [PersonAge =. 28, PersonName =. "Updated"]
        pBlue28 @== Person "Updated" 28 Nothing
        pBlue30 <- updateGet key25 [PersonAge +=. 2]
        pBlue30 @== Person "Updated" 30 Nothing

    describe "repsertMany" $ do
        it "adds new rows when no conflicts" $ runDb $ do
            ids@[johnId, janeId, aliceId, eveId] <-
                replicateM 4 $ liftIO (Person1Key `fmap` generateKey)
            let
                john = Person1 "john" 20
            let
                jane = Person1 "jane" 18
            let
                alice = Person1 "alice" 18
            let
                eve = Person1 "eve" 19

            insertKey johnId john
            insertKey janeId jane

            _ <- repsertMany [(aliceId, alice), (eveId, eve)]
            es <- getMany ids

            let
                rs = [john, jane, alice, eve]
            es @== Map.fromList (zip ids rs)
            mapM_ delete ids

        it "handles conflicts by replacing old keys with new records" $ runDb $ do
            let
                john = Person1 "john" 20
            let
                jane = Person1 "jane" 18
            let
                alice = Person1 "alice" 18
            let
                eve = Person1 "eve" 19

            johnId <- insert john
            janeId <- insert jane

            _ <- repsertMany [(johnId, alice), (janeId, eve)]
            (Just alice') <- get johnId
            (Just eve') <- get janeId

            [alice', eve'] @== [alice, eve]
            mapM_ delete [johnId, janeId]

    it "updateWhere" $ runDb $ do
        let
            p1 = Person "Michael" 25 Nothing
        let
            p2 = Person "Michael2" 25 Nothing
        key1 <- insert p1
        key2 <- insert p2
        updateWhere
            [PersonName ==. "Michael2"]
            [PersonAge +=. 3, PersonName =. "Updated"]
        Just pBlue28 <- get key2
        pBlue28 @== Person "Updated" 28 Nothing
        Just p <- get key1
        p @== p1

    it "selectList" $ runDb $ do
        let
            p25 = Person "Michael" 25 Nothing
        let
            p26 = Person "Michael2" 26 Nothing
        [key25, key26] <- insertMany [p25, p26]
        ps1 <- selectList [] [Asc PersonAge]
        ps1 @== [(Entity key25 p25), (Entity key26 p26)]
        -- limit
        ps2 <- selectList [] [Asc PersonAge, LimitTo 1]
        ps2 @== [(Entity key25 p25)]
        -- offset
        ps3 <- selectList [] [Asc PersonAge, OffsetBy 1]
        ps3 @== [(Entity key26 p26)]
        -- limit & offset
        ps4 <- selectList [] [Asc PersonAge, LimitTo 1, OffsetBy 1]
        ps4 @== [(Entity key26 p26)]

        ps5 <- selectList [] [Desc PersonAge]
        ps5 @== [(Entity key26 p26), (Entity key25 p25)]
        ps6 <- selectList [PersonAge ==. 26] []
        ps6 @== [(Entity key26 p26)]

    it "selectSource" $ runDb $ do
        let
            p1 = Person "selectSource1" 1 Nothing
            p2 = Person "selectSource2" 2 Nothing
            p3 = Person "selectSource3" 3 Nothing
        [k1, k2, k3] <- insertMany [p1, p2, p3]

        ps1 <- runConduitRes $ selectSource [] [Desc PersonAge] .| await
        ps1 @== Just (Entity k3 p3)

        ps2 <-
            runConduitRes $ selectSource [PersonAge <. 3] [Asc PersonAge] .| CL.consume
        ps2 @== [Entity k1 p1, Entity k2 p2]

        runConduitRes $
            selectSource [] [Desc PersonAge] .| do
                e1 <- await
                e1 @== Just (Entity k3 p3)

                e2 <- await
                e2 @== Just (Entity k2 p2)

                e3 <- await
                e3 @== Just (Entity k1 p1)

                e4 <- await
                e4 @== Nothing

    it "selectFirst" $ runDb $ do
        insert_ $ Person "Michael" 26 Nothing
        let
            pOld = Person "Oldie" 75 Nothing
        kOld <- insert pOld

        x <- selectFirst [] [Desc PersonAge]
        x @== Just (Entity kOld pOld)

    it "selectKeys" $ runDb $ do
        let
            p1 = Person "selectKeys1" 1 Nothing
            p2 = Person "selectKeys2" 2 Nothing
            p3 = Person "selectKeys3" 3 Nothing
        [k1, k2, k3] <- insertMany [p1, p2, p3]

        ps1 <- runConduitRes $ selectKeys [] [Desc PersonAge] .| await
        ps1 @== Just k3

        ps2 <- runConduitRes $ selectKeys [PersonAge <. 3] [Asc PersonAge] .| CL.consume
        ps2 @== [k1, k2]

        runConduitRes $
            selectKeys [] [Desc PersonAge] .| do
                e1 <- await
                e1 @== Just k3

                e2 <- await
                e2 @== Just k2

                e3 <- await
                e3 @== Just k1

                e4 <- await
                e4 @== Nothing

    it "insertMany_ with no arguments" $ runDb $ do
        _ <- insertMany_ ([] :: [PersonGeneric backend])
        rows <-
            (count ([] :: [Filter (PersonGeneric backend)]) :: ReaderT backend m Int)
        rows @== 0
        _ <- insertMany ([] :: [PersonGeneric backend])
        rows2 <- count ([] :: [Filter (PersonGeneric backend)])
        rows2 @== 0
        _ <- insertEntityMany ([] :: [Entity (PersonGeneric backend)])
        rows3 <- count ([] :: [Filter (PersonGeneric backend)])
        rows3 @== 0

    it "insertEntityMany" $ runDb $ do
        id1 : id2 : id3 : id4 : id5 : [] <-
            liftIO $ replicateM 5 (PersonKey `fmap` generateKey)
        let
            p1 = Entity id1 $ Person "insertEntityMany1" 1 Nothing
            p2 = Entity id2 $ Person "insertEntityMany2" 2 Nothing
            p3 = Entity id3 $ Person "insertEntityMany3" 3 Nothing
            p4 = Entity id4 $ Person "insertEntityMany4" 3 Nothing
            p5 = Entity id5 $ Person "insertEntityMany5" 3 Nothing
        insertEntityMany [p1, p2, p3, p4, p5]
        rows <- count ([] :: [Filter (PersonGeneric backend)])
        rows @== 5

    it "insertBy" $ runDb $ do
        Right _ <- insertBy $ Person "name" 1 Nothing
        Left _ <- insertBy $ Person "name" 1 Nothing
        Right _ <- insertBy $ Person "name2" 1 Nothing
        return ()

    it "insertKey" $ runDb $ do
        k <- liftIO (PersonKey `fmap` generateKey)
        insertKey k $ Person "Key" 26 Nothing
        Just (Entity k2 _) <- selectFirst [PersonName ==. "Key"] []
        k2 @== k

    it "insertEntity" $ runDb $ do
        Entity k p <- insertEntity $ Person "name" 1 Nothing
        Just p2 <- get k
        p2 @== p

    it "insertRecord" $ runDb $ do
        let
            record = Person "name" 1 Nothing
        record' <- insertRecord record
        record' @== record

    it "getEntity" $ runDb $ do
        Entity k p <- insertEntity $ Person "name" 1 Nothing
        Just (Entity k2 p2) <- getEntity k
        p @== p2
        k @== k2

    it "getJustEntity" $ runDb $ do
        let
            p1 = Person "name" 1 Nothing
        k1 <- insert p1
        Entity k2 p2 <- getJustEntity k1
        p1 @== p2
        k1 @== k2

    it "repsert" $ runDb $ do
        k <- liftIO (PersonKey `fmap` generateKey)
        Nothing <- selectFirst [PersonName ==. "Repsert"] []
        repsert k $ Person "Repsert" 26 Nothing
        Just (Entity k2 _) <- selectFirst [PersonName ==. "Repsert"] []
        k2 @== k
        repsert k $ Person "Repsert" 27 Nothing
        Just (Entity k3 p) <- selectFirst [PersonName ==. "Repsert"] []
        k3 @== k
        27 @== personAge p

    it "retrieves a belongsToJust association" $ runDb $ do
        let
            p = Person "pet owner" 30 Nothing
        person <- insert p
        let
            cat = Pet person "Mittens" Cat
        p2 <- getJust $ petOwnerId cat
        p @== p2
        p3 <- belongsToJust petOwnerId cat
        p @== p3

    it "retrieves a belongsTo association" $ runDb $ do
        let
            p = Person "pet owner" 30 Nothing
        person <- insert p
        let
            cat = MaybeOwnedPet (Just person) "Mittens" Cat
        p2 <- getJust $ fromJust $ maybeOwnedPetOwnerId cat
        p @== p2
        Just p4 <- belongsTo maybeOwnedPetOwnerId cat
        p @== p4

    it "derivePersistField" $ runDb $ do
        person <- insert $ Person "pet owner" 30 Nothing
        catKey <- insert $ Pet person "Mittens" Cat
        Just cat' <- get catKey
        liftIO $ petType cat' @?= Cat
        dog <- insert $ Pet person "Spike" Dog
        Just dog' <- get dog
        liftIO $ petType dog' @?= Dog

    it "derivePersistFieldJSON" $ runDb $ do
        let
            mittensCollar = PetCollar "Mittens\n1-714-668-9672" True
        pkey <- insert $ Person "pet owner" 30 Nothing
        catKey <- insert $ OutdoorPet pkey mittensCollar Cat
        Just (OutdoorPet _ collar' _) <- get catKey
        liftIO $ collar' @?= mittensCollar

    it "idIn" $ runDb $ do
        let
            p1 = Person "D" 0 Nothing
            p2 = Person "E" 1 Nothing
            p3 = Person "F" 2 Nothing
        pid1 <- insert p1
        insert_ p2
        pid3 <- insert p3
        x <- selectList [PersonId <-. [pid1, pid3]] []
        liftIO $ x @?= [Entity pid1 p1, Entity pid3 p3]

    it "In" $ runDb $ do
        let
            p1 = Person "D" 0 Nothing
            p2 = Person "E" 1 Nothing
            p3 = Person "F" 2 (Just "blue")
        insert_ p1
        insert_ p2
        insert_ p3
        x1 <- fmap entityVal `fmap` selectList [PersonName <-. ["D"]] []
        liftIO $ x1 @?= [p1]
        x2 <- fmap entityVal `fmap` selectList [PersonName /<-. ["D"]] []
        liftIO $ x2 @?= [p2, p3]

        x3 <- fmap entityVal `fmap` selectList [PersonColor <-. [Just "blue"]] []
        liftIO $ x3 @?= [p3]
        x4 <- fmap entityVal `fmap` selectList [PersonColor /<-. [Just "blue"]] []
        liftIO $ x4 @?= [p1, p2]

        x5 <-
            fmap entityVal `fmap` selectList [PersonColor <-. [Nothing, Just "blue"]] []
        liftIO $ x5 @?= [p1, p2, p3]
        x6 <- fmap entityVal `fmap` selectList [PersonColor /<-. [Nothing]] []
        liftIO $ x6 @?= [p3]

    describe "toJSON" $ do
        it "serializes" $ runDb $ do
            let
                p = Person "D" 0 Nothing
            k <- insert p
            liftIO $
                toJSON (Entity k p)
                    @?= object
                        [("id", toJSON k), ("color", Null), ("name", String "D"), ("age", Number 0)]

    {- FIXME
        prop "fromJSON . toJSON $ key" $ \(person :: Key Person) ->
          case (fromJSON . toJSON) person of
            Success p -> p == person
            _ -> error "fromJSON"
    -}

    describe "strictness" $ do
        it "bang" $ (return $! Strict (error "foo") 5 5) `shouldThrow` anyErrorCall
        it "tilde" $ void (return $! Strict 5 (error "foo") 5 :: IO Strict)
        it "blank" $ (return $! Strict 5 5 (error "foo")) `shouldThrow` anyErrorCall

    describe "documentation syntax" $ do
        let
            edef = entityDef (Proxy :: Proxy Relationship)
        it "provides comments on entity def" $ do
            getEntityComments edef
                `shouldBe` Just
                    "This is a doc comment for a relationship.\nOnly the first line requires a pipe.\nPipes are optional on subsequent lines.\n"
        it "provides comments on the field" $ do
            let
                [nameField, _] = getEntityFields edef
            fieldComments nameField
                `shouldBe` Just "Fields should be documentable.\n"