esqueleto/test/PostgreSQL/Test.hs

{-# OPTIONS_GHC -fno-warn-unused-binds  #-}
{-# LANGUAGE FlexibleContexts
           , LambdaCase
           , NamedFieldPuns
           , OverloadedStrings
           , RankNTypes
           , ScopedTypeVariables
           , TypeApplications
           , TypeFamilies
           , PartialTypeSignatures
 #-}
module Main (main) where

import Data.Coerce
import Data.Foldable
import qualified Data.Map.Strict as Map
import Data.Map (Map)
import Data.Time
import Control.Arrow ((&&&))
import Control.Monad (void, when)
import Control.Monad.Catch (MonadCatch, catch)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Logger (runStderrLoggingT, runNoLoggingT)
import Control.Monad.Trans.Reader (ReaderT, ask)
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.Char as Char
import qualified Data.List as L
import Data.Ord (comparing)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Time.Clock (getCurrentTime, diffUTCTime, UTCTime)
import Database.Esqueleto hiding (random_)
import Database.Esqueleto.Experimental hiding (random_, from, on)
import qualified Database.Esqueleto.Experimental as Experimental
import qualified Database.Esqueleto.Internal.Sql 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 Database.Persist.Postgresql (withPostgresqlConn)
import Database.PostgreSQL.Simple (SqlError(..), ExecStatus(..))
import System.Environment
import Test.Hspec
import Test.Hspec.QuickCheck

import Common.Test
import PostgreSQL.MigrateJSON



testPostgresqlCoalesce :: Spec
testPostgresqlCoalesce = do
  it "works on PostgreSQL and MySQL with <2 arguments" $
    run $ do
      _ :: [Value (Maybe Int)] <-
        select $
        from $ \p -> do
        return (coalesce [p ^. PersonAge])
      return ()

nameContains :: (BaseBackend backend ~ SqlBackend,
                 BackendCompatible SqlBackend backend,
                 MonadIO m, SqlString s,
                 IsPersistBackend backend, PersistQueryRead backend,
                 PersistUniqueRead backend)
             => (SqlExpr (Value [Char])
             -> SqlExpr (Value s)
             -> SqlExpr (Value Bool))
             -> s
             -> [Entity Person]
             -> ReaderT backend m ()
nameContains f t expected = do
  ret <- select $
         from $ \p -> do
         where_ (f
                  (p ^. PersonName)
                  ((%) ++. val t ++. (%)))
         orderBy [asc (p ^. PersonName)]
         return p
  liftIO $ ret `shouldBe` expected


testPostgresqlTextFunctions :: Spec
testPostgresqlTextFunctions = do
  describe "text functions" $ do
    it "like, (%) and (++.) work on a simple example" $
       run $ do
         [p1e, p2e, p3e, p4e] <- mapM insert' [p1, p2, p3, p4]
         nameContains like "h"  [p1e, p2e]
         nameContains like "i"  [p4e, p3e]
         nameContains like "iv" [p4e]

    it "ilike, (%) and (++.) work on a simple example on PostgreSQL" $
      run $ do
        [p1e, _, p3e, _, p5e] <- mapM insert' [p1, p2, p3, p4, p5]
        let nameContains' t expected = do
              ret <- select $
                     from $ \p -> do
                     where_ (p ^. PersonName `ilike` (%) ++. val t ++. (%))
                     orderBy [asc (p ^. PersonName)]
                     return p
              liftIO $ ret `shouldBe` expected
        nameContains' "mi" [p3e, p5e]
        nameContains' "JOHN" [p1e]





testPostgresqlUpdate :: Spec
testPostgresqlUpdate = do
  it "works on a simple example" $
    run $ 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.
      liftIO $ n `shouldBe` 2
      liftIO $ ret `shouldBe` [ Entity p1k (Person anon (Just 73) Nothing 1)
                              , Entity p2k (Person anon Nothing (Just 37) 2)
                              , Entity p3k p3 ]





testPostgresqlRandom :: Spec
testPostgresqlRandom = do
  it "works with random_" $
    run $ do
      _ <- select $ return (random_ :: SqlExpr (Value Double))
      return ()





testPostgresqlSum :: Spec
testPostgresqlSum = do
  it "works with sum_" $
    run $ do
      _ <- insert' p1
      _ <- insert' p2
      _ <- insert' p3
      _ <- insert' p4
      ret <- select $
             from $ \p->
             return $ joinV $ sum_ (p ^. PersonAge)
      liftIO $ ret `shouldBe` [ Value $ Just (36 + 17 + 17 :: Rational ) ]





testPostgresqlTwoAscFields :: Spec
testPostgresqlTwoAscFields = do
  it "works with two ASC fields (one call)" $
    run $ 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
      liftIO $ ret `shouldBe` [ p4e, p3e, p1e , p2e ]





testPostgresqlOneAscOneDesc :: Spec
testPostgresqlOneAscOneDesc = do
  it "works with one ASC and one DESC field (two calls)" $
    run $ 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
      liftIO $ ret `shouldBe` [ p2e, p1e, p4e, p3e ]





testSelectDistinctOn :: Spec
testSelectDistinctOn = do
  describe "SELECT DISTINCT ON" $ do
    it "works on a simple example" $ do
      run $ 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 =
          run $ 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]

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

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

    it "works on a slightly less simple example (distinctOnOrderBy)" $ do
      slightlyLessSimpleTest $ \bp ->
        distinctOnOrderBy [asc (bp ^. BlogPostAuthorId), asc (bp ^. BlogPostTitle)]





testArrayAggWith :: Spec
testArrayAggWith = do
  describe "ALL, no ORDER BY" $ do
    it "creates sane SQL" $ run $ 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` []

    it "works on an example" $ run $ 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
    it "creates sane SQL" $ run $ 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` []

    it "works on an example" $ run $ 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
    it "creates sane SQL" $ run $ 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` []

    it "works on an example" $ run $ 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
    it "creates sane SQL" $ run $ 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` []

    it "works on an example" $ run $ 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 :: Spec
testStringAggWith = do
  describe "ALL, no ORDER BY" $ do
    it "creates sane SQL" $ run $ 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 " "]

    it "works on an example" $ run $ 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)

    it "works with zero rows" $ run $ do
      [Value ret] <-
        select . from $ \p ->
          return (EP.stringAggWith EP.AggModeAll (p ^. PersonName) (val " ")[])
      liftIO $ ret `shouldBe` Nothing

  describe "DISTINCT, no ORDER BY" $ do
    it "creates sane SQL" $ run $ 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 " "]

    it "works on an example" $ run $ 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
    it "creates sane SQL" $ run $ 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 " "]

    it "works on an example" $ run $ 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
    it "creates sane SQL" $ run $ 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 " "]

    it "works on an example" $ run $ 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 :: Spec
