EntityOperations.hs

module Test.EntityOperations
  ( entityOperationsTests
  )
where

import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty ((:|)))
import qualified Data.List.NonEmpty as NEL
import qualified Data.Maybe as Maybe
import qualified Data.String as String
import qualified Data.Text as T
import Hedgehog ((===))
import qualified Hedgehog as HH
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

import qualified Orville.PostgreSQL as Orville

import qualified Test.Entities.CompositeKeyEntity as CompositeKeyEntity
import qualified Test.Entities.Foo as Foo
import qualified Test.Property as Property

entityOperationsTests :: Orville.ConnectionPool -> Property.Group
entityOperationsTests pool =
  Property.group "EntityOperations" $
    [ prop_insertEntitiesFindEntitiesByRoundTrip pool
    , prop_insertEntitiesAffectedRows pool
    , prop_insertEntitiesFindFirstEntityByRoundTrip pool
    , prop_insertEntityFindEntityRoundTrip pool
    , prop_insertEntityFindEntitiesRoundTrip pool
    , prop_insertEntityFindEntitiesCompositeKeyRoundTrip pool
    , prop_insertAndReturnEntity pool
    , prop_updateEntity pool
    , prop_updateEntityAffectedRows pool
    , prop_updateAndReturnEntity pool
    , prop_updateEntity_NoMatch pool
    , prop_updateAndReturnEntity_NoMatch pool
    , prop_deleteEntity pool
    , prop_deleteEntityAffectedRows pool
    , prop_deleteAndReturnEntity pool
    , prop_deleteEntity_NoMatch pool
    , prop_deleteAndReturnEntity_NoMatch pool
    , prop_deleteEntities pool
    , prop_deleteEntitiesAffectedRows pool
    , prop_deleteEntities_NoMatch pool
    , prop_deleteAndReturnEntities pool
    , prop_deleteAndReturnEntities_NoMatch pool
    , prop_updateFields pool
    , prop_updateFields_NoMatch pool
    , prop_updateFieldsAffectedRows pool
    , prop_updateFieldsAndReturnEntities pool
    , prop_updateFieldsAndReturnEntities_NoMatch pool
    ]

prop_insertEntitiesFindEntitiesByRoundTrip :: Property.NamedDBProperty
prop_insertEntitiesFindEntitiesByRoundTrip =
  Property.singletonNamedDBProperty "insertEntity/findEntitiesBy forms a round trip" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate

    retrievedFoos <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.findEntitiesBy Foo.table mempty

    retrievedFoos === [originalFoo]

prop_insertEntitiesFindFirstEntityByRoundTrip :: Property.NamedDBProperty
prop_insertEntitiesFindFirstEntityByRoundTrip =
  Property.namedDBProperty "insertEntities/findFirstEntityBy only return 1" $ \pool -> do
    originalFoos <- HH.forAll $ Foo.generateList (Range.linear 0 10)

    HH.cover 1 (String.fromString "empty list") (null originalFoos)
    HH.cover 20 (String.fromString "non-empty list") (not (null originalFoos))

    mbRetrievedFoo <-
      Foo.withTable pool $ do
        mapM_ (Orville.insertEntities Foo.table) (NEL.nonEmpty originalFoos)
        Orville.findFirstEntityBy Foo.table mempty

    let
      expectedLength =
        case originalFoos of
          [] -> 0
          _ -> 1

    -- Once we add order by to 'SelectOptions' we can order by something here
    -- and assert which item is returned.
    length (Maybe.maybeToList mbRetrievedFoo) === expectedLength

