chore(occurrences): workaround provide simple room field with least recent suggestions
This commit is contained in:
parent
e625dca6ea
commit
21592347b4
@ -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
|
-- 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.Legacy as E
|
||||||
import qualified Database.Esqueleto.Utils as E
|
import qualified Database.Esqueleto.Utils as E
|
||||||
import qualified Database.Esqueleto.Internal.Internal as E (SqlSelect)
|
import qualified Database.Esqueleto.Internal.Internal as E (SqlSelect)
|
||||||
|
import Database.Persist.Sql.Raw.QQ
|
||||||
|
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.Sequence as Seq
|
||||||
@ -288,7 +289,7 @@ multiActionOpts :: forall action a.
|
|||||||
-> FieldSettings UniWorX
|
-> FieldSettings UniWorX
|
||||||
-> Maybe action
|
-> Maybe action
|
||||||
-> (Html -> MForm Handler (FormResult a, [FieldView UniWorX]))
|
-> (Html -> MForm Handler (FormResult a, [FieldView UniWorX]))
|
||||||
multiActionOpts = multiActionOpts' mpopt
|
multiActionOpts = multiActionOpts' mpreq
|
||||||
|
|
||||||
multiAction' :: forall action a.
|
multiAction' :: forall action a.
|
||||||
( RenderMessage UniWorX action, PathPiece action, Ord action )
|
( RenderMessage UniWorX action, PathPiece action, Ord action )
|
||||||
@ -2342,6 +2343,33 @@ examModeForm mPrev = examMode
|
|||||||
examRequiredEquipmentFromEither (Left c) = ExamRequiredEquipmentCustom c
|
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
|
roomReferenceFormOpt :: FieldSettings UniWorX
|
||||||
-> Maybe (Maybe RoomReference)
|
-> Maybe (Maybe RoomReference)
|
||||||
-> AForm Handler (Maybe RoomReference)
|
-> AForm Handler (Maybe RoomReference)
|
||||||
|
|||||||
@ -63,7 +63,7 @@ occurrencesAForm (toPathPiece -> miIdent') mPrev = wFormToAForm $ do
|
|||||||
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
|
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
|
||||||
-- DEBUG TODO
|
-- DEBUG TODO
|
||||||
-- <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) Nothing
|
-- <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) Nothing
|
||||||
<*> pure Nothing
|
<*> aopt roomReferenceSimpleField (fslI MsgTableTutorialRoom) Nothing
|
||||||
)
|
)
|
||||||
]
|
]
|
||||||
) (fslI MsgScheduleRegularKind & addName (nudge "kind")) 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 MsgOccurrenceStart & addName (nudge "occur-start")) Nothing
|
||||||
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
|
<*> apreq timeFieldTypeTime (fslI MsgOccurrenceEnd & addName (nudge "occur-end")) Nothing
|
||||||
-- DEBUG TODO
|
-- DEBUG TODO
|
||||||
<*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) Nothing
|
-- <*> roomReferenceFormOpt (fslI MsgTableTutorialRoom) (Just Nothing) -- still does not work
|
||||||
-- <*> pure Nothing
|
<*> aopt roomReferenceSimpleField (fslI MsgTableTutorialRoom) Nothing
|
||||||
)
|
)
|
||||||
, ( ExceptionKindNoOccur
|
, ( ExceptionKindNoOccur
|
||||||
, ExceptNoOccur
|
, ExceptNoOccur
|
||||||
|
|||||||
@ -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 :: Functor m => AnIso' a b -> Field m a -> Field m b
|
||||||
isoField (cloneIso -> fieldIso) = convertField (view fieldIso) (review fieldIso)
|
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 :: 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)))
|
convertFieldM = checkMMap . ((fmap Right .) :: (a -> m b) -> (a -> m (Either (SomeMessage (HandlerSite m)) b)))
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user