-- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Sarah Vaupel ,Sarah Vaupel ,Steffen Jost ,Wolfgang Witt -- -- 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: Alert-Icons must be registered in alert-icons.js as well!!! --------------------------------------------------------------------------- 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 | IconPrintCenter | IconLetter | IconAt | IconSupervisor -- | IconWaitingForUser | IconExpired deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic) deriving anyclass (Universe, Finite, NFData) iconText :: Icon -> Text iconText = \case IconNew -> "seedling" IconOK -> "check" IconNotOK -> "times" IconWarning -> "exclamation" IconProblem -> "bolt" IconVisible -> "eye" IconInvisible -> "eye-slash" -- IconCourse -> "chalkboard-teacher" -- From fontawesome v6 onwards: "chalkboard-user" / or "desktop" for both IconCourseFavouriteManual -> "star" IconCourseFavouriteAutomatic -> "star-half-alt" IconCourseFavouriteOff -> "slash" -- TODO use FA regular style star for stacked icon IconEnrolTrue -> "user-plus" IconEnrolFalse -> "user-slash" IconPlanned -> "cog" IconAnnounce -> "bullhorn" IconExam -> "poll-h" IconExamRegisterTrue -> "calendar-check" IconExamRegisterFalse -> "calendar-times" IconExamAutoOccurrenceNudgeUp -> "user-plus" IconExamAutoOccurrenceNudgeDown -> "user-minus" IconExamAutoOccurrenceIgnore -> "users-slash" IconExamAutoOccurrenceReconsider -> "users" IconCommentTrue -> "comment-alt" IconCommentFalse -> "comment-alt-slash" IconLink -> "link" IconFileDownload -> "file-download" IconFileUpload -> "file-upload" IconFileZip -> "file-archive" IconFileCSV -> "file-csv" IconSFTQuestion -> "question-circle" -- for SheetFileType only, should all be round (similar) IconSFTHint -> "life-ring" -- for SheetFileType only IconSFTSolution -> "exclamation-circle" -- for SheetFileType only IconSFTMarking -> "check-circle" -- for SheetFileType only IconEmail -> "envelope" -- envelope is no longer unamibuous IconRegisterTemplate -> "file-alt" IconNoCorrectors -> "user-slash" IconRemoveUser -> "user-slash" IconTooltipDefault -> "question-circle" IconNotificationSuccess -> "check-circle" IconNotificationInfo -> "info-circle" IconNotificationWarning -> "exclamation-circle" IconNotificationError -> "exclamation-triangle" IconNotificationNonactive -> "info" IconFavourite -> "star" IconLanguage -> "flag-alt" IconNavContainerClose -> "chevron-up" IconPageActionChildrenClose -> "chevron-up" IconMenuNews -> "megaphone" IconMenuHelp -> "question" IconMenuProfile -> "cogs" IconMenuLogin -> "sign-in-alt" IconMenuLogout -> "sign-out-alt" IconBreadcrumbsHome -> "home" IconMenuExtra -> "ellipsis-h" IconMenuCourseList -> "chalkboard-teacher" -- From fontawesome v6 onwards: "chalkboard-user" / or "desktop" for both IconMenuCorrections -> "check" IconMenuExams -> "poll-h" IconMenuAdmin -> "screwdriver" IconMenuLms -> "tasks" -- "user-graduate" "laptop" IconMenuQualification -> "graduation-cap" -- "award" "diploma" "file-certificate" IconPageActionPrimaryExpand -> "bars" IconPageActionSecondary -> "ellipsis-h" IconBreadcrumbSeparator -> "angle-right" IconFileUploadSession -> "file-upload" IconStandaloneFieldError -> "exclamation" IconFileUser -> "file-user" IconNotification -> "envelope" IconNotificationSent -> "envelope-open" -- "paper-plane", "shipping-fast", "hourglass-half" IconNoNotification -> "bell-slash" IconPersonalIdentification -> "id-card" IconMenuWorkflows -> "project-diagram" IconVideo -> "video" IconSubmissionUserDuplicate -> "copy" IconSubmissionNoUsers -> "user-slash" IconReset -> "undo" -- From fontawesome v6 onwards: "arrow-rotate-left" IconBlocked -> "ban" IconPrintCenter -> "mail-bulk" -- From fontawesome v6 onwards: "envelope-bulk" IconLetter -> "mail-bulk" -- Problem "envelope" already used for email as well IconAt -> "at" IconSupervisor -> "head-side" -- must be notably different to user -- IconWaitingForUser -> "user-cog" -- Waiting on a user to do something IconExpired -> "hourglass-end" nullaryPathPiece ''Icon $ camelToPathPiece' 1 deriveLift ''Icon deriveJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 } ''Icon -- Create an icon from font-awesome without additional space icon :: Icon -> Markup icon ic = [shamlet| $newline never |] -- Create an icon from font-awesome with fixed width iconFixed :: Icon -> Markup iconFixed ic = [shamlet| $newline never |] -- Stack two icons from font-awesome 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 ---------------- -- 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