304 lines
11 KiB
Haskell
304 lines
11 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 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>,Wolfgang Witt <Wolfgang.Witt@campus.lmu.de>
|
|
--
|
|
-- 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
|
|
| IconNotificationInfo
|
|
| IconNotificationWarning
|
|
| IconNotificationError
|
|
| IconNotificationNonactive
|
|
| IconFavourite
|
|
| IconLanguage
|
|
| IconNavContainerClose | IconPageActionChildrenClose
|
|
| IconMenuNews
|
|
| IconMenuHelp
|
|
| IconMenuProfile
|
|
| IconMenuLogin | IconMenuLogout
|
|
| IconBreadcrumbsHome
|
|
| IconMenuExtra
|
|
| IconMenuCourseList
|
|
| IconMenuCorrections
|
|
| IconMenuExams
|
|
| IconMenuAdmin
|
|
| IconMenuQualification
|
|
| IconMenuLms
|
|
| IconPageActionPrimaryExpand | IconPageActionSecondary
|
|
| IconBreadcrumbSeparator
|
|
| IconFileUploadSession
|
|
| IconStandaloneFieldError
|
|
| IconFileUser
|
|
| IconNotification | IconNoNotification
|
|
| IconPersonalIdentification
|
|
| IconMenuWorkflows
|
|
| IconVideo
|
|
| IconSubmissionUserDuplicate
|
|
| IconSubmissionNoUsers
|
|
| IconRemoveUser
|
|
| IconReset
|
|
| IconBlocked
|
|
| IconPrintCenter
|
|
| IconLetter
|
|
| IconAt
|
|
| IconSupervisor
|
|
| IconWaitingForUser
|
|
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"
|
|
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
|
|
|
|
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
|
|
<i .fas .fa-#{iconText ic}>
|
|
|]
|
|
|
|
-- Create an icon from font-awesome with fixed width
|
|
iconFixed :: Icon -> Markup
|
|
iconFixed ic = [shamlet|
|
|
$newline never
|
|
<i .fas .fa-fw .fa-#{iconText ic}>
|
|
|]
|
|
|
|
-- Stack two icons from font-awesome without additional space
|
|
iconStacked :: Icon -> Icon -> Markup
|
|
iconStacked ic0 ic1
|
|
= [shamlet|
|
|
$newline never
|
|
<span .fa-stack .icon--stacked>
|
|
<i .fas .fa-stack-2x .fa-#{iconText ic0}>
|
|
<i .fas .fa-stack-2x .fa-#{iconText ic1}>
|
|
|]
|
|
|
|
-- 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
|