-- 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 -- - frontend/src/icons.scss --------------------------------------------------------------------------- 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 | 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 | IconPrintCenter | IconLetter | IconAt | IconSupervisor | IconSupervisorForeign -- | IconWaitingForUser | IconExpired | IconLocked | IconUnlocked | IconResetTries -- also see IconReset | IconCompany | IconEdit | IconUserEdit 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 bad isNew :: Bool -> Markup isNew True = icon IconNew isNew False = mempty 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 iconLetterOrEmail :: Bool -> Markup iconLetterOrEmail True = icon IconLetter iconLetterOrEmail False = icon IconAt iconQualificationBlock :: Bool -> Markup iconQualificationBlock True = icon IconCertificate iconQualificationBlock False = icon IconBlocked ---------------- -- 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