testAggregateFunctions = do
  describe "arrayAgg" $ do
    it "looks sane" $ run $ 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)

    it "works on zero rows" $ run $ do
      [Value ret] <-
        select . from $ \p -> return (EP.arrayAgg (p ^. PersonName))
      liftIO $ ret `shouldBe` Nothing
  describe "arrayAggWith" testArrayAggWith
  describe "stringAgg" $ do
    it "looks sane" $
      run $ 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)
    it "works on zero rows" $ run $ do
      [Value ret] <-
        select . from $ \p -> return (EP.stringAgg (p ^. PersonName) (val " "))
      liftIO $ ret `shouldBe` Nothing
  describe "stringAggWith" testStringAggWith

  describe "array_remove (NULL)" $ do
    it "removes NULL from arrays from nullable fields" $ run $ 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
    it "Coalesces NULL into an empty array" $ run $ do
      [Value ret] <-
        select . from $ \p ->
          return (EP.maybeArray $ EP.arrayAgg (p ^. PersonName))
      liftIO $ ret `shouldBe` []





testPostgresModule :: Spec
testPostgresModule = do
  describe "date_trunc" $ modifyMaxSuccess (`div` 10) $ do
    prop "works" $ \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)
            )
          )

      liftIO $ 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
    it "chr looks sane" $
      run $ do
        [Value (ret :: String)] <- select $ return (EP.chr (val 65))
        liftIO $ ret `shouldBe` "A"

    it "allows unit for functions" $ do
      vals <- run $ do
        let
          fn :: SqlExpr (Value UTCTime)
          fn = ES.unsafeSqlFunction "now" ()
        select $ pure fn
      vals `shouldSatisfy` ((1 ==) . length)

    it "works with now" $
      run $ do
        nowDb <- select $ return EP.now_
        nowUtc <- liftIO getCurrentTime
        let halfSecond = realToFrac (0.5 :: 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 half a second
        liftIO $ diffUTCTime nowUtc now `shouldSatisfy` (< halfSecond)


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

testJSONInsertions :: Spec
testJSONInsertions =
  describe "JSON Insertions" $ do
    it "adds scalar values" $ do
      run $ do
        insertIt Null
        insertIt $ Bool True
        insertIt $ Number 1
        insertIt $ String "test"
    it "adds arrays" $ do
      run $ do
        insertIt $ toJSON ([] :: [A.Value])
        insertIt $ toJSON [Number 1, Bool True, Null]
        insertIt $ toJSON [String "test",object ["a" .= Number 3.14], Null, Bool True]
    it "adds objects" $ do
      run $ 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 :: Spec
testJSONOperators =
  describe "JSON Operators" $ do
    testArrowOperators
    testFilterOperators
    testConcatDeleteOperators

testArrowOperators :: Spec
testArrowOperators =
  describe "Arrow Operators" $ do
    testArrowJSONB
    testArrowText
    testHashArrowJSONB
    testHashArrowText

testArrowJSONB :: Spec
testArrowJSONB =
  describe "Single Arrow (JSONB)" $ do
    it "creates sane SQL" $
      createSaneSQL @JSONValue
        (jsonbVal (object ["a" .= True]) ->. "a")
        "SELECT (? -> ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":true}"
        , PersistText "a" ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [1 :: Int,2,3]]
      createSaneSQL @JSONValue
        (jsonbVal obj ->. "a" ->. 1)
        "SELECT ((? -> ?) -> ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[1,2,3]}"
        , PersistText "a"
        , PersistInt64 1 ]
    it "works as expected" $ run $ 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")
      liftIO $ length x `shouldBe` 1
      liftIO $ length y `shouldBe` 1
      liftIO $ length z `shouldBe` 1

