-- SPDX-FileCopyrightText: 2022-2024 Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Wolfgang Witt ,David Mosbach -- -- SPDX-License-Identifier: AGPL-3.0-or-later module Utils.Icon where import ClassyPrelude.Yesod hiding (Proxy) import Data.Universe import Data.Char import Utils.PathPiece -- import Text.Hamlet import Text.Blaze (Markup) import Control.Lens import Language.Haskell.TH import Language.Haskell.TH.Instances () import Language.Haskell.TH.Lift (deriveLift) import Instances.TH.Lift () import Data.Aeson import Data.Aeson.TH -- | A @Widget@ for any site; no language interpolation, etc. type WidgetSiteless = forall site. WidgetFor site () ----------- -- Icons -- ----------- -- We collect all used icons here for an overview. -- For consistency, some conditional icons are also provided, having suffix True/False --------------------------------------------------------------------------- -- IMPORTANT: -- All icons must be manually registered within the following files: -- - src/Utils/Icon.hs -- - assets/icon-src/fontawesome.json by adding "our-name": "fa-name" -- - frontend/src/icons.scss by adding "our-name" -- We only use fontawesome v6.6.0 free icons in regular and solid --------------------------------------------------------------------------- data Icon = IconNew | IconOK | IconNotOK | IconWarning | IconProblem | IconVisible | IconInvisible -- IconCourse -- not used, IconMenuCourse is currently only used | IconCourseFavouriteManual | IconCourseFavouriteAutomatic | IconCourseFavouriteOff | IconEnrolTrue | IconEnrolFalse | IconPlanned | IconAnnounce | IconExam | IconExamRegisterTrue | IconExamRegisterFalse | IconExamAutoOccurrenceNudgeUp | IconExamAutoOccurrenceNudgeDown | IconExamAutoOccurrenceIgnore | IconExamAutoOccurrenceReconsider | IconCommentTrue | IconCommentFalse | IconLink | IconFileDownload | IconFileUpload | IconFileZip | IconFileCSV | IconFileMissing -- a required document is not on file | IconSFTQuestion -- for SheetFileType only | IconSFTHint -- for SheetFileType only | IconSFTSolution -- for SheetFileType only | IconSFTMarking -- for SheetFileType only | IconEmail | IconRegisterTemplate | IconNoCorrectors | IconTooltipDefault | IconNotificationSuccess -- used for popups | IconNotificationInfo | IconNotificationWarning | IconNotificationError | IconNotificationNonactive | IconNotification -- used for email and lettes | IconNoNotification | IconNotificationSent | IconFavourite | IconLanguage | IconNavContainerClose | IconPageActionChildrenClose | IconMenuNews | IconMenuHelp | IconMenuProfile | IconMenuLogin | IconMenuLogout | IconBreadcrumbsHome | IconMenuExtra | IconMenuCourseList | IconMenuCorrections | IconMenuExams | IconMenuAdmin | IconMenuQualification | IconMenuLms | IconPageActionPrimaryExpand | IconPageActionSecondary | IconBreadcrumbSeparator | IconFileUploadSession | IconStandaloneFieldError | IconFileUser | IconPersonalIdentification | IconMenuWorkflows | IconVideo | IconSubmissionUserDuplicate | IconSubmissionNoUsers | IconRemoveUser | IconReset | IconBlocked | IconCertificate -- currently always a car not always suitable?! | IconPrintCenter | IconLetter -- only to be used for postal matters | IconAt | IconSupervisor | IconSupervisorForeign | IconSuperior -- supervisor and head of department -- IconWaitingForUser | IconExpired | IconLocked | IconUnlocked | IconResetTries -- also see IconReset | IconCompany | IconCompanyWarning -- Company-related problems | IconEdit | IconUserEdit -- IconMagic -- indicates automatic updates | IconReroute -- for notification rerouting | IconTop -- indicating highest number/quantity/priority for something | IconWildcard | IconUserUnknown -- no info for user found, e.g. AVS lookup failed | IconUserBadge -- something about user-avs, e.g. badge in-/valid | IconGlasses -- user must wear glasses while driving -- | IconPlaceholder -- reserved and sued by the frontend for actual missing errors | IconMissing -- something is missing or not applicable, less obtrusive than IconPlaceholder deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic) deriving anyclass (Universe, Finite, NFData) iconText :: Icon -> Text iconText = camelToPathPiece' 1 . tshow nullaryPathPiece ''Icon $ camelToPathPiece' 1 deriveLift ''Icon deriveJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 } ''Icon -- Create an icon without additional space icon :: Icon -> Markup icon ic = [shamlet| $newline never |] -- Create an icon with fixed width iconFixed :: Icon -> Markup iconFixed ic = [shamlet| $newline never |] -- Stack two icons without additional space iconStacked :: Icon -> Icon -> Markup iconStacked ic0 ic1 = [shamlet| $newline never |] -- Create an icon (defaults to "?") with a specified tooltip; inline-bool just affects the size of the icon iconTooltip :: forall site. WidgetFor site () -> Maybe Icon -> Bool -> WidgetFor site () iconTooltip tooltip mIcon isInlineTooltip = let ic = iconText $ fromMaybe IconTooltipDefault mIcon urgency = "urgency__info" :: Text in $(whamletFile "templates/widgets/tooltip.hamlet") -- declare constats for all icons for compatibility and convenience -- "IconCourse" generates "iconCourse = icon IconCourse" iconShortcuts :: Q [Dec] iconShortcuts = foldMap mkIcon (universeF :: [Icon]) where mkIcon :: Icon -> Q [Dec] mkIcon ic = do iname <- newName $ over (ix 0) Data.Char.toLower $ show ic isig <- sigD iname [t|Markup|] idef <- valD (varP iname) (normalB [|icon ic|]) [] return [isig, idef] ---------------------- -- Conditional icons -- -- Some case are special, hence no Template Haskell here isVisible :: Bool -> Markup -- ^ Display an icon that denotes that something™ is visible or invisible isVisible True = icon IconVisible isVisible False = icon IconInvisible hasComment :: Bool -> Markup -- ^ Display an icon that denotes that something™ has a comment or not hasComment True = icon IconCommentTrue hasComment False = icon IconCommentFalse hasTickmark :: Bool -> Markup -- ^ Maybe display an icon that denotes that something™ is okay hasTickmark True = icon IconOK hasTickmark False = mempty isBad :: Bool -> Markup -- ^ Maybe display an icon that denotes that something™ is bad isBad True = icon IconProblem isBad False = mempty -- ^ Maybe display an icon that denotes that something™ is new isNew :: Bool -> Markup isNew True = icon IconNew isNew False = mempty -- DEPRECATED by Handler.Utils.updateAutomatic, which includes a helpful tooltip -- Maybe display an icon that denotes that something™ is NOT automagically updated or derived, but had been edited -- isAutomatic :: Bool -> Markup -- isAutomatic True = mempty -- icon IconMagic -- isAutomatic False = icon IconLocked -- IconEdit boolSymbol :: Bool -> Markup boolSymbol True = icon IconOK boolSymbol False = icon IconNotOK iconEnrol :: Bool -> Markup iconEnrol True = icon IconEnrolTrue iconEnrol False = icon IconEnrolFalse iconExamRegister :: Bool -> Markup iconExamRegister True = icon IconExamRegisterTrue iconExamRegister False = icon IconExamRegisterFalse -- | indicator whether notifications are sent by letter or email -- use iconReroute if type of rerouting is unclear iconLetterOrEmail :: Bool -> Markup iconLetterOrEmail True = icon IconLetter iconLetterOrEmail False = icon IconAt iconQualificationBlock :: Bool -> Markup iconQualificationBlock True = iconFixed IconCertificate iconQualificationBlock False = iconFixed IconBlocked iconWriteReadOnly :: Bool -> Markup iconWriteReadOnly True = icon IconEdit iconWriteReadOnly False = icon IconVisible ---------------- -- For documentation on how to avoid these unneccessary functions -- we implement them here just once for the first icon: -- isVisibleWidget :: Bool -> WidgetSiteless -- ^ Widget having an icon that denotes that something™ is visible or invisible isVisibleWidget = toWidget . isVisible maybeIsVisibleWidget :: Maybe Bool -> WidgetSiteless -- ^ Maybe a widget with an icon that denotes that something™ is visible or invisible maybeIsVisibleWidget = toWidget . foldMap isVisible