TestSchema.hs

module Test.Expr.TestSchema
  ( FooBar (..)
  , mkFooBar
  , findAllFooBars
  , fooBarTable
  , fooColumn
  , fooColumnRef
  , barColumn
  , barColumnRef
  , encodeFooBar
  , orderByFoo
  , insertFooBarSource
  , withFooBarData
  , dropAndRecreateTestTable
  , assertEqualFooBarRows
  , assertEqualSqlRows
  , sqlRowsToText
  )
where

import qualified Control.Monad.IO.Class as MIO
import qualified Data.ByteString.Char8 as B8
import qualified Data.Int as Int
import qualified Data.Text as T
import GHC.Stack (HasCallStack, withFrozenCallStack)
import Hedgehog ((===))
import qualified Hedgehog as HH

import qualified Orville.PostgreSQL as Orville
import qualified Orville.PostgreSQL.Expr as Expr
import qualified Orville.PostgreSQL.Raw.Connection as Conn
import qualified Orville.PostgreSQL.Raw.RawSql as RawSql
import qualified Orville.PostgreSQL.Raw.SqlValue as SqlValue

data FooBar = FooBar
  { foo :: Maybe Int.Int32
  , bar :: Maybe String
  }

-- Smart constructor for the common case when both fields are not null
mkFooBar :: Int.Int32 -> String -> FooBar
mkFooBar f b = FooBar (Just f) (Just b)

fooBarTable :: Expr.Qualified Expr.TableName
fooBarTable =
  Expr.qualifyTable Nothing (Expr.tableName "foobar")

fooColumn :: Expr.ColumnName
fooColumn =
  Expr.columnName "foo"

fooColumnRef :: Expr.ValueExpression
fooColumnRef =
  Expr.columnReference fooColumn

barColumn :: Expr.ColumnName
barColumn =
  Expr.columnName "bar"

barColumnRef :: Expr.ValueExpression
barColumnRef =
  Expr.columnReference barColumn

orderByFoo :: Expr.OrderByClause
orderByFoo =
  Expr.orderByClause $
    Expr.orderByColumnName fooColumn Expr.ascendingOrder

findAllFooBars :: Expr.QueryExpr
findAllFooBars =
  Expr.queryExpr
    (Expr.selectClause $ Expr.selectExpr Nothing)
    (Expr.selectColumns [fooColumn, barColumn])
    (Just $ Expr.tableExpr (Expr.referencesTable fooBarTable) Nothing Nothing (Just orderByFoo) Nothing Nothing)

encodeFooBar :: FooBar -> [(Maybe B8.ByteString, SqlValue.SqlValue)]
encodeFooBar fooBar =
  [ (Just (B8.pack "foo"), nullOr SqlValue.fromInt32 (foo fooBar))
  , (Just (B8.pack "bar"), nullOr SqlValue.fromText (T.pack <$> bar fooBar))
  ]

insertFooBarSource :: [FooBar] -> Expr.InsertSource
insertFooBarSource fooBars =
  let
    mkRow fooBar =
      [ nullOr SqlValue.fromInt32 (foo fooBar)
      , nullOr SqlValue.fromText (T.pack <$> bar fooBar)
      ]
  in
    Expr.insertSqlValues (map mkRow fooBars)

nullOr :: (a -> SqlValue.SqlValue) -> Maybe a -> SqlValue.SqlValue
nullOr = maybe SqlValue.sqlNull

withFooBarData ::
  Orville.ConnectionPool ->
  [FooBar] ->
  (Orville.Connection -> IO a) ->
  HH.PropertyT IO a
withFooBarData pool fooBars action =
  MIO.liftIO $
    Conn.withPoolConnection pool $ \connection -> do
      dropAndRecreateTestTable connection

      RawSql.executeVoid connection $
        Expr.insertExpr fooBarTable Nothing (insertFooBarSource fooBars) Nothing

      action connection

dropAndRecreateTestTable :: Orville.Connection -> IO ()
dropAndRecreateTestTable connection = do
  RawSql.executeVoid connection (RawSql.fromString "DROP TABLE IF EXISTS " <> RawSql.toRawSql fooBarTable)
  RawSql.executeVoid connection (RawSql.fromString "CREATE TABLE " <> RawSql.toRawSql fooBarTable <> RawSql.fromString "(foo INTEGER, bar TEXT)")

assertEqualFooBarRows ::
  (HH.MonadTest m, HasCallStack) =>
  [[(Maybe B8.ByteString, SqlValue.SqlValue)]] ->
  [FooBar] ->
  m ()
assertEqualFooBarRows rows fooBars =
  withFrozenCallStack $
    assertEqualSqlRows rows (map encodeFooBar fooBars)

-- SqlValue doesn't have Show or Eq, so use this to compare them in tests
assertEqualSqlRows ::
  (Show a, Eq a, HH.MonadTest m, HasCallStack) =>
  [[(a, SqlValue.SqlValue)]] ->
  [[(a, SqlValue.SqlValue)]] ->
  m ()
assertEqualSqlRows l r =
  withFrozenCallStack $
    sqlRowsToText l === sqlRowsToText r

sqlRowsToText :: [[(a, SqlValue.SqlValue)]] -> [[(a, Either String T.Text)]]
sqlRowsToText = fmap (fmap (\(a, b) -> (a, SqlValue.toText b)))