From f6ade63d1ec094d3a65ba6b0afa98915fe7c1705 Mon Sep 17 00:00:00 2001
From: SJost <jost@tcs.ifi.lmu.de>
Date: Thu, 2 Aug 2018 15:08:28 +0200
Subject: [PATCH] Fix #81

---
 src/Handler/Course.hs | 23 ++++++++++-------------
 src/Model.hs          |  6 ++++++
 src/Utils/DB.hs       |  2 +-
 3 files changed, 17 insertions(+), 14 deletions(-)

diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs
index df9d45ba0..4ff4676a7 100644
--- a/src/Handler/Course.hs
+++ b/src/Handler/Course.hs
@@ -308,16 +308,12 @@ courseEditHandler isGet course = do
           cid <- decrypt cID
           now <- liftIO getCurrentTime
           -- addMessage "debug" [shamlet| #{show res}|]
-          runDB $ do
+          success <- runDB $ do
             old <- get cid
             case old of
-              Nothing -> addMessageI "error" $ MsgInvalidInput
+              Nothing -> addMessageI "error" MsgInvalidInput $> False
               (Just oldCourse) -> do
-            -- existing <- getBy $ CourseTermShort tid csh
-            -- if ((entityKey <$> existing) /= Just cid)
-            --  then addMessageI "danger" $ MsgCourseEditDupShort tid csh
-            --   else do
-                _updOkay <- replace cid (  -- TODO replaceUnique requires Eq?!
+                updOkay <- myReplaceUnique cid (  -- replaceUnique requires Eq Course, which we cannot have
                     Course  {  courseName            = cfName       res
                             ,  courseDescription     = cfDesc       res
                             ,  courseLinkExternal    = cfLink       res
@@ -332,12 +328,13 @@ courseEditHandler isGet course = do
                             ,  courseDeregisterUntil = cfDeRegUntil res
                     }
                   )
-                insert_ $ CourseEdit aid now cid
---                 if (isNothing updOkay)
---                   then do
-                addMessageI "success" $ MsgCourseEditOk tid csh
-                -- redirect $ TermCourseListR tid
---                   else addMessageI "danger" $ MsgCourseEditDupShort tid csh
+                case updOkay of
+                  (Just _) -> addMessageI "danger" (MsgCourseEditDupShort tid csh) $> False
+                  Nothing  -> do
+                    insert_ $ CourseEdit aid now cid
+                    addMessageI "success" $ MsgCourseEditOk tid csh
+                    return True
+          when success $ redirect $ CourseR tid csh CShowR
 
       (FormFailure _) -> addMessageI "warning" MsgInvalidInput
       (FormMissing) -> return ()
diff --git a/src/Model.hs b/src/Model.hs
index b810d9588..9bff65c56 100644
--- a/src/Model.hs
+++ b/src/Model.hs
@@ -8,6 +8,9 @@
 {-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE TypeFamilies               #-}
 {-# LANGUAGE RecordWildCards            #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+
+
 module Model
   ( module Model
   , module Model.Types
@@ -31,6 +34,9 @@ import Data.CaseInsensitive (CI)
 share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll'"]
     $(persistFileWith lowerCaseSettings "models")
 
+-- (Eq Course) is impossible so we derive it for the Uniqueness Constraint only
+deriving instance Eq (Unique Course)
+
 migrateAll :: Migration
 migrateAll = do
   migrateEnableExtension "citext"
diff --git a/src/Utils/DB.hs b/src/Utils/DB.hs
index e547e34eb..084adf0e1 100644
--- a/src/Utils/DB.hs
+++ b/src/Utils/DB.hs
@@ -30,7 +30,7 @@ existsBy :: (PersistEntityBackend record ~ BaseBackend backend, PersistEntity re
 existsBy = fmap isJust . getBy
 
 
-myReplaceUnique
+myReplaceUnique -- Identical to Database.Persist.Class, except for the better type signature (original requires Eq  record which is not needed anyway)
     :: (MonadIO m
        ,Eq (Unique record)
        ,PersistRecordBackend record backend