content: {-# OPTIONS_GHC -fno-warn-unused-binds  #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE PartialTypeSignatures #-}
  {-# LANGUAGE RankNTypes #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeFamilies #-}
  
  module PostgreSQL.Test where
  
  import Control.Arrow ((&&&))
  import Control.Concurrent (forkIO)
  import Control.Monad (void, when)
  import Control.Monad.IO.Class (MonadIO(liftIO))
  import Control.Monad.Logger (runNoLoggingT, runStderrLoggingT)
  import Control.Monad.Trans.Reader (ReaderT, ask, mapReaderT, runReaderT)
  import qualified Control.Monad.Trans.Resource as R
  import Data.Aeson hiding (Value)
  import qualified Data.Aeson as A (Value)
  import Data.ByteString (ByteString)
  import qualified Data.ByteString.Lazy as BSL
  import qualified Data.Char as Char
  import Data.Coerce
  import Data.Foldable
  import qualified Data.List as L
  import qualified Data.List.NonEmpty as NE
  import Data.Map (Map)
  import qualified Data.Map.Strict as Map
  import Data.Ord (comparing)
  import qualified Data.Text as T
  import qualified Data.Text.Encoding as TE
  import qualified Data.Text.Lazy as TL
  import qualified Data.Text.Lazy.Builder as TLB
  import Data.Time
  import Data.Time.Clock (UTCTime, diffUTCTime, getCurrentTime)
  import Database.Esqueleto hiding (random_)
  import Database.Esqueleto.Experimental hiding (from, on, random_)
  import qualified Database.Esqueleto.Experimental as Experimental
  import qualified Database.Esqueleto.Internal.Internal as ES
  import Database.Esqueleto.PostgreSQL
         (random_, withMaterialized, withNotMaterialized)
  import qualified Database.Esqueleto.PostgreSQL as EP
  import Database.Esqueleto.PostgreSQL.JSON hiding ((-.), (?.), (||.))
  import qualified Database.Esqueleto.PostgreSQL.JSON as JSON
  import qualified Database.Persist.Class as P
  import Database.Persist.Postgresql (createPostgresqlPool, withPostgresqlConn)
  import Database.PostgreSQL.Simple (ExecStatus(..), SqlError(..))
  import System.Environment
  import Test.Hspec
  import Test.Hspec.Core.Spec (sequential)
  import Test.Hspec.QuickCheck
  
  import Common.Test
  import Common.Test.Import hiding (from, on)
  import PostgreSQL.MigrateJSON
  
  spec :: Spec
  spec = beforeAll mkConnectionPool $ do
      tests
  
      describe "PostgreSQL specific tests" $ do
          testAscRandom random_
          testSelectDistinctOn
          testPostgresModule
          testPostgresqlOneAscOneDesc
          testPostgresqlTwoAscFields
          testPostgresqlSum
          testPostgresqlRandom
          testPostgresqlUpdate
          testPostgresqlCoalesce
          testPostgresqlTextFunctions
          testInsertUniqueViolation
          testUpsert
          testInsertSelectWithConflict
          testFilterWhere
          testCommonTableExpressions
          setDatabaseState insertJsonValues cleanJSON
              $ describe "PostgreSQL JSON tests" $ do
                  testJSONInsertions
                  testJSONOperators
          testLateralQuery
          testValuesExpression
          testSubselectAliasingBehavior
          testPostgresqlLocking
          testPostgresqlNullsOrdering
  
  
  returningType :: forall a m . m a -> m a
  returningType a = a
  
  testPostgresqlCoalesce :: SpecDb
  testPostgresqlCoalesce = do
      itDb "works on PostgreSQL and MySQL with <2 arguments" $ do
          void $ returningType @[Value (Maybe Int)] $
              select $
              from $ \p -> do
              return (coalesce [p ^. PersonAge])
          asserting noExceptions
  
  testPostgresqlTextFunctions :: SpecDb
  testPostgresqlTextFunctions = do
      describe "text functions" $ do
          itDb "like, (%) and (++.) work on a simple example" $ do
              let nameContains t =
                      select $
                      from $ \p -> do
                      where_
                          (like
                          (p ^. PersonName)
                          ((%) ++. val t ++. (%)))
                      orderBy [asc (p ^. PersonName)]
                      return p
              [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4]
              h <- nameContains "h"
              i <- nameContains "i"
              iv <- nameContains "iv"
              asserting $ do
                  h `shouldBe` [p1e, p2e]
                  i `shouldBe` [p4e, p3e]
                  iv `shouldBe` [p4e]
  
          itDb "ilike, (%) and (++.) work on a simple example on PostgreSQL" $ do
              [p1e, _, p3e, _, p5e] <- mapM insert' [p1, p2, p3, p4, p5]
              let nameContains t = do
                      select $
                       from $ \p -> do
                       where_ (p ^. PersonName `ilike` (%) ++. val t ++. (%))
                       orderBy [asc (p ^. PersonName)]
                       return p
              mi <- nameContains "mi"
              john <- nameContains "JOHN"
              asserting $ do
                  mi `shouldBe` [p3e, p5e]
                  john `shouldBe` [p1e]
  
  testPostgresqlUpdate :: SpecDb
  testPostgresqlUpdate = do
      itDb "works on a simple example" $ do
          p1k <- insert p1
          p2k <- insert p2
          p3k <- insert p3
          let anon = "Anonymous"
          ()  <- update $ \p -> do
                 set p [ PersonName =. val anon
                       , PersonAge *=. just (val 2) ]
                 where_ (p ^. PersonName !=. val "Mike")
          n   <- updateCount $ \p -> do
                 set p [ PersonAge +=. just (val 1) ]
                 where_ (p ^. PersonName !=. val "Mike")
          ret <- select $
                 from $ \p -> do
                 orderBy [ asc (p ^. PersonName), asc (p ^. PersonAge) ]
                 return p
          -- PostgreSQL: nulls are bigger than data, and update returns
          --             matched rows, not actually changed rows.
          asserting $ do
              n `shouldBe` 2
              ret `shouldBe`
                  [ Entity p1k (Person anon (Just 73) Nothing 1)
                  , Entity p2k (Person anon Nothing (Just 37) 2)
                  , Entity p3k p3
                  ]
  
  testPostgresqlRandom :: SpecDb
  testPostgresqlRandom = do
      itDb "works with random_" $ do
          _ <- select $ return (random_ :: SqlExpr (Value Double))
          asserting noExceptions
  
  testPostgresqlSum :: SpecDb
  testPostgresqlSum = do
      itDb "works with sum_" $ do
          _ <- insert' p1
          _ <- insert' p2
          _ <- insert' p3
          _ <- insert' p4
          ret <- select $
                 from $ \p->
                 return $ joinV $ sum_ (p ^. PersonAge)
          asserting $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Rational ) ]
  
  testPostgresqlTwoAscFields :: SpecDb
  testPostgresqlTwoAscFields = do
      itDb "works with two ASC fields (one call)" $ do
          p1e <- insert' p1
          p2e <- insert' p2
          p3e <- insert' p3
          p4e <- insert' p4
          ret <- select $
                 from $ \p -> do
                 orderBy [asc (p ^. PersonAge), asc (p ^. PersonName)]
                 return p
          -- in PostgreSQL nulls are bigger than everything
          asserting $ ret `shouldBe` [ p4e, p3e, p1e , p2e ]
  
  testPostgresqlOneAscOneDesc :: SpecDb
  testPostgresqlOneAscOneDesc = do
    itDb "works with one ASC and one DESC field (two calls)" $
       do
        p1e <- insert' p1
        p2e <- insert' p2
        p3e <- insert' p3
        p4e <- insert' p4
        ret <- select $
               from $ \p -> do
               orderBy [desc (p ^. PersonAge)]
               orderBy [asc (p ^. PersonName)]
               return p
        asserting $ ret `shouldBe` [ p2e, p1e, p4e, p3e ]
  
  testSelectDistinctOn :: SpecDb
  testSelectDistinctOn = do
    describe "SELECT DISTINCT ON" $ do
      itDb "works on a simple example" $ do
         do
          [p1k, p2k, _] <- mapM insert [p1, p2, p3]
          [_, bpB, bpC] <- mapM insert'
            [ BlogPost "A" p1k
            , BlogPost "B" p1k
            , BlogPost "C" p2k ]
          ret <- select $
                 from $ \bp ->
                 distinctOn [don (bp ^. BlogPostAuthorId)] $ do
                 orderBy [asc (bp ^. BlogPostAuthorId), desc (bp ^. BlogPostTitle)]
                 return bp
          liftIO $ ret `shouldBe` L.sortBy (comparing (blogPostAuthorId . entityVal)) [bpB, bpC]
  
      let slightlyLessSimpleTest q =
             do
              [p1k, p2k, _] <- mapM insert [p1, p2, p3]
              [bpA, bpB, bpC] <- mapM insert'
                [ BlogPost "A" p1k
                , BlogPost "B" p1k
                , BlogPost "C" p2k ]
              ret <- select $
                     from $ \bp ->
                     q bp $ return bp
              let cmp = (blogPostAuthorId &&& blogPostTitle) . entityVal
              liftIO $ ret `shouldBe` L.sortBy (comparing cmp) [bpA, bpB, bpC]
  
      itDb "works on a slightly less simple example (two distinctOn calls, orderBy)" $
        slightlyLessSimpleTest $ \bp act ->
          distinctOn [don (bp ^. BlogPostAuthorId)] $
          distinctOn [don (bp ^. BlogPostTitle)] $ do
            orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
            act
  
      itDb "works on a slightly less simple example (one distinctOn call, orderBy)" $ do
        slightlyLessSimpleTest $ \bp act ->
          distinctOn [don (bp ^. BlogPostAuthorId), don (bp ^. BlogPostTitle)] $ do
            orderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
            act
  
      itDb "works on a slightly less simple example (distinctOnOrderBy)" $ do
        slightlyLessSimpleTest $ \bp ->
          distinctOnOrderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]
  
      itDb "generates correct sql with nested expression (distinctOnOrderBy)" $ do
        let query = do
              let orderVal = coalesce [nothing, just $ val (10 :: Int)]
              distinctOnOrderBy [ asc orderVal, desc orderVal ] $ pure orderVal
        select query
        asserting noExceptions
  
  
  
  
  testArrayAggWith :: SpecDb
  testArrayAggWith = do
    describe "ALL, no ORDER BY" $ do
      itDb "creates sane SQL" $  do
        (query, args) <- showQuery ES.SELECT $ from $ \p ->
              return (EP.arrayAggWith EP.AggModeAll (p ^. PersonAge) [])
        liftIO $ query `shouldBe`
          "SELECT array_agg(\"Person\".\"age\")\n\
          \FROM \"Person\"\n"
        liftIO $ args `shouldBe` []
  
      itDb "works on an example" $  do
        let people = [p1, p2, p3, p4, p5]
        mapM_ insert people
        [Value (Just ret)] <-
          select $ from $ \p ->
            return (EP.arrayAggWith EP.AggModeAll (p ^. PersonName) [])
        liftIO $ L.sort ret `shouldBe` L.sort (map personName people)
  
    describe "DISTINCT, no ORDER BY" $ do
      itDb "creates sane SQL" $  do
        (query, args) <- showQuery ES.SELECT $ from $ \p ->
              return (EP.arrayAggWith EP.AggModeDistinct (p ^. PersonAge) [])
        liftIO $ query `shouldBe`
          "SELECT array_agg(DISTINCT \"Person\".\"age\")\n\
          \FROM \"Person\"\n"
        liftIO $ args `shouldBe` []
  
      itDb "works on an example" $  do
        let people = [p1, p2, p3, p4, p5]
        mapM_ insert people
        [Value (Just ret)] <-
          select $ from $ \p ->
            return (EP.arrayAggWith EP.AggModeDistinct (p ^. PersonAge) [])
        liftIO $ L.sort ret `shouldBe` [Nothing, Just 17, Just 36]
  
    describe "ALL, ORDER BY" $ do
      itDb "creates sane SQL" $  do
        (query, args) <- showQuery ES.SELECT $ from $ \p ->
              return (EP.arrayAggWith EP.AggModeAll (p ^. PersonAge)
                      [ asc $ p ^. PersonName
                      , desc $ p ^. PersonFavNum
                      ])
        liftIO $ query `shouldBe`
          "SELECT array_agg(\"Person\".\"age\" \
            \ORDER BY \"Person\".\"name\" ASC, \"Person\".\"favNum\" DESC)\n\
          \FROM \"Person\"\n"
        liftIO $ args `shouldBe` []
  
      itDb "works on an example" $  do
        let people = [p1, p2, p3, p4, p5]
        mapM_ insert people
        [Value (Just ret)] <-
          select $ from $ \p ->
            return (EP.arrayAggWith EP.AggModeAll (p ^. PersonName) [])
        liftIO $ L.sort ret `shouldBe` L.sort (map personName people)
  
    describe "DISTINCT, ORDER BY" $ do
      itDb "creates sane SQL" $  do
        (query, args) <- showQuery ES.SELECT $ from $ \p ->
            return (EP.arrayAggWith EP.AggModeDistinct (p ^. PersonAge)
                     [asc $ p ^. PersonAge])
        liftIO $ query `shouldBe`
          "SELECT array_agg(DISTINCT \"Person\".\"age\" \
            \ORDER BY \"Person\".\"age\" ASC)\n\
          \FROM \"Person\"\n"
        liftIO $ args `shouldBe` []
  
      itDb "works on an example" $  do
        let people = [p1, p2, p3, p4, p5]
        mapM_ insert people
        [Value (Just ret)] <-
          select $ from $ \p ->
            return (EP.arrayAggWith EP.AggModeDistinct (p ^. PersonAge)
                     [asc $ p ^. PersonAge])
        liftIO $ ret `shouldBe` [Just 17, Just 36, Nothing]
  
  
  
  
  
  testStringAggWith :: SpecDb
  testStringAggWith = do
    describe "ALL, no ORDER BY" $ do
      itDb "creates sane SQL" $  do
        (query, args) <- showQuery ES.SELECT $ from $ \p ->
              return (EP.stringAggWith EP.AggModeAll (p ^. PersonName)
                       (val " ") [])
        liftIO $ query `shouldBe`
          "SELECT string_agg(\"Person\".\"name\", ?)\n\
          \FROM \"Person\"\n"
        liftIO $ args `shouldBe` [PersistText " "]
  
      itDb "works on an example" $  do
        let people = [p1, p2, p3, p4, p5]
        mapM_ insert people
        [Value (Just ret)] <-
          select $ from $ \p ->
            return (EP.stringAggWith EP.AggModeAll (p ^. PersonName) (val " ")[])
        liftIO $ (L.sort $ words ret) `shouldBe` L.sort (map personName people)
  
      itDb "works with zero rows" $  do
        [Value ret] <-
          select $ from $ \p ->
            return (EP.stringAggWith EP.AggModeAll (p ^. PersonName) (val " ")[])
        liftIO $ ret `shouldBe` Nothing
  
    describe "DISTINCT, no ORDER BY" $ do
      itDb "creates sane SQL" $  do
        (query, args) <- showQuery ES.SELECT $ from $ \p ->
              return $ EP.stringAggWith EP.AggModeDistinct (p ^. PersonName)
                       (val " ") []
        liftIO $ query `shouldBe`
          "SELECT string_agg(DISTINCT \"Person\".\"name\", ?)\n\
          \FROM \"Person\"\n"
        liftIO $ args `shouldBe` [PersistText " "]
  
      itDb "works on an example" $  do
        let people = [p1, p2, p3 {personName = "John"}, p4, p5]
        mapM_ insert people
        [Value (Just ret)] <-
          select $ from $ \p ->
            return $ EP.stringAggWith EP.AggModeDistinct (p ^. PersonName) (val " ")
                     []
        liftIO $ (L.sort $ words ret) `shouldBe`
          (L.sort . L.nub $ map personName people)
  
    describe "ALL, ORDER BY" $ do
      itDb "creates sane SQL" $  do
        (query, args) <- showQuery ES.SELECT $ from $ \p ->
              return (EP.stringAggWith EP.AggModeAll (p ^. PersonName) (val " ")
                      [ asc $ p ^. PersonName
                      , desc $ p ^. PersonFavNum
                      ])
        liftIO $ query `shouldBe`
          "SELECT string_agg(\"Person\".\"name\", ? \
            \ORDER BY \"Person\".\"name\" ASC, \"Person\".\"favNum\" DESC)\n\
          \FROM \"Person\"\n"
        liftIO $ args `shouldBe` [PersistText " "]
  
      itDb "works on an example" $  do
        let people = [p1, p2, p3, p4, p5]
        mapM_ insert people
        [Value (Just ret)] <-
          select $ from $ \p ->
            return $ EP.stringAggWith EP.AggModeAll (p ^. PersonName) (val " ")
                      [desc $ p ^. PersonName]
        liftIO $ (words ret)
          `shouldBe` (L.reverse . L.sort $ map personName people)
  
    describe "DISTINCT, ORDER BY" $ do
      itDb "creates sane SQL" $  do
        (query, args) <- showQuery ES.SELECT $ from $ \p ->
              return $ EP.stringAggWith EP.AggModeDistinct (p ^. PersonName)
                       (val " ") [desc $ p ^. PersonName]
        liftIO $ query `shouldBe`
          "SELECT string_agg(DISTINCT \"Person\".\"name\", ? \
          \ORDER BY \"Person\".\"name\" DESC)\n\
          \FROM \"Person\"\n"
        liftIO $ args `shouldBe` [PersistText " "]
  
      itDb "works on an example" $  do
        let people = [p1, p2, p3 {personName = "John"}, p4, p5]
        mapM_ insert people
        [Value (Just ret)] <-
          select $ from $ \p ->
            return $ EP.stringAggWith EP.AggModeDistinct (p ^. PersonName) (val " ")
                     [desc $ p ^. PersonName]
        liftIO $ (words ret) `shouldBe`
          (L.reverse . L.sort . L.nub $ map personName people)
  
  
  
  
  
  testAggregateFunctions :: SpecDb
  testAggregateFunctions = do
    describe "arrayAgg" $ do
      itDb "looks sane" $  do
        let people = [p1, p2, p3, p4, p5]
        mapM_ insert people
        [Value (Just ret)] <-
          select $ from $ \p -> return (EP.arrayAgg (p ^. PersonName))
        liftIO $ L.sort ret `shouldBe` L.sort (map personName people)
  
      itDb "works on zero rows" $  do
        [Value ret] <-
          select $ from $ \p -> return (EP.arrayAgg (p ^. PersonName))
        liftIO $ ret `shouldBe` Nothing
    describe "arrayAggWith" testArrayAggWith
    describe "stringAgg" $ do
      itDb "looks sane" $
         do
          let people = [p1, p2, p3, p4, p5]
          mapM_ insert people
          [Value (Just ret)] <-
            select $
            from $ \p -> do
            return (EP.stringAgg (p ^. PersonName) (val " "))
          liftIO $ L.sort (words ret) `shouldBe` L.sort (map personName people)
      itDb "works on zero rows" $  do
        [Value ret] <-
          select $ from $ \p -> return (EP.stringAgg (p ^. PersonName) (val " "))
        liftIO $ ret `shouldBe` Nothing
    describe "stringAggWith" testStringAggWith
  
    describe "array_remove (NULL)" $ do
      itDb "removes NULL from arrays from nullable fields" $  do
        mapM_ insert [ Person "1" Nothing   Nothing 1
                     , Person "2" (Just 7)  Nothing 1
                     , Person "3" (Nothing) Nothing 1
                     , Person "4" (Just 8)  Nothing 2
                     , Person "5" (Just 9)  Nothing 2
                     ]
        ret <- select $ from $ \(person :: SqlExpr (Entity Person)) -> do
          groupBy (person ^. PersonFavNum)
          return . EP.arrayRemoveNull . EP.maybeArray . EP.arrayAgg
            $ person ^. PersonAge
        liftIO $ (L.sort $ map (L.sort . unValue) ret)
          `shouldBe` [[7], [8,9]]
  
    describe "maybeArray" $ do
      itDb "Coalesces NULL into an empty array" $  do
        [Value ret] <-
          select $ from $ \p ->
            return (EP.maybeArray $ EP.arrayAgg (p ^. PersonName))
        liftIO $ ret `shouldBe` []
  
  testPostgresModule :: SpecDb
  testPostgresModule = do
      describe "date_trunc" $ modifyMaxSuccess (`div` 10) $ do
          propDb "works" $ \run listOfDateParts -> run $ do
              let
                  utcTimes =
                      map
                        (\(y, m, d, s) ->
                          fromInteger s
                            `addUTCTime`
                              UTCTime (fromGregorian (2000 + y) m d) 0
                        )
                      listOfDateParts
                  truncateDate
                      :: SqlExpr (Value String)  -- ^ .e.g (val "day")
                      -> SqlExpr (Value UTCTime) -- ^ input field
                      -> SqlExpr (Value UTCTime) -- ^ truncated date
                  truncateDate datePart expr =
                      ES.unsafeSqlFunction "date_trunc" (datePart, expr)
                  vals =
                      zip (map (DateTruncTestKey . fromInteger) [1..]) utcTimes
              for_ vals $ \(idx, utcTime) -> do
                  insertKey idx (DateTruncTest utcTime)
  
              -- Necessary to get the test to pass; see the discussion in
              -- https://github.com/bitemyapp/esqueleto/pull/180
              rawExecute "SET TIME ZONE 'UTC'" []
              ret <-
                  fmap (Map.fromList . coerce :: _ -> Map DateTruncTestId (UTCTime, UTCTime)) $
                  select $
                  from $ \dt -> do
                  pure
                    ( dt ^. DateTruncTestId
                    , ( dt ^. DateTruncTestCreated
                      , truncateDate (val "day") (dt ^. DateTruncTestCreated)
                      )
                    )
  
              asserting $ for_ vals $ \(idx, utcTime) -> do
                case Map.lookup idx ret of
                  Nothing ->
                    expectationFailure "index not found"
                  Just (original, truncated) -> do
                    utcTime `shouldBe` original
                    if utctDay utcTime == utctDay truncated
                      then
                        utctDay utcTime `shouldBe` utctDay truncated
                      else
                        -- use this if/else to get a better error message
                        utcTime `shouldBe` truncated
  
      describe "PostgreSQL module" $ do
          describe "Aggregate functions" testAggregateFunctions
          itDb "chr looks sane" $ do
              [Value (ret :: String)] <- select $ return (EP.chr (val 65))
              liftIO $ ret `shouldBe` "A"
  
          itDb "allows unit for functions" $ do
              let
                  fn :: SqlExpr (Value UTCTime)
                  fn = ES.unsafeSqlFunction "now" ()
              vals <- select $ pure fn
              liftIO $ vals `shouldSatisfy` ((1 ==) . length)
  
          itDb "works with now" $
             do
              nowDb <- select $ return EP.now_
              nowUtc <- liftIO getCurrentTime
              let oneSecond = realToFrac (1 :: Double)
  
              -- | Check the result is not null
              liftIO $ nowDb `shouldSatisfy` (not . null)
  
              -- | Unpack the now value
              let (Value now: _) = nowDb
  
              -- | Get the time diff and check it's less than a second
              liftIO $ diffUTCTime nowUtc now `shouldSatisfy` (< oneSecond)
  
  testJSONInsertions :: SpecDb
  testJSONInsertions =
      describe "JSON Insertions" $ do
          itDb "adds scalar values" $ do
              insertIt Null
              insertIt $ Bool True
              insertIt $ Number 1
              insertIt $ String "test"
          itDb "adds arrays" $ do
              insertIt $ toJSON ([] :: [A.Value])
              insertIt $ toJSON [Number 1, Bool True, Null]
              insertIt $ toJSON [String "test",object ["a" .= Number 3.14], Null, Bool True]
          itDb "adds objects" $ do
              insertIt $ object ["a" .= (1 :: Int), "b" .= False]
              insertIt $ object ["a" .= object ["b" .= object ["c" .= String "message"]]]
    where
      insertIt :: MonadIO m => A.Value -> SqlPersistT m ()
      insertIt = insert_ . Json . JSONB
  
  testJSONOperators :: SpecDb
  testJSONOperators =
    describe "JSON Operators" $ do
      testArrowOperators
      testFilterOperators
      testConcatDeleteOperators
  
  testArrowOperators :: SpecDb
  testArrowOperators =
    describe "Arrow Operators" $ do
      testArrowJSONB
      testArrowText
      testHashArrowJSONB
      testHashArrowText
  
  testArrowJSONB :: SpecDb
  testArrowJSONB =
      describe "Single Arrow (JSONB)" $ do
          itDb "creates sane SQL" $
              createSaneSQL @JSONValue
                  (jsonbVal (object ["a" .= True]) ->. "a")
                  "SELECT (? -> ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped "{\"a\":true}"
                  , PersistText "a"
                  ]
          itDb "creates sane SQL (chained)" $ do
              let obj = object ["a" .= [1 :: Int,2,3]]
              createSaneSQL @JSONValue
                (jsonbVal obj ->. "a" ->. 1)
                "SELECT ((? -> ?) -> ?)\nFROM \"Json\"\n"
                [ PersistLiteralEscaped "{\"a\":[1,2,3]}"
                , PersistText "a"
                , PersistInt64 1 ]
          itDb "works as expected" $  do
            x <- selectJSONwhere $ \v -> v ->. "b" ==. jsonbVal (Bool False)
            y <- selectJSONwhere $ \v -> v ->. 1 ==. jsonbVal (Bool True)
            z <- selectJSONwhere $ \v -> v ->. "a" ->. "b" ->. "c" ==. jsonbVal (String "message")
            asserting $ do
                length x `shouldBe` 1
                length y `shouldBe` 1
                length z `shouldBe` 1
  
  testArrowText :: SpecDb
  testArrowText =
      describe "Single Arrow (Text)" $ do
          itDb "creates sane SQL" $
            createSaneSQL
              (jsonbVal (object ["a" .= True]) ->>. "a")
              "SELECT (? ->> ?)\nFROM \"Json\"\n"
              [ PersistLiteralEscaped "{\"a\":true}"
              , PersistText "a" ]
          itDb "creates sane SQL (chained)" $ do
            let obj = object ["a" .= [1 :: Int,2,3]]
            createSaneSQL
              (jsonbVal obj ->. "a" ->>. 1)
              "SELECT ((? -> ?) ->> ?)\nFROM \"Json\"\n"
              [ PersistLiteralEscaped "{\"a\":[1,2,3]}"
              , PersistText "a"
              , PersistInt64 1 ]
          itDb "works as expected" $  do
            x <- selectJSONwhere $ \v -> v ->>. "b" ==. just (val "false")
            y <- selectJSONwhere $ \v -> v ->>. 1 ==. just (val "true")
            z <- selectJSONwhere $ \v -> v ->. "a" ->. "b" ->>. "c" ==. just (val "message")
            liftIO $ length x `shouldBe` 1
            liftIO $ length y `shouldBe` 1
            liftIO $ length z `shouldBe` 1
  
  testHashArrowJSONB :: SpecDb
  testHashArrowJSONB =
    describe "Double Arrow (JSONB)" $ do
      itDb "creates sane SQL" $ do
        let list = ["a","b","c"]
        createSaneSQL @JSONValue
          (jsonbVal (object ["a" .= True]) #>. list)
          "SELECT (? #> ?)\nFROM \"Json\"\n"
          [ PersistLiteralEscaped "{\"a\":true}"
          , persistTextArray list ]
      itDb "creates sane SQL (chained)" $ do
        let obj = object ["a" .= [object ["b" .= True]]]
        createSaneSQL @JSONValue
          (jsonbVal obj #>. ["a","1"] #>. ["b"])
          "SELECT ((? #> ?) #> ?)\nFROM \"Json\"\n"
          [ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
          , persistTextArray ["a","1"]
          , persistTextArray ["b"] ]
      itDb "works as expected" $  do
        x <- selectJSONwhere $ \v -> v #>. ["a","b","c"] ==. jsonbVal (String "message")
        y <- selectJSONwhere $ \v -> v #>. ["1","a"] ==. jsonbVal (Number 3.14)
        z <- selectJSONwhere $ \v -> v #>. ["1"] #>. ["a"] ==. jsonbVal (Number 3.14)
        liftIO $ length x `shouldBe` 1
        liftIO $ length y `shouldBe` 1
        liftIO $ length z `shouldBe` 1
  
  testHashArrowText :: SpecDb
  testHashArrowText =
    describe "Double Arrow (Text)" $ do
      itDb "creates sane SQL" $ do
        let list = ["a","b","c"]
        createSaneSQL
          (jsonbVal (object ["a" .= True]) #>>. list)
          "SELECT (? #>> ?)\nFROM \"Json\"\n"
          [ PersistLiteralEscaped "{\"a\":true}"
          , persistTextArray list ]
      itDb "creates sane SQL (chained)" $ do
        let obj = object ["a" .= [object ["b" .= True]]]
        createSaneSQL
          (jsonbVal obj #>. ["a","1"] #>>. ["b"])
          "SELECT ((? #> ?) #>> ?)\nFROM \"Json\"\n"
          [ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
          , persistTextArray ["a","1"]
          , persistTextArray ["b"] ]
      itDb "works as expected" $  do
        x <- selectJSONwhere $ \v -> v #>>. ["a","b","c"] ==. just (val "message")
        y <- selectJSONwhere $ \v -> v #>>. ["1","a"] ==. just (val "3.14")
        z <- selectJSONwhere $ \v -> v #>. ["1"] #>>. ["a"] ==. just (val "3.14")
        liftIO $ length x `shouldBe` 1
        liftIO $ length y `shouldBe` 1
        liftIO $ length z `shouldBe` 1
  
  
  testFilterOperators :: SpecDb
  testFilterOperators =
      describe "Filter Operators" $ do
          testInclusion
          testQMark
          testQMarkAny
          testQMarkAll
  
  testInclusion :: SpecDb
  testInclusion = do
      describe "@>" $ do
          itDb "creates sane SQL" $ do
              let obj = object ["a" .= False, "b" .= True]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL
                  (jsonbVal obj  @>. jsonbVal (object ["a" .= False]))
                  "SELECT (? @> ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped encoded
                  , PersistLiteralEscaped "{\"a\":false}"
                  ]
          itDb "creates sane SQL (chained)" $ do
              let obj = object ["a" .= [object ["b" .= True]]]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL
                  (jsonbVal obj ->. "a" @>. jsonbVal (object ["b" .= True]))
                  "SELECT ((? -> ?) @> ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped encoded
                  , PersistText "a"
                  , PersistLiteralEscaped "{\"b\":true}"
                  ]
          itDb "works as expected" $  do
            x <- selectJSONwhere $ \v -> v @>. jsonbVal (Number 1)
            y <- selectJSONwhere $ \v -> v @>. jsonbVal (toJSON [object ["a" .= Number 3.14]])
            z <- selectJSONwhere $ \v -> v ->. 1 @>. jsonbVal (object ["a" .= Number 3.14])
            liftIO $ length x `shouldBe` 2
            liftIO $ length y `shouldBe` 1
            liftIO $ length z `shouldBe` 1
      describe "<@" $ do
          itDb "creates sane SQL" $ do
              let obj = object ["a" .= False, "b" .= True]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL
                  (jsonbVal (object ["a" .= False]) <@. jsonbVal obj )
                  "SELECT (? <@ ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped "{\"a\":false}"
                  , PersistLiteralEscaped encoded
                  ]
          itDb "creates sane SQL (chained)" $ do
              let obj = object ["a" .= [object ["b" .= True]]]
                  obj' = object ["b" .= True, "c" .= Null]
                  encoded = BSL.toStrict $ encode obj'
              createSaneSQL
                  (jsonbVal obj ->. "a" <@. jsonbVal obj')
                  "SELECT ((? -> ?) <@ ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped "{\"a\":[{\"b\":true}]}"
                  , PersistText "a"
                  , PersistLiteralEscaped encoded
                  ]
          itDb "works as expected" $  do
              x <- selectJSONwhere $ \v -> v <@. jsonbVal (toJSON [Number 1])
              y <- selectJSONwhere $ \v -> v <@. jsonbVal (object ["a" .= (1 :: Int), "b" .= False, "c" .= Null])
              z <- selectJSONwhere $ \v -> v #>. ["a","b"] <@. jsonbVal (object ["b" .= False, "c" .= String "message"])
              liftIO $ length x `shouldBe` 2
              liftIO $ length y `shouldBe` 1
              liftIO $ length z `shouldBe` 1
  
  testQMark :: SpecDb
  testQMark = do
      describe "Question Mark" $ do
          itDb "creates sane SQL" $ do
              let obj = object ["a" .= False, "b" .= True]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL
                (jsonbVal obj JSON.?. "a")
                "SELECT (? ?? ?)\nFROM \"Json\"\n"
                [ PersistLiteralEscaped encoded
                , PersistText "a"
                ]
          itDb "creates sane SQL (chained)" $ do
              let obj = object ["a" .= [object ["b" .= True]]]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL
                  (jsonbVal obj #>. ["a","0"] JSON.?. "b")
                  "SELECT ((? #> ?) ?? ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped encoded
                  , persistTextArray ["a","0"]
                  , PersistText "b"
                  ]
          itDb "works as expected" $  do
              x <- selectJSONwhere (JSON.?. "a")
              y <- selectJSONwhere (JSON.?. "test")
              z <- selectJSONwhere $ \v -> v ->. "a" JSON.?. "b"
              liftIO $ length x `shouldBe` 2
              liftIO $ length y `shouldBe` 2
              liftIO $ length z `shouldBe` 1
  
  testQMarkAny :: SpecDb
  testQMarkAny = do
      describe "Question Mark (Any)" $ do
          itDb "creates sane SQL" $ do
              let obj = (object ["a" .= False, "b" .= True])
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL
                  (jsonbVal obj  ?|. ["a","c"])
                  "SELECT (? ??| ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped encoded
                  , persistTextArray ["a","c"]
                  ]
          itDb "creates sane SQL (chained)" $ do
              let obj = object ["a" .= [object ["b" .= True]]]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL
                  (jsonbVal obj #>. ["a","0"] ?|. ["b","c"])
                  "SELECT ((? #> ?) ??| ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped encoded
                  , persistTextArray ["a","0"]
                  , persistTextArray ["b","c"]
                  ]
          itDb "works as expected" $  do
            x <- selectJSONwhere (?|. ["b","test"])
            y <- selectJSONwhere (?|. ["a"])
            z <- selectJSONwhere $ \v -> v ->. (-3) ?|. ["a"]
            w <- selectJSONwhere (?|. [])
            liftIO $ length x `shouldBe` 3
            liftIO $ length y `shouldBe` 2
            liftIO $ length z `shouldBe` 1
            liftIO $ length w `shouldBe` 0
  
  testQMarkAll :: SpecDb
  testQMarkAll = do
      describe "Question Mark (All)" $ do
          itDb "creates sane SQL" $ do
              let obj = object ["a" .= False, "b" .= True]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL
                  (jsonbVal obj  ?&. ["a","c"])
                  "SELECT (? ??& ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped encoded
                  , persistTextArray ["a","c"]
                  ]
          itDb "creates sane SQL (chained)" $ do
              let obj = object ["a" .= [object ["b" .= True]]]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL
                  (jsonbVal obj #>. ["a","0"] ?&. ["b","c"])
                  "SELECT ((? #> ?) ??& ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped encoded
                  , persistTextArray ["a","0"]
                  , persistTextArray ["b","c"]
                  ]
          itDb "works as expected" $  do
              x <- selectJSONwhere (?&. ["test"])
              y <- selectJSONwhere (?&. ["a","b"])
              z <- selectJSONwhere $ \v -> v ->. "a" ?&. ["b"]
              w <- selectJSONwhere (?&. [])
              liftIO $ length x `shouldBe` 2
              liftIO $ length y `shouldBe` 1
              liftIO $ length z `shouldBe` 1
              liftIO $ length w `shouldBe` 9
  
  testConcatDeleteOperators :: SpecDb
  testConcatDeleteOperators = do
    describe "Concatenation Operator" testConcatenationOperator
    describe "Deletion Operators" $ do
      testMinusOperator
      testMinusOperatorV10
      testHashMinusOperator
  
  testConcatenationOperator :: SpecDb
  testConcatenationOperator = do
      describe "Concatenation" $ do
          itDb "creates sane SQL" $ do
              let objAB = object ["a" .= False, "b" .= True]
                  objC = object ["c" .= Null]
              createSaneSQL @JSONValue
                  (jsonbVal objAB
                      JSON.||. jsonbVal objC)
                  "SELECT (? || ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped $ BSL.toStrict $ encode objAB
                  , PersistLiteralEscaped $ BSL.toStrict $ encode objC
                  ]
          itDb "creates sane SQL (chained)" $ do
              let obj = object ["a" .= [object ["b" .= True]]]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL @JSONValue
                  (jsonbVal obj ->. "a" JSON.||. jsonbVal (toJSON [Null]))
                  "SELECT ((? -> ?) || ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped encoded
                  , PersistText "a"
                  , PersistLiteralEscaped "[null]"
                  ]
          itDb "works as expected" $  do
            x <- selectJSON $ \v -> do
                where_ $ v @>. jsonbVal (object [])
                where_ $ v JSON.||. jsonbVal (object ["x" .= True])
                                @>. jsonbVal (object ["x" .= True])
            y <- selectJSONwhere $ \v ->
                v JSON.||. jsonbVal (toJSON [String "a", String "b"])
                      ->>. 4 ==. just (val "b")
            z <- selectJSONwhere $ \v ->
                v JSON.||. jsonbVal (toJSON [Bool False])
                       ->. 0 JSON.@>. jsonbVal (Number 1)
            w <- selectJSON $ \v -> do
                where_ . not_ $ v @>. jsonbVal (object [])
                where_ $ jsonbVal (String "test1") JSON.||. v ->>. 0 ==. just (val "test1")
            liftIO $ length x `shouldBe` 2
            liftIO $ length y `shouldBe` 1
            liftIO $ length z `shouldBe` 2
            liftIO $ length w `shouldBe` 7
  
  testMinusOperator :: SpecDb
  testMinusOperator =
      describe "Minus Operator" $ do
          itDb "creates sane SQL" $ do
              let obj = object ["a" .= False, "b" .= True]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL @JSONValue
                  (jsonbVal obj JSON.-. "a")
                  "SELECT (? - ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped encoded
                  , PersistText "a"
                  ]
          itDb "creates sane SQL (chained)" $ do
              let obj = object ["a" .= [object ["b" .= True]]]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL @JSONValue
                  (jsonbVal obj ->. "a" JSON.-. 0)
                  "SELECT ((? -> ?) - ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped encoded
                  , PersistText "a"
                  , PersistInt64 0
                  ]
          itDb "works as expected" $  do
              x <- selectJSON $ \v -> do
                  where_ $ v @>. jsonbVal (toJSON ([] :: [Int]))
                  where_ $ v JSON.-. 0 @>. jsonbVal (toJSON [Bool True])
              y <- selectJSON $ \v -> do
                  where_ $ v @>. jsonbVal (toJSON ([] :: [Int]))
                  where_ $ v JSON.-. (-1) @>. jsonbVal (toJSON [Null])
              z <- selectJSON_ $ \v -> v JSON.-. "b" ?&. ["a", "b"]
              w <- selectJSON_ $ \v -> do
                  v JSON.-. "test" @>. jsonbVal (toJSON [String "test"])
              liftIO $ length x `shouldBe` 2
              liftIO $ length y `shouldBe` 1
              liftIO $ length z `shouldBe` 0
              liftIO $ length w `shouldBe` 0
              sqlFailWith "22023" $ selectJSONwhere $ \v ->
                  v JSON.-. 0 @>. jsonbVal (toJSON ([] :: [Int]))
    where
      selectJSON_ f = selectJSON $ \v -> do
          where_
              $ v @>. jsonbVal (object [])
              ||. v @>. jsonbVal (toJSON ([] :: [Int]))
          where_ $ f v
  
  testMinusOperatorV10 :: SpecDb
  testMinusOperatorV10 = do
      describe "Minus Operator (PSQL >= v10)" $ do
          itDb "creates sane SQL" $ do
              let obj = object ["a" .= False, "b" .= True]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL @JSONValue
                  (jsonbVal obj  --. ["a","b"])
                  "SELECT (? - ?)\nFROM \"Json\"\n"
                  [ PersistLiteralEscaped encoded
                  , persistTextArray ["a","b"]
                  ]
          itDb "creates sane SQL (chained)" $ do
              let obj = object ["a" .= [object ["b" .= True]]]
                  encoded = BSL.toStrict $ encode obj
              createSaneSQL @JSONValue
                (jsonbVal obj #>. ["a","0"] --. ["b"])
                "SELECT ((? #> ?) - ?)\nFROM \"Json\"\n"
                [ PersistLiteralEscaped encoded
                , persistTextArray ["a","0"]
                , persistTextArray ["b"]
                ]
          itDb "works as expected" $  do
              x <- selectJSON $ \v -> do
                  where_ $ v @>. jsonbVal (toJSON ([] :: [Int]))
                  where_ $ v --. ["test","a"] @>. jsonbVal (toJSON [String "test"])
              y <- selectJSON $ \v -> do
                  where_ $ v @>. jsonbVal (object [])
                  where_ $ v --. ["a","b"] <@. jsonbVal (object [])
              z <- selectJSON_ $ \v -> v --. ["b"] <@. jsonbVal (object ["a" .= (1 :: Int)])
              w <- selectJSON_ $ \v -> do
                  v --. ["test"] @>. jsonbVal (toJSON [String "test"])
              liftIO $ length x `shouldBe` 0
              liftIO $ length y `shouldBe` 2
              liftIO $ length z `shouldBe` 1
              liftIO $ length w `shouldBe` 0
              sqlFailWith "22023" $ selectJSONwhere $ \v ->
                  v --. ["a"] @>. jsonbVal (toJSON ([] :: [Int]))
    where
      selectJSON_ f = selectJSON $ \v -> do
          where_ $ v @>. jsonbVal (object [])
                 ||. v @>. jsonbVal (toJSON ([] :: [Int]))
          where_ $ f v
  
  testHashMinusOperator :: SpecDb
  testHashMinusOperator =
    describe "Hash-Minus Operator" $ do
      itDb "creates sane SQL" $
        createSaneSQL @JSONValue
          (jsonbVal (object ["a" .= False, "b" .= True]) #-. ["a"])
          "SELECT (? #- ?)\nFROM \"Json\"\n"
          [ PersistLiteralEscaped (BSL.toStrict $ encode $ object ["a" .= False, "b" .= True])
          , persistTextArray ["a"] ]
      itDb "creates sane SQL (chained)" $ do
        let obj = object ["a" .= [object ["b" .= True]]]
        createSaneSQL @JSONValue
          (jsonbVal obj ->. "a" #-. ["0","b"])
          "SELECT ((? -> ?) #- ?)\nFROM \"Json\"\n"
          [ PersistLiteralEscaped (BSL.toStrict $ encode obj)
          , PersistText "a"
          , persistTextArray ["0","b"] ]
      itDb "works as expected" $  do
        x <- selectJSON $ \v -> do
            where_ $ v @>. jsonbVal (toJSON ([] :: [Int]))
            where_ $ v #-. ["1","a"] @>. jsonbVal (toJSON [object []])
        y <- selectJSON $ \v -> do
            where_ $ v @>. jsonbVal (toJSON ([] :: [Int]))
            where_ $ v #-. ["-3","a"] @>. jsonbVal (toJSON [object []])
        z <- selectJSON_ $ \v -> v #-. ["a","b","c"]
                @>. jsonbVal (object ["a" .= object ["b" .= object ["c" .= String "message"]]])
        w <- selectJSON_ $ \v -> v #-. ["a","b"] JSON.?. "b"
        liftIO $ length x `shouldBe` 1
        liftIO $ length y `shouldBe` 1
        liftIO $ length z `shouldBe` 0
        liftIO $ length w `shouldBe` 1
        sqlFailWith "22023" $ selectJSONwhere $ \v ->
            v #-. ["0"] @>. jsonbVal (toJSON ([] :: [Int]))
    where selectJSON_ f = selectJSON $ \v -> do
            where_ $ v @>. jsonbVal (object [])
            where_ $ f v
  
  testInsertUniqueViolation :: SpecDb
  testInsertUniqueViolation =
      describe "Unique Violation on Insert" $
          itDb "Unique throws exception" $ do
              eres <-
                  try $ do
                      _ <- insert u1
                      _ <- insert u2
                      insert u3
              liftIO $ case eres of
                  Left err | err == exception ->
                      pure ()
                  _ ->
                      expectationFailure $ "Expected a SQL exception, got: " <>
                          show eres
  
    where
      exception = SqlError {
        sqlState = "23505",
        sqlExecStatus = FatalError,
        sqlErrorMsg = "duplicate key value violates unique constraint \"UniqueValue\"",
        sqlErrorDetail = "Key (value)=(0) already exists.",
        sqlErrorHint = ""}
  
  testUpsert :: SpecDb
  testUpsert = describe "Upsert test" $ do
      itDb "Upsert can insert like normal" $  do
          u1e <- EP.upsert u1 (pure (OneUniqueName =. val "fifth"))
          liftIO $ entityVal u1e `shouldBe` u1
      itDb "Upsert performs update on collision" $  do
          u1e <- EP.upsert u1 (pure (OneUniqueName =. val "fifth"))
          liftIO $ entityVal u1e `shouldBe` u1
          u2e <- EP.upsert u2 (pure (OneUniqueName =. val "fifth"))
          liftIO $ entityVal u2e `shouldBe` u2
          u3e <- EP.upsert u3 (pure (OneUniqueName =. val "fifth"))
          liftIO $ entityVal u3e `shouldBe` u1{oneUniqueName="fifth"}
      describe "With no updates" $ do
          itDb "Works with no updates" $ do
              _ <- EP.upsertMaybe u1 []
              pure ()
          itDb "Works with no updates, twice" $ do
              mu1  <- EP.upsertMaybe u1 []
              Entity u1Key u1' <- liftIO $ assertJust mu1
              mu2 <- EP.upsertMaybe u1 { oneUniqueName = "Something Else" } []
              asserting $ do
                  mu2 `shouldBe` Nothing
              -- liftIO $ do
              --     u1 `shouldBe` u1'
  
  testInsertSelectWithConflict :: SpecDb
  testInsertSelectWithConflict =
    describe "insertSelectWithConflict test" $ do
      itDb "Should do Nothing when no updates set" $  do
        _ <- insert p1
        _ <- insert p2
        _ <- insert p3
        n1 <- EP.insertSelectWithConflictCount UniqueValue (
            from $ \p -> return $ OneUnique <# val "test" <&> (p ^. PersonFavNum)
          )
          (\current excluded -> [])
        uniques1 <- select $ from $ \u -> return u
        n2 <- EP.insertSelectWithConflictCount UniqueValue (
            from $ \p -> return $ OneUnique <# val "test" <&> (p ^. PersonFavNum)
          )
          (\current excluded -> [])
        uniques2 <- select $ from $ \u -> return u
        liftIO $ n1 `shouldBe` 3
        liftIO $ n2 `shouldBe` 0
        let test = map (OneUnique "test" . personFavNum) [p1,p2,p3]
        liftIO $ map entityVal uniques1 `shouldBe` test
        liftIO $ map entityVal uniques2 `shouldBe` test
      itDb "Should update a value if given an update on conflict" $  do
          _ <- insert p1
          _ <- insert p2
          _ <- insert p3
          -- Note, have to sum 4 so that the update does not conflicts again with another row.
          n1 <- EP.insertSelectWithConflictCount UniqueValue (
              from $ \p -> return $ OneUnique <# val "test" <&> (p ^. PersonFavNum)
            )
            (\current excluded -> [OneUniqueValue =. val 4 +. (current ^. OneUniqueValue) +. (excluded ^. OneUniqueValue)])
          uniques1 <- select $ from $ \u -> return u
          n2 <- EP.insertSelectWithConflictCount UniqueValue (
              from $ \p -> return $ OneUnique <# val "test" <&> (p ^. PersonFavNum)
            )
            (\current excluded -> [OneUniqueValue =. val 4 +. (current ^. OneUniqueValue) +. (excluded ^. OneUniqueValue)])
          uniques2 <- select $ from $ \u -> return u
          liftIO $ n1 `shouldBe` 3
          liftIO $ n2 `shouldBe` 3
          let test = map (OneUnique "test" . personFavNum) [p1,p2,p3]
              test2 = map (OneUnique "test" . (+4) . (*2) . personFavNum) [p1,p2,p3]
          liftIO $ map entityVal uniques1 `shouldBe` test
          liftIO $ map entityVal uniques2 `shouldBe` test2
  
  testFilterWhere :: SpecDb
  testFilterWhere =
    describe "filterWhere" $ do
      itDb "adds a filter clause to count aggregation" $  do
        -- Person "John"   (Just 36) Nothing   1
        _ <- insert p1
        -- Person "Rachel" Nothing   (Just 37) 2
        _ <- insert p2
        --  Person "Mike"   (Just 17) Nothing   3
        _ <- insert p3
        -- Person "Livia"  (Just 17) (Just 18) 4
        _ <- insert p4
        -- Person "Mitch"  Nothing   Nothing   5
        _ <- insert p5
  
        usersByAge <- fmap coerce <$> do
            select $ from $ \users -> do
              groupBy $ users ^. PersonAge
              return
                ( users ^. PersonAge :: SqlExpr (Value (Maybe Int))
                -- Nothing: [Rachel { favNum = 2 }, Mitch { favNum = 5 }] = 2
                -- Just 36: [John { favNum = 1 } (excluded)] = 0
                -- Just 17: [Mike { favNum = 3 }, Livia { favNum = 4 }] = 2
                , count (users ^. PersonId) `EP.filterWhere` (users ^. PersonFavNum >=. val 2)
                  :: SqlExpr (Value Int)
                -- Nothing: [Rachel { favNum = 2 } (excluded), Mitch { favNum = 5 } (excluded)] = 0
                -- Just 36: [John { favNum = 1 }] = 1
                -- Just 17: [Mike { favNum = 3 } (excluded), Livia { favNum = 4 } (excluded)] = 0
                , count (users ^. PersonFavNum) `EP.filterWhere` (users ^. PersonFavNum <. val 2)
                  :: SqlExpr (Value Int)
                )
  
        liftIO $ usersByAge `shouldMatchList`
          ( [ (Nothing, 2, 0)
            , (Just 36, 0, 1)
            , (Just 17, 2, 0)
            ] :: [(Maybe Int, Int, Int)]
          )
  
      itDb "adds a filter clause to sum aggregation" $  do
        -- Person "John"   (Just 36) Nothing   1
        _ <- insert p1
        -- Person "Rachel" Nothing   (Just 37) 2
        _ <- insert p2
        --  Person "Mike"   (Just 17) Nothing   3
        _ <- insert p3
        -- Person "Livia"  (Just 17) (Just 18) 4
        _ <- insert p4
        -- Person "Mitch"  Nothing   Nothing   5
        _ <- insert p5
  
        usersByAge <- fmap (\(Value a, Value b, Value c) -> (a, b, c)) <$> do
            select $ from $ \users -> do
              groupBy $ users ^. PersonAge
              return
                ( users ^. PersonAge
                -- Nothing: [Rachel { favNum = 2 }, Mitch { favNum = 5 }] = Just 7
                -- Just 36: [John { favNum = 1 } (excluded)] = Nothing
                -- Just 17: [Mike { favNum = 3 }, Livia { favNum = 4 }] = Just 7
                , sum_ (users ^. PersonFavNum) `EP.filterWhere` (users ^. PersonFavNum >=. val 2)
                -- Nothing: [Rachel { favNum = 2 } (excluded), Mitch { favNum = 5 } (excluded)] = Nothing
                -- Just 36: [John { favNum = 1 }] = Just 1
                -- Just 17: [Mike { favNum = 3 } (excluded), Livia { favNum = 4 } (excluded)] = Nothing
                , sum_ (users ^. PersonFavNum) `EP.filterWhere` (users ^. PersonFavNum <. val 2)
                )
  
        liftIO $ usersByAge `shouldMatchList`
          ( [ (Nothing, Just 7, Nothing)
            , (Just 36, Nothing, Just 1)
            , (Just 17, Just 7, Nothing)
            ] :: [(Maybe Int, Maybe Rational, Maybe Rational)]
          )
  
  testCommonTableExpressions :: SpecDb
  testCommonTableExpressions = do
      describe "You can run them" $ do
          itDb "will run" $ do
              void $ select $ do
                  limitedLordsCte <-
                      Experimental.with $ do
                          lords <- Experimental.from $ Experimental.table @Lord
                          limit 10
                          pure lords
                  lords <- Experimental.from limitedLordsCte
                  orderBy [asc $ lords ^. LordId]
                  pure lords
  
              asserting noExceptions
  
      itDb "can do multiple recursive queries" $ do
          let
              oneToTen =
                  Experimental.withRecursive
                      (pure $ val (1 :: Int))
                      Experimental.unionAll_
                      (\self -> do
                          v <- Experimental.from self
                          where_ $ v <. val 10
                          pure $ v +. val 1
                      )
  
          vals <- select $ do
              cte <- oneToTen
              cte2 <- oneToTen
              res1 <- Experimental.from cte
              res2 <- Experimental.from cte2
              pure (res1, res2)
          asserting $ vals `shouldBe` (((,) <$> fmap Value [1..10] <*> fmap Value [1..10]))
  
      itDb "passing previous query works" $ do
          let
              oneToTen =
                  Experimental.withRecursive
                       (pure $ val (1 :: Int))
                       Experimental.unionAll_
                       (\self -> do
                           v <- Experimental.from self
                           where_ $ v <. val 10
                           pure $ v +. val 1
                       )
  
              oneMore q =
                  Experimental.with $ do
                      v <- Experimental.from q
                      pure $ v +. val 1
          vals <- select $ do
              cte <- oneToTen
              cte2 <- oneMore cte
              res <- Experimental.from cte2
              pure res
          asserting $ vals `shouldBe` fmap Value [2..11]
  
      describe "MATERIALIZED CTEs" $ do
        describe "withNotMaterialized" $ do
          itDb "successfully executes query" $ do
            void $ select $ do
              limitedLordsCte <-
                  withNotMaterialized $ do
                      lords <- Experimental.from $ Experimental.table @Lord
                      limit 10
                      pure lords
              lords <- Experimental.from limitedLordsCte
              orderBy [asc $ lords ^. LordId]
              pure lords
  
            asserting noExceptions
  
          itDb "generates the expected SQL" $ do
            (sql, _) <- showQuery ES.SELECT $ do
                    limitedLordsCte <-
                        withNotMaterialized $ do
                            lords <- Experimental.from $ Experimental.table @Lord
                            limit 10
                            pure lords
                    lords <- Experimental.from limitedLordsCte
                    orderBy [asc $ lords ^. LordId]
                    pure lords
  
            asserting $ sql `shouldBe` T.unlines
              [ "WITH \"cte\" AS NOT MATERIALIZED (SELECT \"Lord\".\"county\" AS \"v_county\", \"Lord\".\"dogs\" AS \"v_dogs\""
              , "FROM \"Lord\""
              , " LIMIT 10"
              , ")"
              , "SELECT \"cte\".\"v_county\", \"cte\".\"v_dogs\""
              , "FROM \"cte\""
              , "ORDER BY \"cte\".\"v_county\" ASC"
              ]
            asserting noExceptions
  
  
        describe "withMaterialized" $ do
          itDb "generates the expected SQL" $ do
            (sql, _) <- showQuery ES.SELECT $ do
                    limitedLordsCte <-
                        withMaterialized $ do
                            lords <- Experimental.from $ Experimental.table @Lord
                            limit 10
                            pure lords
                    lords <- Experimental.from limitedLordsCte
                    orderBy [asc $ lords ^. LordId]
                    pure lords
  
            asserting $ sql `shouldBe` T.unlines
              [ "WITH \"cte\" AS MATERIALIZED (SELECT \"Lord\".\"county\" AS \"v_county\", \"Lord\".\"dogs\" AS \"v_dogs\""
              , "FROM \"Lord\""
              , " LIMIT 10"
              , ")"
              , "SELECT \"cte\".\"v_county\", \"cte\".\"v_dogs\""
              , "FROM \"cte\""
              , "ORDER BY \"cte\".\"v_county\" ASC"
              ]
            asserting noExceptions
  
          itDb "successfully executes query" $ do
              void $ select $ do
                    limitedLordsCte <-
                        withMaterialized $ do
                            lords <- Experimental.from $ Experimental.table @Lord
                            limit 10
                            pure lords
                    lords <- Experimental.from limitedLordsCte
                    orderBy [asc $ lords ^. LordId]
                    pure lords
  
              asserting noExceptions
  
  testPostgresqlLocking :: SpecDb
  testPostgresqlLocking = do
      describe "Monoid instance" $ do
          let toText conn q =
                  let (tlb, _) = ES.toRawSql ES.SELECT (conn, ES.initialIdentState) q
                      in TLB.toLazyText tlb
          itDb "concatenates postgres locking clauses" $ do
              let multipleLockingQuery = do
                      p <- Experimental.from $ table @Person
                      EP.forUpdateOf p EP.skipLocked
                      EP.forUpdateOf p EP.skipLocked
                      EP.forNoKeyUpdateOf p EP.skipLocked
                      EP.forShareOf p EP.skipLocked
                      EP.forKeyShareOf p EP.skipLocked
              conn <- ask
              let res1 = toText conn multipleLockingQuery
                  resExpected =
                      TL.unlines
                      [
                        "SELECT 1"
                      ,"FROM \"Person\""
                      ,"FOR UPDATE OF \"Person\" SKIP LOCKED"
                      ,"FOR UPDATE OF \"Person\" SKIP LOCKED"
                      ,"FOR NO KEY UPDATE OF \"Person\" SKIP LOCKED"
                      ,"FOR SHARE OF \"Person\" SKIP LOCKED"
                      ,"FOR KEY SHARE OF \"Person\" SKIP LOCKED"
                      ]
  
              asserting $ res1 `shouldBe` resExpected
  
      describe "For update skip locked locking" $ sequential $ do
          let mkInitialStateForLockingTest connection =
                  flip runSqlPool connection $ do
                      p1k <- insert p1
                      p2k <- insert p2
                      p3k <- insert p3
                      blogPosts <- mapM insert'
                          [ BlogPost "A" p1k
                          , BlogPost "B" p2k
                          , BlogPost "C" p3k ]
                      pure ([p1k, p2k, p3k], entityKey <$> blogPosts)
              cleanupLockingTest connection (personKeys, blogPostKeys) =
                  flip runSqlPool connection $ do
                      forM_ blogPostKeys P.delete
                      forM_ personKeys P.delete
          aroundWith (\testAction connection -> do
              bracket (mkInitialStateForLockingTest connection) (cleanupLockingTest connection) $ \(personKeys, blogPostKeys) ->
                  testAction (connection, personKeys, blogPostKeys)
              ) $ do
                  it "skips locked rows for a locking select" $ \(connection, _, _) -> do
                      waitMainThread <- newEmptyMVar
  
                      let sideThread :: IO Expectation
                          sideThread = do
                              flip runSqlPool connection $ do
  
                                  _ <- takeMVar waitMainThread
                                  nonLockedRowsNonSpecified <-
                                      select $ do
                                          p <- Experimental.from $ table @Person
                                          EP.forUpdateOf p EP.skipLocked
                                          return p
  
                                  nonLockedRowsSpecifiedTable <-
                                      select $ do
                                          from $ \(p `LeftOuterJoin` b) -> do
                                              on (p ^. PersonId ==. b ^. BlogPostAuthorId)
                                              EP.forUpdateOf p EP.skipLocked
                                              return p
  
                                  nonLockedRowsSpecifyAllTables <-
                                      select $ do
                                          from $ \(p `InnerJoin` b) -> do
                                              on (p ^. PersonId ==. b ^. BlogPostAuthorId)
                                              EP.forUpdateOf (p :& b) EP.skipLocked
                                              return p
  
                                  pure $ do
                                      nonLockedRowsNonSpecified `shouldBe` []
                                      nonLockedRowsSpecifiedTable `shouldBe` []
                                      nonLockedRowsSpecifyAllTables `shouldBe` []
  
                      withAsync sideThread $ \sideThreadAsync -> do
                          void $ flip runSqlPool connection $ do
                              void $ select $ do
                                  person <- Experimental.from $ table @Person
                                  locking ForUpdate
                                  pure $ person ^. PersonId
  
                              _ <- putMVar waitMainThread ()
                              sideThreadAsserts <- wait sideThreadAsync
                              nonLockedRowsAfterUpdate <- select $ do
                                                  from $ \(p `LeftOuterJoin` b) -> do
                                                      on (p ^. PersonId ==. b ^. BlogPostAuthorId)
                                                      EP.forUpdateOf p EP.skipLocked
                                                      return p
  
                              asserting sideThreadAsserts
                              asserting $ length nonLockedRowsAfterUpdate `shouldBe` 3
  
                  it "skips locked rows for a subselect update" $ \(connection, _, _)-> do
                      waitMainThread <- newEmptyMVar
  
                      let sideThread :: IO Expectation
                          sideThread =
                              flip runSqlPool connection $ do
                                  _ <- liftIO $ takeMVar waitMainThread
  
                                  nonLockedRowsSpecifiedTable <-
                                      select $ do
                                          from $ \(p `LeftOuterJoin` b) -> do
                                              on (p ^. PersonId ==. b ^. BlogPostAuthorId)
                                              EP.forUpdateOf p EP.skipLocked
                                              return p
  
                                  pure $ length nonLockedRowsSpecifiedTable `shouldBe` 2
  
                      withAsync sideThread $ \sideThreadAsync -> do
                          void $ flip runSqlPool connection $ do
                              update $ \p -> do
                                  set p [ PersonName =. val "ChangedName1" ]
                                  where_ $ p ^. PersonId
                                      `in_` subList_select (do
                                              person <- Experimental.from $ table @Person
                                              where_ (person ^. PersonName ==. val "Rachel")
                                              limit 1
                                              locking ForUpdate
                                              pure $ person ^. PersonId)
  
  
                              _ <- putMVar waitMainThread ()
                              sideThreadAsserts <- wait sideThreadAsync
                              nonLockedRowsAfterUpdate <- select $ do
                                                  from $ \(p `LeftOuterJoin` b) -> do
                                                      on (p ^. PersonId ==. b ^. BlogPostAuthorId)
                                                      EP.forUpdateOf p EP.skipLocked
                                                      return p
  
                              asserting sideThreadAsserts
                              asserting $ length nonLockedRowsAfterUpdate `shouldBe` 3
  
                  it "skips locked rows for a subselect join update" $ \(connection, _, _) -> do
                      waitMainThread <- newEmptyMVar
  
                      let sideThread :: IO Expectation
                          sideThread =
                              flip runSqlPool connection $ do
                                  liftIO $ takeMVar waitMainThread
                                  lockedRows <-
                                      select $ do
                                          from $ \(p `LeftOuterJoin` b) -> do
                                              on (p ^. PersonId ==. b ^. BlogPostAuthorId)
                                              where_ (b ^. BlogPostTitle ==. val "A")
                                              EP.forUpdateOf p EP.skipLocked
                                              return p
  
                                  nonLockedRows <-
                                    select $ do
                                          from $ \(p `LeftOuterJoin` b) -> do
                                              on (p ^. PersonId ==. b ^. BlogPostAuthorId)
                                              EP.forUpdateOf p EP.skipLocked
                                              return p
  
                                  pure $ do
                                      lockedRows `shouldBe` []
                                      length nonLockedRows `shouldBe` 2
  
                      withAsync sideThread $ \sideThreadAsync -> do
                          void $ flip runSqlPool connection $ do
                              update $ \p -> do
                                  set p [ PersonName =. val "ChangedName" ]
                                  where_ $ p ^. PersonId
                                      `in_` subList_select (do
                                              (people :& blogPosts) <-
                                                  Experimental.from $ table @Person
                                                  `Experimental.leftJoin` table @BlogPost
                                                  `Experimental.on` (\(people :& blogPosts) ->
                                                          just (people ^. PersonId) ==. blogPosts ?. BlogPostAuthorId)
                                              where_ (blogPosts ?. BlogPostTitle ==. just (val "A"))
                                              pure $ people ^. PersonId
                                          )
  
                              liftIO $ putMVar waitMainThread ()
                              sideThreadAsserts <- wait sideThreadAsync
                              nonLockedRowsAfterUpdate <- select $ do
                                                  from $ \(p `LeftOuterJoin` b) -> do
                                                      on (p ^. PersonId ==. b ^. BlogPostAuthorId)
                                                      EP.forUpdateOf p EP.skipLocked
                                                      return p
  
                              asserting sideThreadAsserts
                              asserting $ length nonLockedRowsAfterUpdate `shouldBe` 3
  
      describe "noWait" $ do
          itDb "doesn't crash" $ do
              select $ do
                  t <- Experimental.from $ table @Person
                  EP.forUpdateOf t EP.noWait
                  pure t
  
              asserting noExceptions
  
  -- Since lateral queries arent supported in Sqlite or older versions of mysql
  -- the test is in the Postgres module
  testLateralQuery :: SpecDb
  testLateralQuery = do
      describe "Lateral queries" $ do
          itDb "supports CROSS JOIN LATERAL" $ do
            _ <-  do
              select $ do
                  l :& c <-
                    Experimental.from $ table @Lord
                    `CrossJoin` \lord -> do
                          deed <- Experimental.from $ table @Deed
                          where_ $ lord ^. LordId ==. deed ^. DeedOwnerId
                          pure $ countRows @Int
                  pure (l, c)
            liftIO $ True `shouldBe` True
  
          itDb "supports INNER JOIN LATERAL" $ do
              let subquery lord = do
                                  deed <- Experimental.from $ table @Deed
                                  where_ $ lord ^. LordId ==. deed ^. DeedOwnerId
                                  pure $ countRows @Int
              res <- select $ do
                l :& c <- Experimental.from $ table @Lord
                                `InnerJoin` subquery
                                `Experimental.on` (const $ val True)
                pure (l, c)
  
              let _ = res :: [(Entity Lord, Value Int)]
              asserting noExceptions
  
          itDb "supports LEFT JOIN LATERAL" $ do
              res <- select $ do
                  l :& c <- Experimental.from $ table @Lord
                                  `LeftOuterJoin` (\lord -> do
                                            deed <- Experimental.from $ table @Deed
                                            where_ $ lord ^. LordId ==. deed ^. DeedOwnerId
                                            pure $ countRows @Int)
                                  `Experimental.on` (const $ val True)
                  pure (l, c)
  
              let _ = res :: [(Entity Lord, Value (Maybe Int))]
              asserting noExceptions
  
  testValuesExpression :: SpecDb
  testValuesExpression = do
      describe "(VALUES (..)) query" $ do
          itDb "works with joins and other sql expressions" $ do
              p1k <- insert p1
              p2k <- insert p2
              p3k <- insert p3
              let exprs :: NE.NonEmpty (SqlExpr (Value Int), SqlExpr (Value Text))
                  exprs =   (val 10, val "ten")
                      NE.:| [ (val 20, val "twenty")
                          , (val 30, val "thirty") ]
                  query = do
                      (bound, boundName) :& person <- Experimental.from $
                          EP.values exprs
                          `Experimental.InnerJoin` table @Person
                          `Experimental.on` (\((bound, boundName) :& person) -> person^.PersonAge >=. just bound)
                      groupBy bound
                      orderBy [ asc bound ]
                      pure (bound, count @Int $ person^.PersonName)
              result <- select query
              liftIO $ result `shouldBe` [ (Value 10, Value 2)
                                         , (Value 20, Value 1)
                                         , (Value 30, Value 1) ]
  
          itDb "supports single-column query" $ do
              let query = do
                      vInt <- Experimental.from $ EP.values $ val 1 NE.:| [ val 2, val 3 ]
                      pure (vInt :: SqlExpr (Value Int))
              result <- select query
              asserting noExceptions
              liftIO $ result `shouldBe` [ Value 1, Value 2, Value 3 ]
  
          itDb "supports multi-column query (+ nested simple expression and null)" $ do
              let query = do
                      (vInt, vStr, vDouble) <- Experimental.from
                          $ EP.values $ (val 1, val "str1", coalesce [just $ val 1.0, nothing])
                                  NE.:| [ (val 2, val "str2", just $ val 2.5)
                                        , (val 3, val "str3", nothing) ]
                      pure ( vInt :: SqlExpr (Value Int)
                              , vStr :: SqlExpr (Value Text)
                              , vDouble :: SqlExpr (Value (Maybe Double)) )
              result <- select query
              asserting noExceptions
              liftIO $ result `shouldBe` [ (Value 1, Value "str1", Value $ Just 1.0)
                                         , (Value 2, Value "str2", Value $ Just 2.5)
                                         , (Value 3, Value "str3", Value Nothing) ]
  
  testSubselectAliasingBehavior :: SpecDb
  testSubselectAliasingBehavior = do
      describe "Aliasing behavior" $ do
          itDb "correctly realiases entities accross multiple subselects" $ do
              _ <- select $ do
                      Experimental.from $ Experimental.from $ Experimental.from $ table @Lord
              asserting noExceptions
  
          itDb "doesnt erroneously repeat variable names when using subselect + union" $ do
              let lordQuery = do
                      l <- Experimental.from $ table @Lord
                      pure (l ^. LordCounty, l ^. LordDogs)
                  personQuery = do
                      p <- Experimental.from $ table @Person
                      pure (p ^. PersonName, just $ p ^. PersonFavNum)
              _ <- select $
                  Experimental.from $ do
                      (str, _) <- Experimental.from $ lordQuery `union_` personQuery
                      pure (str, val @Int 1)
              asserting noExceptions
  
  testPostgresqlNullsOrdering :: SpecDb
  testPostgresqlNullsOrdering = do
    describe "Postgresql NULLS orderings work" $ do
        itDb "ASC NULLS FIRST works" $ do
          p1e <- insert' p1
          p2e <- insert' p2 -- p2 has a null age
          p3e <- insert' p3
          p4e <- insert' p4
          ret <- select $
                 from $ \p -> do
                 orderBy [EP.ascNullsFirst (p ^. PersonAge), EP.ascNullsFirst (p ^. PersonFavNum)]
                 return p
          -- nulls come first
          asserting $ ret `shouldBe` [ p2e, p3e, p4e, p1e ]
        itDb "ASC NULLS LAST works" $ do
          p1e <- insert' p1
          p2e <- insert' p2 -- p2 has a null age
          p3e <- insert' p3
          p4e <- insert' p4
          ret <- select $
                 from $ \p -> do
                 orderBy [EP.ascNullsLast (p ^. PersonAge), EP.ascNullsLast (p ^. PersonFavNum)]
                 return p
          -- nulls come last
          asserting $ ret `shouldBe` [ p3e, p4e, p1e, p2e ]
        itDb "DESC NULLS FIRST works" $ do
          p1e <- insert' p1
          p2e <- insert' p2 -- p2 has a null age
          p3e <- insert' p3
          p4e <- insert' p4
          ret <- select $
                 from $ \p -> do
                 orderBy [EP.descNullsFirst (p ^. PersonAge), EP.descNullsFirst (p ^. PersonFavNum)]
                 return p
          -- nulls come first
          asserting $ ret `shouldBe` [ p2e, p1e, p4e, p3e ]
        itDb "DESC NULLS LAST works" $ do
          p1e <- insert' p1
          p2e <- insert' p2 -- p2 has a null age
          p3e <- insert' p3
          p4e <- insert' p4
          ret <- select $
                 from $ \p -> do
                 orderBy [EP.descNullsLast (p ^. PersonAge), EP.descNullsLast (p ^. PersonFavNum)]
                 return p
          -- nulls come last
          asserting $ ret `shouldBe` [ p1e, p4e, p3e, p2e ]
  
  
  type JSONValue = Maybe (JSONB A.Value)
  
  createSaneSQL :: (PersistField a, MonadIO m) => SqlExpr (Value a) -> T.Text -> [PersistValue] -> SqlPersistT m ()
  createSaneSQL act q vals = do
      (query, args) <- showQuery ES.SELECT $ fromValue act
      liftIO $ do
          query `shouldBe` q
          args `shouldBe` vals
  
  fromValue :: (PersistField a) => SqlExpr (Value a) -> SqlQuery (SqlExpr (Value a))
  fromValue act = from $ \x -> do
      let _ = x :: SqlExpr (Entity Json)
      return act
  
  persistTextArray :: [T.Text] -> PersistValue
  persistTextArray = PersistArray . fmap PersistText
  
  sqlFailWith
      :: (HasCallStack, MonadUnliftIO m, Show a)
      => ByteString
      -> SqlPersistT m a
      -> SqlPersistT m ()
  sqlFailWith errState f = do
      eres <- try f
      case eres of
          Left err ->
              success err
          Right a ->
              liftIO $ expectationFailure $ mconcat
                  [ "should fail with error code: "
                  , T.unpack errStateT
                  , ", but got: "
                  , show a
                  ]
    where
      success SqlError{sqlState}
          | sqlState == errState =
              pure ()
          | otherwise = do
              liftIO $ expectationFailure $ T.unpack $ T.concat
                  [ "should fail with: ", errStateT
                  , ", but received: ", TE.decodeUtf8 sqlState
                  ]
      errStateT =
          TE.decodeUtf8 errState
  
  selectJSONwhere
    :: MonadIO m
    => (JSONBExpr A.Value -> SqlExpr (Value Bool))
    -> SqlPersistT m [Entity Json]
  selectJSONwhere f = selectJSON $ where_ . f
  
  selectJSON
    :: MonadIO m
    => (JSONBExpr A.Value -> SqlQuery ())
    -> SqlPersistT m [Entity Json]
  selectJSON f = select $ from $ \v -> do
      f $ just (v ^. JsonValue)
      return v
  
  insertJsonValues :: SqlPersistT IO ()
  insertJsonValues = do
      insertIt Null
      insertIt $ Bool True
      insertIt $ Number 1
      insertIt $ String "test"
      insertIt $ toJSON ([] :: [A.Value])
      insertIt $ toJSON [Number 1, Bool True, Null]
      insertIt $ toJSON [String "test",object ["a" .= Number 3.14], Null, Bool True]
      insertIt $ object ["a" .= (1 :: Int), "b" .= False]
      insertIt $ object ["a" .= object ["b" .= object ["c" .= String "message"]]]
    where
      insertIt :: MonadIO m => A.Value -> SqlPersistT m ()
      insertIt = insert_ . Json . JSONB
  
  verbose :: Bool
  verbose = False
  
  migrateIt :: _ => SqlPersistT m ()
  migrateIt = mapReaderT runNoLoggingT $ do
      void $ runMigrationSilent $ do
          migrateAll
          migrateUnique
          migrateJSON
      cleanDB
      cleanUniques
  
  mkConnectionPool :: IO ConnectionPool
  mkConnectionPool = do
      verbose' <- lookupEnv "VERBOSE" >>= \case
          Nothing ->
              return verbose
          Just x
              | map Char.toLower x == "true" -> return True
              | null x -> return True
              | otherwise -> return False
      pool <- if verbose'
          then
              runStderrLoggingT $
                  createPostgresqlPool
                  "host=localhost port=5432 user=esqutest password=esqutest dbname=esqutest"
                  4
          else
              runNoLoggingT $
                  createPostgresqlPool
                  "host=localhost port=5432 user=esqutest password=esqutest dbname=esqutest"
                  4
      flip runSqlPool pool $ do
          migrateIt
      pure pool
  
  -- | Show the SQL generated by a query
  showQuery :: (Monad m, ES.SqlSelect a r, BackendCompatible SqlBackend backend)
            => ES.Mode -> SqlQuery a -> ReaderT backend m (T.Text, [PersistValue])
  showQuery mode query = do
    backend <- ask
    let (builder, values) = ES.toRawSql mode (backend, ES.initialIdentState) query
    return (ES.builderToText builder, values)
  