chore(occurrences): workaround provide simple room field with least recent suggestions

This commit is contained in:
Steffen Jost 2024-10-04 16:13:01 +02:00
parent e625dca6ea
commit 21592347b4
3 changed files with 34 additions and 5 deletions

View File

@ -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)

View File

@ -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

View File

@ -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)))