diff --git a/IHP/HaskellSupport.hs b/IHP/HaskellSupport.hs index e1ef76914..c8494c615 100644 --- a/IHP/HaskellSupport.hs +++ b/IHP/HaskellSupport.hs @@ -29,6 +29,7 @@ module IHP.HaskellSupport ( , includes , stripTags , symbolToText +, IsEmpty (..) ) where import ClassyPrelude @@ -51,9 +52,24 @@ infixl 8 |> a |> f = f a {-# INLINE (|>) #-} -isEmpty :: MonoFoldable value => value -> Bool -isEmpty value = null value -{-# INLINE isEmpty #-} +-- | Used by 'nonEmpty' and 'isEmptyValue' to check for emptyness +class IsEmpty value where + -- | Returns True when the value is an empty string, empty list, zero UUID, etc. + isEmpty :: value -> Bool + +instance IsEmpty Text where + isEmpty "" = True + isEmpty _ = False + {-# INLINE isEmpty #-} + +instance IsEmpty (Maybe value) where + isEmpty Nothing = True + isEmpty (Just _) = False + {-# INLINE isEmpty #-} + +instance IsEmpty [a] where + isEmpty [] = True + isEmpty _ = False ifOrEmpty :: (Monoid a) => Bool -> a -> a ifOrEmpty bool a = if bool then a else mempty @@ -62,7 +78,7 @@ ifOrEmpty bool a = if bool then a else mempty whenEmpty condition = when (isEmpty condition) {-# INLINE whenEmpty #-} -whenNonEmpty :: (MonoFoldable a, Applicative f) => a -> f () -> f () +whenNonEmpty :: (IsEmpty a, Applicative f) => a -> f () -> f () whenNonEmpty condition = unless (isEmpty condition) {-# INLINE whenNonEmpty #-} diff --git a/IHP/ModelSupport.hs b/IHP/ModelSupport.hs index 065de6f12..74bae0382 100644 --- a/IHP/ModelSupport.hs +++ b/IHP/ModelSupport.hs @@ -210,6 +210,9 @@ instance InputValue (PrimaryKey model') => InputValue (Id' model') where {-# INLINE inputValue #-} inputValue = inputValue . Newtype.unpack +instance IsEmpty (PrimaryKey table) => IsEmpty (Id' table) where + isEmpty (Id primaryKey) = isEmpty primaryKey + recordToInputValue :: (HasField "id" entity (Id entity), Show (PrimaryKey (GetTableName entity))) => entity -> Text recordToInputValue entity = getField @"id" entity diff --git a/IHP/ValidationSupport/ValidateField.hs b/IHP/ValidationSupport/ValidateField.hs index 5c0c250df..c9b388bd8 100644 --- a/IHP/ValidationSupport/ValidateField.hs +++ b/IHP/ValidationSupport/ValidateField.hs @@ -147,7 +147,6 @@ validateAll validators text = True -> Success False -> (filter isFailure results) !! 0 - -- | Validates that value is not empty -- -- >>> nonEmpty "hello world" @@ -161,8 +160,8 @@ validateAll validators text = -- -- >>> nonEmpty Nothing -- Failure "This field cannot be empty" -nonEmpty :: MonoFoldable value => value -> ValidatorResult -nonEmpty value | null value = Failure "This field cannot be empty" +nonEmpty :: IsEmpty value => value -> ValidatorResult +nonEmpty value | isEmpty value = Failure "This field cannot be empty" nonEmpty _ = Success {-# INLINE nonEmpty #-} @@ -180,8 +179,8 @@ nonEmpty _ = Success -- -- >>> isEmptyValue Nothing -- Success -isEmptyValue :: MonoFoldable value => value -> ValidatorResult -isEmptyValue value | null value = Success +isEmptyValue :: IsEmpty value => value -> ValidatorResult +isEmptyValue value | isEmpty value = Success isEmptyValue _ = Failure "This field must be empty" {-# INLINE isEmptyValue #-}