testArrowText :: Spec
testArrowText =
  describe "Single Arrow (Text)" $ do
    it "creates sane SQL" $
      createSaneSQL
        (jsonbVal (object ["a" .= True]) ->>. "a")
        "SELECT (? ->> ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":true}"
        , PersistText "a" ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [1 :: Int,2,3]]
      createSaneSQL
        (jsonbVal obj ->. "a" ->>. 1)
        "SELECT ((? -> ?) ->> ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[1,2,3]}"
        , PersistText "a"
        , PersistInt64 1 ]
    it "works as expected" $ run $ 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 :: Spec
testHashArrowJSONB =
  describe "Double Arrow (JSONB)" $ do
    it "creates sane SQL" $ do
      let list = ["a","b","c"]
      createSaneSQL @JSONValue
        (jsonbVal (object ["a" .= True]) #>. list)
        "SELECT (? #> ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":true}"
        , persistTextArray list ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [object ["b" .= True]]]
      createSaneSQL @JSONValue
        (jsonbVal obj #>. ["a","1"] #>. ["b"])
        "SELECT ((? #> ?) #> ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
        , persistTextArray ["a","1"]
        , persistTextArray ["b"] ]
    it "works as expected" $ run $ 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 :: Spec
testHashArrowText =
  describe "Double Arrow (Text)" $ do
    it "creates sane SQL" $ do
      let list = ["a","b","c"]
      createSaneSQL
        (jsonbVal (object ["a" .= True]) #>>. list)
        "SELECT (? #>> ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":true}"
        , persistTextArray list ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [object ["b" .= True]]]
      createSaneSQL
        (jsonbVal obj #>. ["a","1"] #>>. ["b"])
        "SELECT ((? #> ?) #>> ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
        , persistTextArray ["a","1"]
        , persistTextArray ["b"] ]
    it "works as expected" $ run $ 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 :: Spec
testFilterOperators =
  describe "Filter Operators" $ do
    testInclusion
    testQMark
    testQMarkAny
    testQMarkAll

testInclusion :: Spec
testInclusion = do
  describe "@>" $ do
    it "creates sane SQL" $
      createSaneSQL
        (jsonbVal (object ["a" .= False, "b" .= True]) @>. jsonbVal (object ["a" .= False]))
        "SELECT (? @> ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":false,\"b\":true}"
        , PersistDbSpecific "{\"a\":false}" ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [object ["b" .= True]]]
      createSaneSQL
        (jsonbVal obj ->. "a" @>. jsonbVal (object ["b" .= True]))
        "SELECT ((? -> ?) @> ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
        , PersistText "a"
        , PersistDbSpecific "{\"b\":true}" ]
    it "works as expected" $ run $ 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
    it "creates sane SQL" $
      createSaneSQL
        (jsonbVal (object ["a" .= False]) <@. jsonbVal (object ["a" .= False, "b" .= True]))
        "SELECT (? <@ ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":false}"
        , PersistDbSpecific "{\"a\":false,\"b\":true}" ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [object ["b" .= True]]]
      createSaneSQL
        (jsonbVal obj ->. "a" <@. jsonbVal (object ["b" .= True, "c" .= Null]))
        "SELECT ((? -> ?) <@ ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
        , PersistText "a"
        , PersistDbSpecific "{\"b\":true,\"c\":null}" ]
    it "works as expected" $ run $ 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 :: Spec
