From 5347cd0b9d087c3eff7d30c51110d613668313f9 Mon Sep 17 00:00:00 2001 From: Vojtech Knaisl Date: Wed, 16 Oct 2024 12:42:43 +0200 Subject: [PATCH] Fix diff owl --- .../Service/Owl/Diff/Accessor/Accessor.hs | 5 +++- .../src/Wizard/Service/Owl/Diff/Differ.hs | 23 +++++++++++-------- .../Service/Owl/Diff/EventFactory/Question.hs | 20 ++++++++-------- 3 files changed, 27 insertions(+), 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 index 3ec56fc5d..a3ca5b653 100644 --- 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 index d60121858..a0e64b82e 100644 --- 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 index 412cf76d6..c8b59d07e 100644 --- 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 =