typson-esqueleto-0.1.0.0: test/Spec.hs

{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

import           Control.Monad (void)
import           Control.Monad.Catch (handleAll)
import qualified Data.ByteString.Char8 as BS
import           Data.List (sort)
import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.PostgreSQL.JSON as E
import qualified Database.Persist.Postgresql as P
import qualified Database.PostgreSQL.Simple as Pg
import qualified Hedgehog.Gen as HH
import qualified Hedgehog.Range as HH
import           System.Environment (lookupEnv)
import           Test.Tasty
import           Test.Tasty.HUnit

import           Typson.Esqueleto
import           Typson.Test.Esqueleto.DbSchema (EsqueletoEntity(..), EntityField(EsqueletoEntityGraph), migrateAll)
import           Typson.Test.Generators
import           Typson.Test.Types

main :: IO ()
main = defaultMain esqueletoTestTree

esqueletoTestTree :: TestTree
esqueletoTestTree = withRunDb $ \runDb ->
  testGroup "Esqueleto Tests"
  [ testCase "JSON Queries" $ do
      graphs <- HH.sample (HH.list (HH.singleton 100) bazGen)
      runDb (insertData graphs)

      r1 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath basicPath1 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a1 = E.Value . NullableJSONB . basicPath1Getter <$> graphs
      assertEqual "Basic Path 1" (sort r1) (sort a1)

      r2 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath basicPath2 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a2 = E.Value . NullableJSONB . basicPath2Getter <$> graphs
      assertEqual "Basic Path 2" (sort r2) (sort a2)

      r3 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath basicPath3 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a3 = E.Value . NullableJSONB . basicPath3Getter <$> graphs
      assertEqual "Basic Path 3" (sort r3) (sort a3)

      r4 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath optionalPath1 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a4 = E.Value . NullableJSONB . optionalPath1Getter <$> graphs
      assertEqual "Optional Path 1" (sort r4) (sort a4)

      r5 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath optionalPath2 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a5 = E.Value . NullableJSONB . optionalPath2Getter <$> graphs
      assertEqual "Optional Path 2" (sort r5) (sort a5)

      r6 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath optionalPath3 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a6 = E.Value . NullableJSONB . optionalPath3Getter <$> graphs
      assertEqual "Optional Path 3" (sort r6) (sort a6)

      r7 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath listIdxPath1 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a7 = E.Value . NullableJSONB . listIdxPath1Getter <$> graphs
      assertEqual "List Idx Path 1" (sort r7) (sort a7)

      r8 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath listIdxPath2 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a8 = E.Value . NullableJSONB . listIdxPath2Getter <$> graphs
      assertEqual "List Idx Path 2" (sort r8) (sort a8)

      r9 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath listIdxPath3 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a9 = E.Value . NullableJSONB . listIdxPath3Getter <$> graphs
      assertEqual "List Idx Path 3" (sort r9) (sort a9)

      r10 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath unionPath1 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a10 = E.Value . NullableJSONB . unionPath1Getter <$> graphs
      assertEqual "Union Path 1" (sort r10) (sort a10)

      r11 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath unionPath2 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a11 = E.Value . NullableJSONB . unionPath2Getter <$> graphs
      assertEqual "Union Path 2" (sort r11) (sort a11)

      r12 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath textMapPath1 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a12 = E.Value . NullableJSONB . textMapPath1Getter <$> graphs
      assertEqual "Text Map Path 1" (sort r12) (sort a12)

      r13 <- runDb . E.select . E.from $ \entity ->
              pure . jsonPath textMapPath2 bazJ
                $ entity E.^. EsqueletoEntityGraph
      let a13 = E.Value . NullableJSONB . textMapPath2Getter <$> graphs
      assertEqual "Text Map Path 2" (sort r13) (sort a13)
  ]

type DbRunner = forall b. P.SqlPersistT IO b -> IO b

withRunDb :: (DbRunner -> TestTree) -> TestTree
withRunDb mkTree = withDb $ \ioBackend -> mkTree $ \action -> do
  backend <- ioBackend
  P.runSqlConn action backend

withDb :: (IO P.SqlBackend -> TestTree) -> TestTree
withDb = withResource connectToDb P.connClose

connectToDb :: IO P.SqlBackend
connectToDb = do
  Just connString <- lookupEnv "CONN_STRING"
  conn <- Pg.connectPostgreSQL $ BS.pack connString
  backend <- P.openSimpleConn (\_ _ _ _ -> pure ()) conn

  -- reset the table
  _ <- handleAll (const $ pure 0) $ Pg.execute_ conn "DROP TABLE \"esqueleto_entity\""

  P.runSqlConn (P.runMigration migrateAll) backend

  pure backend

insertData :: [Baz] -> P.SqlPersistT IO ()
insertData graphs =
  void $ P.insertMany (EsqueletoEntity . E.JSONB <$> graphs)