testQMark =
  describe "Question Mark" $ do
    it "creates sane SQL" $
      createSaneSQL
        (jsonbVal (object ["a" .= False, "b" .= True]) JSON.?. "a")
        "SELECT (? ?? ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":false,\"b\":true}"
        , PersistText "a" ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [object ["b" .= True]]]
      createSaneSQL
        (jsonbVal obj #>. ["a","0"] JSON.?. "b")
        "SELECT ((? #> ?) ?? ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
        , persistTextArray ["a","0"]
        , PersistText "b" ]
    it "works as expected" $ run $ 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 :: Spec
testQMarkAny =
  describe "Question Mark (Any)" $ do
    it "creates sane SQL" $
      createSaneSQL
        (jsonbVal (object ["a" .= False, "b" .= True]) ?|. ["a","c"])
        "SELECT (? ??| ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":false,\"b\":true}"
        , persistTextArray ["a","c"] ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [object ["b" .= True]]]
      createSaneSQL
        (jsonbVal obj #>. ["a","0"] ?|. ["b","c"])
        "SELECT ((? #> ?) ??| ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
        , persistTextArray ["a","0"]
        , persistTextArray ["b","c"] ]
    it "works as expected" $ run $ 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 :: Spec
testQMarkAll =
  describe "Question Mark (All)" $ do
    it "creates sane SQL" $
      createSaneSQL
        (jsonbVal (object ["a" .= False, "b" .= True]) ?&. ["a","c"])
        "SELECT (? ??& ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":false,\"b\":true}"
        , persistTextArray ["a","c"] ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [object ["b" .= True]]]
      createSaneSQL
        (jsonbVal obj #>. ["a","0"] ?&. ["b","c"])
        "SELECT ((? #> ?) ??& ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
        , persistTextArray ["a","0"]
        , persistTextArray ["b","c"] ]
    it "works as expected" $ run $ 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 :: Spec
testConcatDeleteOperators = do
  describe "Concatenation Operator" testConcatenationOperator
  describe "Deletion Operators" $ do
    testMinusOperator
    testMinusOperatorV10
    testHashMinusOperator

testConcatenationOperator :: Spec
testConcatenationOperator =
  describe "Concatenation" $ do
    it "creates sane SQL" $
      createSaneSQL @JSONValue
        (jsonbVal (object ["a" .= False, "b" .= True])
            JSON.||. jsonbVal (object ["c" .= Null]))
        "SELECT (? || ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":false,\"b\":true}"
        , PersistDbSpecific "{\"c\":null}" ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [object ["b" .= True]]]
      createSaneSQL @JSONValue
        (jsonbVal obj ->. "a" JSON.||. jsonbVal (toJSON [Null]))
        "SELECT ((? -> ?) || ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
        , PersistText "a"
        , PersistDbSpecific "[null]" ]
    it "works as expected" $ run $ 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
      sqlFailWith "22023" $ selectJSONwhere $ \v ->
          v JSON.||. jsonbVal (toJSON $ String "test")
                 @>. jsonbVal (String "test")

testMinusOperator :: Spec
testMinusOperator =
  describe "Minus Operator" $ do
    it "creates sane SQL" $
      createSaneSQL @JSONValue
        (jsonbVal (object ["a" .= False, "b" .= True]) JSON.-. "a")
        "SELECT (? - ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":false,\"b\":true}"
        , PersistText "a" ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [object ["b" .= True]]]
      createSaneSQL @JSONValue
        (jsonbVal obj ->. "a" JSON.-. 0)
        "SELECT ((? -> ?) - ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
        , PersistText "a"
        , PersistInt64 0 ]
    it "works as expected" $ run $ 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 :: Spec