prop_insertEntitiesAffectedRows :: Property.NamedDBProperty
prop_insertEntitiesAffectedRows =
  Property.namedDBProperty "insertEntities returns the number of affected rows" $ \pool -> do
    originalFoos <- HH.forAll $ Foo.generateList (Range.linear 0 10)

    HH.cover 1 (String.fromString "empty list") (null originalFoos)
    HH.cover 20 (String.fromString "non-empty list") (not (null originalFoos))

    affectedRows <-
      Foo.withTable pool $ do
        case NEL.nonEmpty originalFoos of
          Nothing -> pure 0
          Just nonEmptyFoos -> Orville.insertEntitiesAndReturnRowCount Foo.table nonEmptyFoos

    affectedRows === length originalFoos

prop_insertEntityFindEntityRoundTrip :: Property.NamedDBProperty
prop_insertEntityFindEntityRoundTrip =
  Property.singletonNamedDBProperty "insertEntity/findEntity forms a round trip" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate

    mbRetrievedFoo <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.findEntity Foo.table (Foo.fooId originalFoo)

    mbRetrievedFoo === Just originalFoo

prop_insertEntityFindEntitiesRoundTrip :: Property.NamedDBProperty
prop_insertEntityFindEntitiesRoundTrip =
  Property.singletonNamedDBProperty "insertEntity/findEntities form a round trip" $ \pool -> do
    foos <- HH.forAll $ Foo.generateNonEmpty (Range.linear 1 5)

    retrievedFoos <-
      Foo.withTable pool $ do
        Orville.insertEntities Foo.table foos
        Orville.findEntities Foo.table (Foo.fooId <$> foos)

    List.sortOn Foo.fooId retrievedFoos === List.sortOn Foo.fooId (NEL.toList foos)

prop_insertEntityFindEntitiesCompositeKeyRoundTrip :: Property.NamedDBProperty
prop_insertEntityFindEntitiesCompositeKeyRoundTrip =
  Property.singletonNamedDBProperty "insertEntity/findEntities form a round trip (composite primary key)" $ \pool -> do
    compositeKeyEntities <- HH.forAll $ CompositeKeyEntity.generateNonEmpty (Range.linear 1 5)

    retrievedCompositeKeyEntities <-
      CompositeKeyEntity.withTable pool $ do
        Orville.insertEntities CompositeKeyEntity.table compositeKeyEntities
        Orville.findEntities CompositeKeyEntity.table (CompositeKeyEntity.compositeKey <$> compositeKeyEntities)

    List.sortOn CompositeKeyEntity.compositeKey retrievedCompositeKeyEntities === List.sortOn CompositeKeyEntity.compositeKey (NEL.toList compositeKeyEntities)

prop_insertAndReturnEntity :: Property.NamedDBProperty
prop_insertAndReturnEntity =
  Property.singletonNamedDBProperty "insertAndReturnEntity returns the inserted entity" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate

    retrievedFoo <-
      Foo.withTable pool $ do
        Orville.insertAndReturnEntity Foo.table originalFoo

    retrievedFoo === originalFoo

prop_updateEntity :: Property.NamedDBProperty
prop_updateEntity =
  Property.singletonNamedDBProperty "updateEntity updates row at the given key" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate
    newFoo <- HH.forAll Foo.generate

    returnedFoo <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.updateEntity Foo.table (Foo.fooId originalFoo) newFoo
        Orville.findEntitiesBy Foo.table mempty

    returnedFoo === [newFoo]

prop_updateEntityAffectedRows :: Property.NamedDBProperty
prop_updateEntityAffectedRows =
  Property.singletonNamedDBProperty "updateEntity returns the number of affected rows" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate
    newFoo <- HH.forAll Foo.generate

    affectedRows <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.updateEntityAndReturnRowCount Foo.table (Foo.fooId originalFoo) newFoo

    affectedRows === 1

prop_updateAndReturnEntity :: Property.NamedDBProperty
prop_updateAndReturnEntity =
  Property.singletonNamedDBProperty "updateAndReturnEntity returns the updated entity" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate
    newFoo <- HH.forAll Foo.generate

    mbReturnedFoo <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.updateAndReturnEntity Foo.table (Foo.fooId originalFoo) newFoo

    mbReturnedFoo === Just newFoo

