From 21592347b4ce3101ac33b8d0b0e57fd7f8073aa3 Mon Sep 17 00:00:00 2001
From: Steffen <s.jost@fraport.de>
Date: Fri, 4 Oct 2024 16:13:01 +0200
Subject: [PATCH] chore(occurrences): workaround provide simple room field with
 least recent suggestions

---
 src/Handler/Utils/Form.hs             | 32 +++++++++++++++++++++++++--
 src/Handler/Utils/Form/Occurrences.hs |  6 ++---
 src/Utils/Form.hs                     |  1 +
 3 files changed, 34 insertions(+), 5 deletions(-)

diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs
index 24ceb7b92..e7713934c 100644
--- a/src/Handler/Utils/Form.hs
+++ b/src/Handler/Utils/Form.hs
@@ -1,4 +1,4 @@
--- SPDX-FileCopyrightText: 2022 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>
+-- SPDX-FileCopyrightText: 2022-24 Felix Hamann <felix.hamann@campus.lmu.de>,Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>,Steffen Jost <jost@tcs.ifi.lmu.de>,Winnie Ros <winnie.ros@campus.lmu.de>,Steffen Jost <s.jost@fraport.de>
 --
 -- SPDX-License-Identifier: AGPL-3.0-or-later
 
@@ -44,6 +44,7 @@ import qualified Data.Conduit.List as C (mapMaybe, mapMaybeM)
 import qualified Database.Esqueleto.Legacy as E
 import qualified Database.Esqueleto.Utils as E
 import qualified Database.Esqueleto.Internal.Internal as E (SqlSelect)
+import Database.Persist.Sql.Raw.QQ
 
 import qualified Data.Set as Set
 import qualified Data.Sequence as Seq
@@ -288,7 +289,7 @@ multiActionOpts :: forall action a.
                 -> FieldSettings UniWorX
                 -> Maybe action
                 -> (Html -> MForm Handler (FormResult a, [FieldView UniWorX]))
-multiActionOpts = multiActionOpts' mpopt
+multiActionOpts = multiActionOpts' mpreq
 
 multiAction' :: forall action a.
                 ( RenderMessage UniWorX action, PathPiece action, Ord action )
@@ -2342,6 +2343,33 @@ examModeForm mPrev = examMode
             examRequiredEquipmentFromEither (Left  c) = ExamRequiredEquipmentCustom c
 
 
+roomReferenceSimpleField :: Field Handler RoomReference
+roomReferenceSimpleField =
+    convertField RoomReferenceSimple getRoom (textField & cfStrip & addDatalist roomReferenceSimpleSuggestions)
+  where
+    getRoom RoomReferenceSimple{..} = roomRefText
+    getRoom RoomReferenceLink{}     = mempty
+
+roomReferenceSimpleSuggestions :: HandlerFor UniWorX (OptionList Text)
+roomReferenceSimpleSuggestions = do
+  suggsRaw <- runDB [sqlQQ|
+      SELECT room FROM (
+        SELECT DISTINCT ON (room)
+            j.value #> '{room,text}' AS room
+          , t.@{TutorialLastChanged} AS changed
+        FROM ^{Tutorial} AS t
+          , jsonb_array_elements((@{TutorialTime}->'exceptions') || (@{TutorialTime}->'scheduled')) AS j
+        ORDER BY 1, 2 DESC
+      ) AS sq
+      WHERE room IS NOT NULL
+      ORDER BY changed DESC
+      LIMIT 7;
+    |]
+  return $ mkOptionList $ fmap (\(E.unSingle -> t) -> Option t t t) suggsRaw
+  -- suggs <- liftHandler $ runDBRead $ E.select $ do
+  --       tut <- E.from $ E.table @Tutorial
+  --     return $ tut E.^. tutorialTime E.#>>. ["scheduled","1","room","text"]
+
 roomReferenceFormOpt :: FieldSettings UniWorX
                      -> Maybe (Maybe RoomReference)
                      -> AForm Handler (Maybe RoomReference)
diff --git a/src/Handler/Utils/Form/Occurrences.hs b/src/Handler/Utils/Form/Occurrences.hs
index 767b9f5c7..9a70af25b 100644
--- a/src/Handler/Utils/Form/Occurrences.hs
+++ b/src/Handler/Utils/Form/Occurrences.hs
@@ -63,7 +63,7 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
                                 <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
                                 -- DEBUG TODO
                                 -- <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) Nothing
-                                <*> pure Nothing
+                                <*> aopt roomReferenceSimpleField (fslI MsgTableTutorialRoom) Nothing
                             )
                           ]
             ) (fslI MsgScheduleRegularKind & addName (nudge "kind")) Nothing
@@ -101,8 +101,8 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
                                 <*> apreq timeFieldTypeTime (fslI MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
                                 <*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
                                 -- DEBUG TODO
-                                <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) Nothing
-                                -- <*> pure Nothing
+                                -- <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) (Just Nothing) -- still does not work
+                                <*> aopt roomReferenceSimpleField (fslI MsgTableTutorialRoom) Nothing
                             )
                           , ( ExceptionKindNoOccur
                             , ExceptNoOccur
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index 6a48bdec4..1f88144d6 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -903,6 +903,7 @@ cfAnySeparatedSet = guardField (not . Set.null) . convertField (Set.fromList . m
 isoField :: Functor m => AnIso' a b -> Field m a -> Field m b
 isoField (cloneIso -> fieldIso) = convertField (view fieldIso) (review fieldIso)
 
+-- | Also see non-monadic `Yesod.Form.Functions.convertField`
 convertFieldM :: forall m a b. Monad m => (a -> m b) -> (b -> a) -> Field m a -> Field m b
 convertFieldM = checkMMap . ((fmap Right .) :: (a -> m b) -> (a -> m (Either (SomeMessage (HandlerSite m)) b)))