Fix diff owl

ds-wizard · Oct 21, 2024 · 5347cd0 · 5347cd0
1 parent 7d3a657
commit 5347cd0
Show file tree

Hide file tree

Showing 3 changed files with 27 additions and 21 deletions.
diff --git a/wizard-server/src/Wizard/Service/Owl/Diff/Accessor/Accessor.hs b/wizard-server/src/Wizard/Service/Owl/Diff/Accessor/Accessor.hs
@@ -4,6 +4,7 @@ import qualified Data.List as L
 import qualified Data.Map.Strict as M
 import Data.Maybe (mapMaybe)
 
+import Shared.Common.Model.Common.MapEntry
 import WizardLib.KnowledgeModel.Model.Event.EventField
 import WizardLib.KnowledgeModel.Model.KnowledgeModel.KnowledgeModelLenses
 
@@ -30,7 +31,9 @@ getExistingEntities oldEntities newEntities =
  oldEntities
 
 isSameEntity :: HasAnnotations' entity => entity -> entity -> Bool
-isSameEntity entity1 entity2 = getAnnotations entity1 == getAnnotations entity2
+isSameEntity entity1 entity2 =
+ let sortAnnotations = L.sortBy (\a1 a2 -> a1.key `compare` a2.key)
+ in (sortAnnotations . getAnnotations $ entity1) == (sortAnnotations . getAnnotations $ entity2)
 
 diffListField (oldKm, newKm) oldList newList getEntitiesMFn =
  let accessorFn km uuid = M.lookup uuid (getEntitiesMFn km)

diff --git a/wizard-server/src/Wizard/Service/Owl/Diff/Differ.hs b/wizard-server/src/Wizard/Service/Owl/Diff/Differ.hs
@@ -31,8 +31,8 @@ diffChapter (oldKm, newKm) (oldCh, newCh) = do
  let oldQuestions = getQuestionsForChapterUuid oldKm oldCh.uuid
  let newQuestions = getQuestionsForChapterUuid newKm newCh.uuid
  existingQuestionsDiff <- traverse (diffQuestion (oldKm, newKm)) (getExistingEntities oldQuestions newQuestions)
- newQuestionEvents <- traverse (createAddEvent newCh.uuid) (getDiffEntities newQuestions oldQuestions)
- deletedQuestionEvents <- traverse (createDeleteEvent newCh.uuid) (getDiffEntities oldQuestions newQuestions)
+ newQuestionEvents <- traverse (createAddEvent newCh.uuid) (getDiffEntities oldQuestions newQuestions)
+ deletedQuestionEvents <- traverse (createDeleteEvent newCh.uuid) (getDiffEntities newQuestions oldQuestions)
  return $ catMaybes [editChapterEvent] ++ concat existingQuestionsDiff ++ newQuestionEvents ++ deletedQuestionEvents
 
 diffQuestion :: MonadIO m => (KnowledgeModel, KnowledgeModel) -> (Question, Question) -> m [Event]
@@ -41,25 +41,28 @@ diffQuestion (oldKm, newKm) (OptionsQuestion' oldQ, OptionsQuestion' newQ) = do
  let oldAnswers = getAnswersForQuestionUuid oldKm oldQ.uuid
  let newAnswers = getAnswersForQuestionUuid newKm newQ.uuid
  existingAnswersDiff <- traverse (diffAnswer (oldKm, newKm)) (getExistingEntities oldAnswers newAnswers)
- newAnswerEvents <- traverse (createAddEvent newQ.uuid) (getDiffEntities newAnswers oldAnswers)
- deletedAnswerEvents <- traverse (createDeleteEvent oldQ.uuid) (getDiffEntities oldAnswers newAnswers)
+ newAnswerEvents <- traverse (createAddEvent newQ.uuid) (getDiffEntities oldAnswers newAnswers)
+ deletedAnswerEvents <- traverse (createDeleteEvent oldQ.uuid) (getDiffEntities newAnswers oldAnswers)
  return $ catMaybes [editQuestionEvent] ++ concat existingAnswersDiff ++ newAnswerEvents ++ deletedAnswerEvents
 diffQuestion (oldKm, newKm) (MultiChoiceQuestion' oldQ, MultiChoiceQuestion' newQ) = do
  editQuestionEvent <- createEditEvent (oldKm, newKm) U.nil (MultiChoiceQuestion' oldQ) (MultiChoiceQuestion' newQ)
  let oldChoices = getChoicesForQuestionUuid oldKm oldQ.uuid
  let newChoices = getChoicesForQuestionUuid newKm newQ.uuid
  existingChoicesDiff <- traverse (diffChoice (oldKm, newKm)) (getExistingEntities oldChoices newChoices)