prop_updateEntity_NoMatch :: Property.NamedDBProperty
prop_updateEntity_NoMatch =
  Property.singletonNamedDBProperty "updateEntity updates no rows when key does not match" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate
    newFoo <- HH.forAll Foo.generate

    let
      mismatchFooId =
        1 + Foo.fooId originalFoo

    retrievedFoos <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.updateEntity Foo.table mismatchFooId newFoo
        Orville.findEntitiesBy Foo.table mempty

    retrievedFoos === [originalFoo]

prop_updateAndReturnEntity_NoMatch :: Property.NamedDBProperty
prop_updateAndReturnEntity_NoMatch =
  Property.singletonNamedDBProperty "updateAndReturnEntity returns Nothing when key does not match" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate
    newFoo <- HH.forAll Foo.generate

    let
      mismatchFooId =
        1 + Foo.fooId originalFoo

    mbReturnedFoo <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.updateAndReturnEntity Foo.table mismatchFooId newFoo

    mbReturnedFoo === Nothing

prop_deleteEntity :: Property.NamedDBProperty
prop_deleteEntity =
  Property.singletonNamedDBProperty "deleteEntity deletes row at the given key" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate
    let
      withDifferentKey = Gen.filter $ (Foo.fooId originalFoo /=) . Foo.fooId
    anotherFoo <- HH.forAll . withDifferentKey $ Foo.generate

    retrievedFoos <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.insertEntity Foo.table anotherFoo
        Orville.deleteEntity Foo.table (Foo.fooId originalFoo)
        Orville.findEntitiesBy Foo.table mempty

    retrievedFoos === [anotherFoo]

prop_deleteEntityAffectedRows :: Property.NamedDBProperty
prop_deleteEntityAffectedRows =
  Property.singletonNamedDBProperty "deleteEntity returns the number of affected rows" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate
    let
      withDifferentKey = Gen.filter $ (Foo.fooId originalFoo /=) . Foo.fooId
    anotherFoo <- HH.forAll . withDifferentKey $ Foo.generate

    affectedRows <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.insertEntity Foo.table anotherFoo
        Orville.deleteEntityAndReturnRowCount Foo.table (Foo.fooId originalFoo)

    affectedRows === 1

prop_deleteAndReturnEntity :: Property.NamedDBProperty
prop_deleteAndReturnEntity =
  Property.singletonNamedDBProperty "deleteAndReturnEntity returns the deleted row" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate
    mbReturnedFoo <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.deleteAndReturnEntity Foo.table (Foo.fooId originalFoo)

    mbReturnedFoo === Just originalFoo

prop_deleteEntity_NoMatch :: Property.NamedDBProperty
prop_deleteEntity_NoMatch =
  Property.singletonNamedDBProperty "deleteEntity deletes no rows when key doesn't match" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate

    let
      mismatchFooId =
        1 + Foo.fooId originalFoo

    retrievedFoos <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.deleteEntity Foo.table mismatchFooId
        Orville.findEntitiesBy Foo.table mempty

    retrievedFoos === [originalFoo]

prop_deleteAndReturnEntity_NoMatch :: Property.NamedDBProperty
prop_deleteAndReturnEntity_NoMatch =
  Property.singletonNamedDBProperty "deleteAndReturnEntity returns Nothing when key doesn't match" $ \pool -> do
    originalFoo <- HH.forAll Foo.generate

    let
      mismatchFooId =
        1 + Foo.fooId originalFoo

    mbReturnedFoo <-
      Foo.withTable pool $ do
        Orville.insertEntity Foo.table originalFoo
        Orville.deleteAndReturnEntity Foo.table mismatchFooId

    mbReturnedFoo === Nothing

