Support nonEmpty validation also for Id fields

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 #-}
 

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

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 #-}