testMinusOperatorV10 =
  describe "Minus Operator (PSQL >= v10)" $ do
    it "creates sane SQL" $
      createSaneSQL @JSONValue
        (jsonbVal (object ["a" .= False, "b" .= True]) --. ["a","b"])
        "SELECT (? - ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":false,\"b\":true}"
        , persistTextArray ["a","b"] ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [object ["b" .= True]]]
      createSaneSQL @JSONValue
        (jsonbVal obj #>. ["a","0"] --. ["b"])
        "SELECT ((? #> ?) - ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
        , persistTextArray ["a","0"]
        , persistTextArray ["b"] ]
    it "works as expected" $ run $ 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 :: Spec
testHashMinusOperator =
  describe "Hash-Minus Operator" $ do
    it "creates sane SQL" $
      createSaneSQL @JSONValue
        (jsonbVal (object ["a" .= False, "b" .= True]) #-. ["a"])
        "SELECT (? #- ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":false,\"b\":true}"
        , persistTextArray ["a"] ]
    it "creates sane SQL (chained)" $ do
      let obj = object ["a" .= [object ["b" .= True]]]
      createSaneSQL @JSONValue
        (jsonbVal obj ->. "a" #-. ["0","b"])
        "SELECT ((? -> ?) #- ?)\nFROM \"Json\"\n"
        [ PersistDbSpecific "{\"a\":[{\"b\":true}]}"
        , PersistText "a"
        , persistTextArray ["0","b"] ]
    it "works as expected" $ run $ 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 :: Spec
testInsertUniqueViolation =
  describe "Unique Violation on Insert" $
    it "Unique throws exception" $ run (do
      _ <- insert u1
      _ <- insert u2
      insert u3) `shouldThrow` (==) exception
  where
    exception = SqlError {
      sqlState = "23505",
      sqlExecStatus = FatalError,
      sqlErrorMsg = "duplicate key value violates unique constraint \"UniqueValue\"",
      sqlErrorDetail = "Key (value)=(0) already exists.",
      sqlErrorHint = ""}

testUpsert :: Spec
testUpsert =
  describe "Upsert test" $ do
    it "Upsert can insert like normal" $ run $ do
      u1e <- EP.upsert u1 [OneUniqueName =. val "fifth"]
      liftIO $ entityVal u1e `shouldBe` u1
    it "Upsert performs update on collision" $ run $ 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 :: Spec
testInsertSelectWithConflict =
  describe "insertSelectWithConflict test" $ do
    it "Should do Nothing when no updates set" $ run $ 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
    it "Should update a value if given an update on conflict" $ run $ 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 :: Spec
testFilterWhere =
  describe "filterWhere" $ do
    it "adds a filter clause to count aggregation" $ run $ 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 . fmap) (\(Value a, Value b, Value c) -> (a, b, c)) <$> select $ from $ \users -> do
        groupBy $ users ^. PersonAge
        return
          ( users ^. PersonAge
          -- 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)
          -- 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)
          )

      liftIO $ usersByAge `shouldMatchList`
        ( [ (Nothing, 2, 0)
          , (Just 36, 0, 1)
          , (Just 17, 2, 0)
          ] :: [(Maybe Int, Int, Int)]
        )

    it "adds a filter clause to sum aggregation" $ run $ 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 . fmap) (\(Value a, Value b, Value c) -> (a, b, c)) <$> 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 :: Spec
testCommonTableExpressions = do
  describe "You can run them" $ do
    it "will run" $ do
      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

      True `shouldBe` True

  it "can do multiple recursive queries" $ do
    vals <- run $ 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
                     )

      select $ do
        cte <- oneToTen
        cte2 <- oneToTen
        res1 <- Experimental.from cte
        res2 <- Experimental.from cte2
        pure (res1, res2)
    vals `shouldBe` (((,) <$> fmap Value [1..10] <*> fmap Value [1..10]))

  it "passing previous query works" $
    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
    in do
    vals <- run $ do

      select $ do
        cte <- oneToTen
        cte2 <- oneMore cte
        res <- Experimental.from cte2
        pure res
    vals `shouldBe` fmap Value [2..11]

