module IHP.ValidationSupport.ValidateIsUnique
( validateIsUnique
, validateIsUniqueCaseInsensitive
, withCustomErrorMessageIO
) where

import IHP.Prelude
import Database.PostgreSQL.Simple.ToField
import IHP.ModelSupport
import IHP.ValidationSupport.Types
import IHP.QueryBuilder
import IHP.Fetch

-- | Validates that e.g. an email (or another field) is unique across all users before inserting.
--
-- This validator reads the given field name (e.g. email) from the record, and runs a database query
-- to check that there is no other record using the same field value (e.g. email value).
--
-- __Example:__ Validate that an email is unique
--
-- > action CreateUserAction = do
-- >     let user = newRecord @User
-- >     user
-- >         |> fill @'["email"]
-- >         |> validateIsUnique #email
-- >         >>= ifValid \case
-- >             Left user -> render NewView { .. }
-- >             Right user -> do
-- >                 createRecord user
-- >                 redirectTo UsersAction
validateIsUnique :: forall field model savedModel fieldValue modelId savedModelId. (
        savedModel ~ NormalizeModel model
        , ?modelContext :: ModelContext
        , FromRow savedModel
        , KnownSymbol field
        , HasField field model fieldValue
        , HasField field savedModel fieldValue
        , KnownSymbol (GetTableName savedModel)
        , ToField fieldValue
        , EqOrIsOperator fieldValue
        , HasField "meta" model MetaBag
        , SetField "meta" model MetaBag
        , HasField "id" savedModel savedModelId
        , HasField "id" model modelId
        , savedModelId ~ modelId
        , Eq modelId
        , GetModelByTableName (GetTableName savedModel) ~ savedModel
        , Table savedModel
    ) => Proxy field -> model -> IO model
validateIsUnique fieldProxy model = validateIsUniqueCaseAware fieldProxy model True
{-# INLINE validateIsUnique #-}


-- | Case insensitive version of 'validateIsUnique'.
--
-- Uses a comparison like @LOWER(field) = LOWER(value)@ internally, so it's best to have an index for @LOWER(field)@ in your Schema.sql
--
-- >>> CREATE UNIQUE INDEX users_email_index ON users ((LOWER(email)));
--
-- __Example:__ Validate that an email is unique, ignoring case
--
-- > action CreateUserAction = do
-- >     let user = newRecord @User
-- >     user
-- >         |> fill @'["email"]
-- >         |> validateIsUniqueCaseInsensitive #email
-- >         >>= ifValid \case
-- >             Left user -> render NewView { .. }
-- >             Right user -> do
-- >                 createRecord user
-- >                 redirectTo UsersAction
validateIsUniqueCaseInsensitive :: forall field model savedModel fieldValue modelId savedModelId. (
        savedModel ~ NormalizeModel model
        , ?modelContext :: ModelContext
        , FromRow savedModel
        , KnownSymbol field
        , HasField field model fieldValue
        , HasField field savedModel fieldValue
        , KnownSymbol (GetTableName savedModel)
        , ToField fieldValue
        , EqOrIsOperator fieldValue
        , HasField "meta" model MetaBag
        , SetField "meta" model MetaBag
        , HasField "id" savedModel savedModelId
        , HasField "id" model modelId
        , savedModelId ~ modelId
        , Eq modelId
        , GetModelByTableName (GetTableName savedModel) ~ savedModel
        , Table savedModel
    ) => Proxy field -> model -> IO model
validateIsUniqueCaseInsensitive fieldProxy model = validateIsUniqueCaseAware fieldProxy model False
{-# INLINE validateIsUniqueCaseInsensitive #-}

-- | Internal helper for 'validateIsUnique' and 'validateIsUniqueCaseInsensitive'
validateIsUniqueCaseAware :: forall field model savedModel fieldValue modelId savedModelId. (
        savedModel ~ NormalizeModel model
        , ?modelContext :: ModelContext
        , FromRow savedModel
        , KnownSymbol field
        , HasField field model fieldValue
        , HasField field savedModel fieldValue
        , KnownSymbol (GetTableName savedModel)
        , ToField fieldValue
        , EqOrIsOperator fieldValue
        , HasField "meta" model MetaBag
        , SetField "meta" model MetaBag
        , HasField "id" savedModel savedModelId
        , HasField "id" model modelId
        , savedModelId ~ modelId
        , Eq modelId
        , GetModelByTableName (GetTableName savedModel) ~ savedModel
        , Table savedModel
    ) => Proxy field -> model -> Bool -> IO model
validateIsUniqueCaseAware fieldProxy model caseSensitive = do
    let value = getField @field model
    result <- query @savedModel
        |> (if caseSensitive
                then filterWhere (fieldProxy, value)
                else filterWhereCaseInsensitive (fieldProxy, value)
            )
        |> fetchOneOrNothing
    case result of
        Just value | not $ model.id == value.id -> pure (attachValidatorResult fieldProxy (Failure "This is already in use") model)
        _ -> pure (attachValidatorResult fieldProxy Success model)
{-# INLINE validateIsUniqueCaseAware #-}

-- | Overrides the error message of a given IO validator function.
--
-- __Example:__ Validate that an email is unique with a custom error message
--
-- > action CreateUserAction = do
-- >     let user = newRecord @User
-- >     user
-- >         |> fill @'["email"]
-- >         |> withCustomErrorMessageIO "Email Has Already Been Used" validateIsUnique #email
-- >         >>= ifValid \case
-- >             Left user -> render NewView { .. }
-- >             Right user -> do
-- >                 createRecord user
-- >                 redirectTo UsersAction
withCustomErrorMessageIO :: forall field model savedModel fieldValue modelId savedModelId. (
        savedModel ~ NormalizeModel model
        , ?modelContext :: ModelContext
        , FromRow savedModel
        , KnownSymbol field
        , HasField field model fieldValue
        , HasField field savedModel fieldValue
        , KnownSymbol (GetTableName savedModel)
        , ToField fieldValue
        , EqOrIsOperator fieldValue
        , HasField "meta" model MetaBag
        , SetField "meta" model MetaBag
        , HasField "id" savedModel savedModelId
        , HasField "id" model modelId
        , savedModelId ~ modelId
        , Eq modelId
        , GetModelByTableName (GetTableName savedModel) ~ savedModel
    ) => Text -> (Proxy field -> model -> IO model) -> Proxy field -> model -> IO model
withCustomErrorMessageIO message validator field model = do
    validator field model >>= (\model ->
                                let maybeFailure = getValidationFailure field model
                                in case maybeFailure of
                                    Just _ -> pure $ attachFailure field message model
                                    Nothing -> pure model)
{-# INLINABLE withCustomErrorMessageIO #-}