- newChoiceEvents <- traverse (createAddEvent newQ.uuid) (getDiffEntities newChoices oldChoices)
- deletedChoiceEvents <- traverse (createDeleteEvent oldQ.uuid) (getDiffEntities oldChoices newChoices)
+ newChoiceEvents <- traverse (createAddEvent newQ.uuid) (getDiffEntities oldChoices newChoices)
+ deletedChoiceEvents <- traverse (createDeleteEvent oldQ.uuid) (getDiffEntities newChoices oldChoices)
  return $ catMaybes [editQuestionEvent] ++ concat existingChoicesDiff ++ newChoiceEvents ++ deletedChoiceEvents
 diffQuestion (oldKm, newKm) (ListQuestion' oldQ, ListQuestion' newQ) = do
  editQuestionEvent <- createEditEvent (oldKm, newKm) U.nil (ListQuestion' oldQ) (ListQuestion' newQ)
  let oldQuestions = getItemTemplateQuestionsForQuestionUuid oldKm oldQ.uuid
  let newQuestions = getItemTemplateQuestionsForQuestionUuid newKm newQ.uuid
  existingQuestionsDiff <- traverse (diffQuestion (oldKm, newKm)) (getExistingEntities oldQuestions newQuestions)
- newQuestionEvents <- traverse (createAddEvent newQ.uuid) (getDiffEntities newQuestions oldQuestions)
- deletedQuestionEvents <- traverse (createDeleteEvent oldQ.uuid) (getDiffEntities oldQuestions newQuestions)
+ newQuestionEvents <- traverse (createAddEvent newQ.uuid) (getDiffEntities oldQuestions newQuestions)
+ deletedQuestionEvents <- traverse (createDeleteEvent oldQ.uuid) (getDiffEntities newQuestions oldQuestions)
  return $ catMaybes [editQuestionEvent] ++ concat existingQuestionsDiff ++ newQuestionEvents ++ deletedQuestionEvents
+diffQuestion (oldKm, newKm) (ValueQuestion' oldQ, ValueQuestion' newQ) = do
+ editQuestionEvent <- createEditEvent (oldKm, newKm) U.nil (ValueQuestion' oldQ) (ValueQuestion' newQ)
+ return $ catMaybes [editQuestionEvent]
 diffQuestion (oldKm, newKm) _ = return []
 
 diffAnswer :: MonadIO m => (KnowledgeModel, KnowledgeModel) -> (Answer, Answer) -> m [Event]
@@ -68,8 +71,8 @@ diffAnswer (oldKm, newKm) (oldAnswer, newAnswer) = do
  let oldQuestions = getQuestionsForAnswerUuid oldKm oldAnswer.uuid
  let newQuestions = getQuestionsForAnswerUuid newKm newAnswer.uuid
  existingQuestionsDiff <- traverse (diffQuestion (oldKm, newKm)) (getExistingEntities oldQuestions newQuestions)
- newQuestionEvents <- traverse (createAddEvent newAnswer.uuid) (getDiffEntities newQuestions oldQuestions)
- deletedQuestionEvents <- traverse (createDeleteEvent oldAnswer.uuid) (getDiffEntities oldQuestions newQuestions)
+ newQuestionEvents <- traverse (createAddEvent newAnswer.uuid) (getDiffEntities oldQuestions newQuestions)
+ deletedQuestionEvents <- traverse (createDeleteEvent oldAnswer.uuid) (getDiffEntities newQuestions oldQuestions)
  return $ catMaybes [editAnswerEvent] ++ concat existingQuestionsDiff ++ newQuestionEvents ++ deletedQuestionEvents
 
 diffChoice :: MonadIO m => (KnowledgeModel, KnowledgeModel) -> (Choice, Choice) -> m [Event]

diff --git a/wizard-server/src/Wizard/Service/Owl/Diff/EventFactory/Question.hs b/wizard-server/src/Wizard/Service/Owl/Diff/EventFactory/Question.hs
@@ -103,14 +103,14 @@ instance EventFactory Question where
  , props = entity.props
  , createdAt = now
  }