-- Since lateral queries arent supported in Sqlite or older versions of mysql
-- the test is in the Postgres module
testLateralQuery :: Spec
testLateralQuery = do
  describe "Lateral queries" $ do
    it "supports CROSS JOIN LATERAL" $ do
      _ <- run $ 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)
      True `shouldBe` True

    it "supports INNER JOIN LATERAL" $ do
      run $ 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)]
        pure ()
      True `shouldBe` True

    it "supports LEFT JOIN LATERAL" $ do
      run $ 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))]
        pure ()
      True `shouldBe` True

  {--
    it "compile error on RIGHT JOIN LATERAL" $ do
      run $ do
        res <- select $ do
          l :& c <- Experimental.from $ Table @Lord
                          `RightOuterJoin` (\lord -> do
                                      deed <- Experimental.from $ Table @Deed
                                      where_ $ lord ?. LordId ==. just (deed ^. DeedOwnerId)
                                      pure $ countRows @Int)
                          `Experimental.on` (const $ val True)
          pure (l, c)

        let _ = res :: [(Maybe (Entity Lord), Value Int)]
        pure ()
    it "compile error on FULL OUTER JOIN LATERAL" $ do
      run $ do
        res <- select $ do
          l :& c <- Experimental.from $ Table @Lord
                          `FullOuterJoin` (\lord -> do
                                      deed <- Experimental.from $ Table @Deed
                                      where_ $ lord ?. LordId ==. just (deed ^. DeedOwnerId)
                                      pure $ countRows @Int)
                          `Experimental.on` (const $ val True)
          pure (l, c)

        let _ = res :: [(Maybe (Entity Lord), Value (Maybe Int))]
        pure ()
    --}

type JSONValue = Maybe (JSONB A.Value)

createSaneSQL :: (PersistField a) => SqlExpr (Value a) -> T.Text -> [PersistValue] -> IO ()
createSaneSQL act q vals = run $ do
    (query, args) <- showQuery ES.SELECT $ fromValue act
    liftIO $ query `shouldBe` q
    liftIO $ 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 :: (MonadCatch m, MonadIO m) => ByteString -> SqlPersistT (R.ResourceT m) a -> SqlPersistT (R.ResourceT m) ()
sqlFailWith errState f = do
    p <- (f >> return True) `catch` success
    when p failed
  where success SqlError{sqlState}
          | sqlState == errState = return False
          | otherwise = do
              liftIO $ expectationFailure $ T.unpack $ T.concat
                  [ "should fail with: ", errStateT
                  , ", but received: ", TE.decodeUtf8 sqlState
                  ]
              return False
        failed = liftIO $ expectationFailure $ "should fail with: " `mappend` T.unpack errStateT
        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 ---------------



main :: IO ()
main = do
  hspec $ do
    tests run

    describe "Test PostgreSQL locking" $ do
      testLocking withConn

    describe "PostgreSQL specific tests" $ do
      testAscRandom random_ run
      testRandomMath run
      testSelectDistinctOn
      testPostgresModule
      testPostgresqlOneAscOneDesc
      testPostgresqlTwoAscFields
      testPostgresqlSum
      testPostgresqlRandom
      testPostgresqlUpdate
      testPostgresqlCoalesce
      testPostgresqlTextFunctions
      testInsertUniqueViolation
      testUpsert
      testInsertSelectWithConflict
      testFilterWhere
      testCommonTableExpressions
      describe "PostgreSQL JSON tests" $ do
        -- NOTE: We only clean the table once, so we
        -- can use its contents across all JSON tests
        it "MIGRATE AND CLEAN JSON TABLE" $ run $ do
          void $ runMigrationSilent migrateJSON
          cleanJSON
        testJSONInsertions
        testJSONOperators
      testLateralQuery


run, runSilent, runVerbose :: Run
runSilent  act = runNoLoggingT     $ run_worker act
runVerbose act = runStderrLoggingT $ run_worker act
run f = do
  verbose' <- lookupEnv "VERBOSE" >>= \case
    Nothing -> return verbose
    Just x | map Char.toLower x == "true" -> return True
           | null x -> return True
           | otherwise -> return False
  if verbose'
    then runVerbose f
    else runSilent f

verbose :: Bool
verbose = False

run_worker :: RunDbMonad m => SqlPersistT (R.ResourceT m) a -> m a
run_worker act = withConn $ runSqlConn (migrateIt >> act)

migrateIt :: RunDbMonad m => SqlPersistT (R.ResourceT m) ()
migrateIt = do
  void $ runMigrationSilent migrateAll
  void $ runMigrationSilent migrateUnique
  cleanDB
  cleanUniques

withConn :: RunDbMonad m => (SqlBackend -> R.ResourceT m a) -> m a
withConn =
  R.runResourceT . withPostgresqlConn "host=localhost port=5432 user=esqutest password=esqutest dbname=esqutest"

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