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

                                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

    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


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)