TestSchema.hs

module Test.Expr.TestSchema
  ( FooBar (..)
  , mkFooBar
  , findAllFooBars
  , findAllFooBarsInTable
  , 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.List.NonEmpty as NE
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.QualifiedOrUnqualified Expr.TableName
fooBarTable =
  Expr.unqualified (Expr.tableName "foobar")

fooColumn :: Expr.QualifiedOrUnqualified Expr.ColumnName
fooColumn =
  Expr.unqualified $ Expr.columnName "foo"

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

barColumn :: Expr.QualifiedOrUnqualified Expr.ColumnName
barColumn =
  Expr.unqualified $ Expr.columnName "bar"

barColumnAliased :: Expr.Qualified Expr.ColumnName
barColumnAliased =
  Expr.aliasQualifyColumn (Expr.stringToAliasExpr "b") $ 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 =
  findAllFooBarsInTable fooBarTable

findAllFooBarsInTable :: Expr.QualifiedOrUnqualified Expr.TableName -> Expr.QueryExpr
findAllFooBarsInTable tableName =
  let
    tableRefList =
      Expr.tableReferenceList
        [ Expr.tableNameReference tableName (Just (Expr.stringToAliasExpr "b"))
        ]
  in
    Expr.queryExpr
      (Expr.selectClause $ Expr.selectExpr Nothing)
      (Expr.selectColumns [fooColumn, Expr.untrackQualified barColumnAliased])
      (Just $ Expr.tableExpr tableRefList Nothing Nothing (Just orderByFoo) Nothing Nothing Nothing 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 :: NE.NonEmpty FooBar -> Expr.InsertSource
insertFooBarSource fooBars =
  let
    mkRow fooBar =
      NE.fromList
        [ Expr.valueExpression $ nullOr SqlValue.fromInt32 (foo fooBar)
        , Expr.valueExpression $ nullOr SqlValue.fromText (T.pack <$> bar fooBar)
        ]
  in
    Expr.valuesExprInsertSource
      . Expr.valuesExprFromValueExpressions
      $ fmap mkRow fooBars

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

withFooBarData ::
  Orville.ConnectionPool ->
  NE.NonEmpty 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 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)))