prop_deleteEntities :: Property.NamedDBProperty
prop_deleteEntities =
  Property.singletonNamedDBProperty "deleteEntities deletes all matching rows" $ \pool -> do
    foos <- HH.forAll $ Foo.generateNonEmpty (Range.linear 1 5)

    let
      fooIds = fmap Foo.fooId foos

    remainingFoos <-
      Foo.withTable pool $ do
        Orville.insertEntities Foo.table foos
        Orville.deleteEntities
          Foo.table
          (Just (Orville.fieldIn Foo.fooIdField fooIds))
        Orville.findEntitiesBy
          Foo.table
          (Orville.where_ (Orville.fieldIn Foo.fooIdField fooIds))

    fmap Foo.fooId remainingFoos === []

prop_deleteEntitiesAffectedRows :: Property.NamedDBProperty
prop_deleteEntitiesAffectedRows =
  Property.singletonNamedDBProperty "deleteEntities returns the number of affected rows" $ \pool -> do
    foos <- HH.forAll $ Foo.generateNonEmpty (Range.linear 1 5)

    let
      fooIds = fmap Foo.fooId foos

    affectedRows <-
      Foo.withTable pool $ do
        Orville.insertEntities Foo.table foos
        Orville.deleteEntitiesAndReturnRowCount
          Foo.table
          (Just (Orville.fieldIn Foo.fooIdField fooIds))

    affectedRows === length foos

prop_deleteEntities_NoMatch :: Property.NamedDBProperty
prop_deleteEntities_NoMatch =
  Property.singletonNamedDBProperty "deleteEntities does not delete non matching rows" $ \pool -> do
    foos <- HH.forAll $ Foo.generateNonEmpty (Range.linear 1 5)

    let
      fooIds = fmap Foo.fooId foos
      mismatchedId = maximum fooIds + 1

    remainingFoos <-
      Foo.withTable pool $ do
        Orville.insertEntities Foo.table foos
        Orville.deleteEntities
          Foo.table
          (Just (Orville.fieldEquals Foo.fooIdField mismatchedId))
        Orville.findEntitiesBy
          Foo.table
          (Orville.where_ (Orville.fieldIn Foo.fooIdField fooIds))

    fmap Foo.fooId remainingFoos === NEL.toList fooIds

prop_deleteAndReturnEntities :: Property.NamedDBProperty
prop_deleteAndReturnEntities =
  Property.singletonNamedDBProperty "deleteAndReturnEntities deletes all matching rows" $ \pool -> do
    foos <- HH.forAll $ Foo.generateNonEmpty (Range.linear 1 5)

    let
      fooIds = fmap Foo.fooId foos

    deletedFoos <-
      Foo.withTable pool $ do
        Orville.insertEntities Foo.table foos
        Orville.deleteAndReturnEntities
          Foo.table
          (Just (Orville.fieldIn Foo.fooIdField fooIds))

    fmap Foo.fooId deletedFoos === NEL.toList fooIds

prop_deleteAndReturnEntities_NoMatch :: Property.NamedDBProperty
prop_deleteAndReturnEntities_NoMatch =
  Property.singletonNamedDBProperty "deleteAndReturnEntities does not delete non matching rows" $ \pool -> do
    foos <- HH.forAll $ Foo.generateNonEmpty (Range.linear 1 5)

    let
      fooIds = fmap Foo.fooId foos
      mismatchedId = maximum fooIds + 1

    deletedFoos <-
      Foo.withTable pool $ do
        Orville.insertEntities Foo.table foos
        Orville.deleteAndReturnEntities
          Foo.table
          (Just (Orville.fieldEquals Foo.fooIdField mismatchedId))

    fmap Foo.fooId deletedFoos === []