- createEditEvent (oldKm, newKm) parentUuid (OptionsQuestion' oldEntity) (OptionsQuestion' newEntity) = do
+ createEditEvent (oldKm, newKm) parentUuid (OptionsQuestion' newEntity) (OptionsQuestion' oldEntity) = do
  eventUuid <- liftIO generateUuid
  now <- liftIO getCurrentTime
  let event =
  EditOptionsQuestionEvent
  { uuid = eventUuid
  , parentUuid = parentUuid
- , entityUuid = newEntity.uuid
+ , entityUuid = oldEntity.uuid
  , title = diffField oldEntity.title newEntity.title
  , text = diffField oldEntity.text newEntity.text
  , requiredPhaseUuid =
@@ -127,14 +127,14 @@ instance EventFactory Question where
  if isEmptyEvent event
  then return . Just . EditQuestionEvent' . EditOptionsQuestionEvent' $ event
  else return Nothing
- createEditEvent (oldKm, newKm) parentUuid (MultiChoiceQuestion' oldEntity) (MultiChoiceQuestion' newEntity) = do
+ createEditEvent (oldKm, newKm) parentUuid (MultiChoiceQuestion' newEntity) (MultiChoiceQuestion' oldEntity) = do
  eventUuid <- liftIO generateUuid
  now <- liftIO getCurrentTime
  let event =
  EditMultiChoiceQuestionEvent
  { uuid = eventUuid
  , parentUuid = parentUuid
- , entityUuid = newEntity.uuid
+ , entityUuid = oldEntity.uuid
  , title = diffField oldEntity.title newEntity.title
  , text = diffField oldEntity.text newEntity.text
  , requiredPhaseUuid =
@@ -151,14 +151,14 @@ instance EventFactory Question where
  if isEmptyEvent event
  then return . Just . EditQuestionEvent' . EditMultiChoiceQuestionEvent' $ event
  else return Nothing
- createEditEvent (oldKm, newKm) parentUuid (ListQuestion' oldEntity) (ListQuestion' newEntity) = do
+ createEditEvent (oldKm, newKm) parentUuid (ListQuestion' newEntity) (ListQuestion' oldEntity) = do
  eventUuid <- liftIO generateUuid
  now <- liftIO getCurrentTime
  let event =
  EditListQuestionEvent
  { uuid = eventUuid
  , parentUuid = parentUuid
- , entityUuid = newEntity.uuid
+ , entityUuid = oldEntity.uuid
  , title = diffField oldEntity.title newEntity.title
  , text = diffField oldEntity.text newEntity.text
  , requiredPhaseUuid =
@@ -179,14 +179,14 @@ instance EventFactory Question where
  if isEmptyEvent event
  then return . Just . EditQuestionEvent' . EditListQuestionEvent' $ event
  else return Nothing
- createEditEvent (oldKm, newKm) parentUuid (ValueQuestion' oldEntity) (ValueQuestion' newEntity) = do
+ createEditEvent (oldKm, newKm) parentUuid (ValueQuestion' newEntity) (ValueQuestion' oldEntity) = do
  eventUuid <- liftIO generateUuid
  now <- liftIO getCurrentTime
  let event =
  EditValueQuestionEvent
  { uuid = eventUuid
  , parentUuid = parentUuid
- , entityUuid = newEntity.uuid
+ , entityUuid = oldEntity.uuid
  , title = diffField oldEntity.title newEntity.title
  , text = diffField oldEntity.text newEntity.text
  , requiredPhaseUuid =
@@ -202,14 +202,14 @@ instance EventFactory Question where
  if isEmptyEvent event
  then return . Just . EditQuestionEvent' . EditValueQuestionEvent' $ event
  else return Nothing
- createEditEvent (oldKm, newKm) parentUuid (IntegrationQuestion' oldEntity) (IntegrationQuestion' newEntity) = do
+ createEditEvent (oldKm, newKm) parentUuid (IntegrationQuestion' newEntity) (IntegrationQuestion' oldEntity) = do
  eventUuid <- liftIO generateUuid
  now <- liftIO getCurrentTime
  let event =
  EditIntegrationQuestionEvent
  { uuid = eventUuid
  , parentUuid = parentUuid
- , entityUuid = newEntity.uuid
+ , entityUuid = oldEntity.uuid
  , title = diffField oldEntity.title newEntity.title
  , text = diffField oldEntity.text newEntity.text
  , requiredPhaseUuid =