Test.hs

{-# 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_)
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

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 [OneUniqueName =. val "fifth"]
      liftIO $ entityVal u1e `shouldBe` u1
    itDb "Upsert performs update on collision" $  do
      u1e <- EP.upsert u1 [OneUniqueName =. val "fifth"]
      liftIO $ entityVal u1e `shouldBe` u1
      u2e <- EP.upsert u2 [OneUniqueName =. val "fifth"]
      liftIO $ entityVal u2e `shouldBe` u2
      u3e <- EP.upsert u3 [OneUniqueName =. val "fifth"]
      liftIO $ entityVal u3e `shouldBe` u1{oneUniqueName="fifth"}

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]

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.forShareOf 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 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

                                liftIO $ print nonLockedRowsSpecifiedTable
                                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

                            liftIO $ print nonLockedRowsAfterUpdate
                            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

-- 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


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

--------------- JSON --------------- JSON --------------- JSON ---------------
--------------- JSON --------------- JSON --------------- JSON ---------------
--------------- JSON --------------- JSON --------------- JSON ---------------



spec :: Spec
spec = beforeAll mkConnectionPool $ do
    tests

    describe "PostgreSQL specific tests" $ do
        testAscRandom random_
        testRandomMath
        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

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)