prop_updateFields :: Property.NamedDBProperty
prop_updateFields =
  Property.singletonNamedDBProperty "updateFields updates all matching rows" $ \pool -> do
    foos <- HH.forAll $ Foo.generateNonEmpty (Range.linear 1 5)

    let
      fooIds = fmap Foo.fooId foos
      updatedName = T.pack "Updated"

    updatedFoos <-
      Foo.withTable pool $ do
        Orville.insertEntities Foo.table foos
        Orville.updateFields
          Foo.table
          (Orville.setField Foo.fooNameField updatedName :| [])
          (Just (Orville.fieldIn Foo.fooIdField fooIds))
        Orville.findEntitiesBy
          Foo.table
          (Orville.where_ (Orville.fieldIn Foo.fooIdField fooIds))

    fmap Foo.fooName updatedFoos === fmap (const updatedName) (NEL.toList foos)

prop_updateFields_NoMatch :: Property.NamedDBProperty
prop_updateFields_NoMatch =
  Property.singletonNamedDBProperty "updateFields updates no non-matching rows" $ \pool -> do
    foos <- HH.forAll $ Foo.generateNonEmpty (Range.linear 1 5)

    let
      fooIds = fmap Foo.fooId foos
      updatedName = T.pack "Updated"
      mismatchedId = maximum fooIds + 1

    foosAfterUpdate <-
      Foo.withTable pool $ do
        Orville.insertEntities Foo.table foos
        Orville.updateFields
          Foo.table
          (Orville.setField Foo.fooNameField updatedName :| [])
          (Just (Orville.fieldEquals Foo.fooIdField mismatchedId))
        Orville.findEntitiesBy Foo.table mempty

    List.sortOn Foo.fooId foosAfterUpdate === List.sortOn Foo.fooId (NEL.toList foos)

prop_updateFieldsAffectedRows :: Property.NamedDBProperty
prop_updateFieldsAffectedRows =
  Property.singletonNamedDBProperty "updateFields returns the number of affeted rows" $ \pool -> do
    foos <- HH.forAll $ Foo.generateNonEmpty (Range.linear 1 5)

    let
      fooIds = fmap Foo.fooId foos
      updatedName = T.pack "Updated"

    affectedRows <-
      Foo.withTable pool $ do
        Orville.insertEntities Foo.table foos
        Orville.updateFieldsAndReturnRowCount
          Foo.table
          (Orville.setField Foo.fooNameField updatedName :| [])
          (Just (Orville.fieldIn Foo.fooIdField fooIds))

    affectedRows === length foos

prop_updateFieldsAndReturnEntities :: Property.NamedDBProperty
prop_updateFieldsAndReturnEntities =
  Property.singletonNamedDBProperty "updateFieldsAndReturnEntities returns updated rows" $ \pool -> do
    foos <- HH.forAll $ Foo.generateNonEmpty (Range.linear 1 5)

    let
      fooIds = fmap Foo.fooId foos
      updatedName = T.pack "Updated"

    updatedFoos <-
      Foo.withTable pool $ do
        Orville.insertEntities Foo.table foos
        Orville.updateFieldsAndReturnEntities
          Foo.table
          (Orville.setField Foo.fooNameField updatedName :| [])
          (Just (Orville.fieldIn Foo.fooIdField fooIds))

    fmap Foo.fooName updatedFoos === fmap (const updatedName) (NEL.toList foos)

prop_updateFieldsAndReturnEntities_NoMatch :: Property.NamedDBProperty
prop_updateFieldsAndReturnEntities_NoMatch =
  Property.singletonNamedDBProperty "updateFieldsAndReturnEntities returns no non-matching rows" $ \pool -> do
    foos <- HH.forAll $ Foo.generateNonEmpty (Range.linear 1 5)

    let
      fooIds = fmap Foo.fooId foos
      updatedName = T.pack "Updated"
      mismatchedId = maximum fooIds + 1

    updatedFoos <-
      Foo.withTable pool $ do
        Orville.insertEntities Foo.table foos
        Orville.updateFieldsAndReturnEntities
          Foo.table
          (Orville.setField Foo.fooNameField updatedName :| [])
          (Just (Orville.fieldEquals Foo.fooIdField mismatchedId))

    updatedFoos === []