didChange should not return True when the value is the same as the da…

…tabase value

IHP/ModelSupport.hs

@@ -48,6 +48,7 @@ import IHP.Postgres.Inet
 import qualified Data.ByteString.Char8 as ByteString
 import IHP.Log.Types
 import qualified IHP.Log as Log
+import Data.Dynamic
 
 -- | Provides the db connection and some IHP-specific db configuration
 data ModelContext = ModelContext
@@ -486,13 +487,18 @@ ids :: (HasField "id" record id) => [record] -> [id]
 ids records = map (getField @"id") records
 {-# INLINE ids #-}
 
+-- | Every IHP database record has a magic @meta@ field which keeps a @MetaBag@ inside. This data structure is used e.g. to keep track of the validation errors that happend.
 data MetaBag = MetaBag
-  { annotations :: [(Text, Text)]
-  , touchedFields :: [Text]
-  } deriving (Eq, Show)
+    { annotations            :: ![(Text, Text)] -- ^ Stores validation failures, as a list of (field name, error) pairs. E.g. @annotations = [ ("name", "cannot be empty") ]@
+    , touchedFields          :: ![Text] -- ^ Whenever a 'set' is callled on a field, it will be marked as touched. Only touched fields are saved to the database when you call 'updateRecord'
+    , originalDatabaseRecord :: Maybe Dynamic -- ^ When the record has been fetched from the database, we save the initial database record here. This is used by 'didChange' to check if a field value is different from the initial database value.
+    } deriving (Show)
+
+instance Eq MetaBag where
+    MetaBag { annotations, touchedFields } == MetaBag { annotations = annotations', touchedFields = touchedFields' } = annotations == annotations' && touchedFields == touchedFields'
 
 instance Default MetaBag where
-    def = MetaBag { annotations = [], touchedFields = [] }
+    def = MetaBag { annotations = [], touchedFields = [], originalDatabaseRecord = Nothing }
     {-# INLINE def #-}
 
 instance SetField "annotations" MetaBag [(Text, Text)] where
@@ -544,12 +550,31 @@ didChangeRecord record =
 -- __Example:__ Setting a flash message after updating the profile picture
 --
 -- > when (user |> didChange #profilePictureUrl) (setSuccessMessage "Your Profile Picture has been updated. It might take a few minutes until it shows up everywhere")
-didChange :: (KnownSymbol fieldName, HasField fieldName record fieldValue, HasField "meta" record MetaBag) => Proxy fieldName -> record -> Bool
-didChange field record =
-    record
-    |> get #meta
-    |> get #touchedFields
-    |> includes (cs $! symbolVal field)
+didChange :: forall fieldName fieldValue record. (KnownSymbol fieldName, HasField fieldName record fieldValue, HasField "meta" record MetaBag, Eq fieldValue, Typeable record) => Proxy fieldName -> record -> Bool
+didChange field record = didTouchField && didChangeField
+    where
+        didTouchField :: Bool
+        didTouchField =
+            record
+            |> get #meta
+            |> get #touchedFields
+            |> includes (cs $! symbolVal field)
+
+        didChangeField :: Bool
+        didChangeField = originalFieldValue /= fieldValue
+
+        fieldValue :: fieldValue
+        fieldValue = record |> getField @fieldName
+
+        originalFieldValue :: fieldValue
+        originalFieldValue =
+            record
+            |> get #meta
+            |> get #originalDatabaseRecord
+            |> fromMaybe (error "didChange called on a record without originalDatabaseRecord")
+            |> fromDynamic @record
+            |> fromMaybe (error "didChange failed to retrieve originalDatabaseRecord")
+            |> getField @fieldName
 
 -- | Represents fields that have a default value in an SQL schema
 --

IHP/SchemaCompiler.hs

@@ -147,6 +147,7 @@ compileTypes options schema@(Schema statements) =
                   <> "import qualified Database.PostgreSQL.Simple.Types\n"
                   <> "import IHP.Job.Types\n"
                   <> "import IHP.Job.Queue ()\n"
+                  <> "import qualified Data.Dynamic\n"
 
 compileStatementPreview :: [Statement] -> Statement -> Text
 compileStatementPreview statements statement = let ?schema = Schema statements in compileStatement previewCompilerOptions statement
@@ -431,7 +432,8 @@ compileFromRowInstance table@(CreateTable { name, columns }) = cs [i|
 instance FromRow #{modelName} where
     fromRow = do
 #{unsafeInit . indent . indent . unlines $ map columnBinding columnNames}
-        pure $ #{modelName} #{intercalate " " (map compileField (dataFields table))}
+        let theRecord = #{modelName} #{intercalate " " (map compileField (dataFields table))}
+        pure theRecord
 
 |]
     where
@@ -444,6 +446,7 @@ instance FromRow #{modelName} where
         compileField (fieldName, _)
             | isColumn fieldName = fieldName
             | isManyToManyField fieldName = let (Just ref) = find (\(n, _) -> columnNameToFieldName n == fieldName) referencing in compileSetQueryBuilder ref
+            | fieldName == "meta" = "def { originalDatabaseRecord = Just (Data.Dynamic.toDyn theRecord) }"
             | otherwise = "def"
 
         isPrimaryKey name = name `elem` primaryKeyColumnNames (primaryKeyConstraint table)

Test/ModelSupportSpec.hs

@@ -8,6 +8,7 @@ import Test.Hspec
 import IHP.Prelude
 import IHP.ModelSupport
 import qualified Data.Aeson as Aeson
+import qualified Data.Dynamic as Dynamic
 
 tests = do
     describe "ModelSupport" do
@@ -77,3 +78,23 @@ tests = do
                     let (Just value) :: Maybe Aeson.Value = Aeson.decode "{\"hello\":true}"
                     (inputValue value) `shouldBe` "{\"hello\":true}"
 
+        describe "didChange" do
+            let project = Project { id = 1337, name = "Test", meta = def { originalDatabaseRecord = Just (Dynamic.toDyn project) } }
+
+            it "should return False for a new record" do
+                (project |> didChange #name) `shouldBe` False
+                (project |> didChange #id) `shouldBe` False
+
+            it "should return True for a changed field" do
+                (project |> set #name "Changed" |> didChange #name) `shouldBe` True
+                (project |> didChange #id) `shouldBe` False
+
+            it "should return false for a changed field when set with the same value again" do
+                (project |> set #name "Test" |> didChange #name) `shouldBe` False
+                (project |> didChange #id) `shouldBe` False
+
+data Project = Project { id :: Int, name :: Text, meta :: MetaBag }
+instance SetField "id" Project Int where
+    setField value project@(Project { id, name, meta }) = project { Test.ModelSupportSpec.id = value, meta = meta { touchedFields = "id":(touchedFields meta) } }
+instance SetField "name" Project Text where
+    setField value project@(Project { id, name, meta }) = project { name = value, meta = meta { touchedFields = "name":(touchedFields meta) } }