From a2251868a4e83d7cf1e35f3e85fd3124aba05c85 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 | 20 +++++++++---------- 2 files changed, 14 insertions(+), 11 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..02e7b9618 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,24 +41,24 @@ 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) _ = return [] @@ -68,8 +68,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]