fradrive/src/Utils/Icon.hs

-- SPDX-FileCopyrightText: 2022-2024 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>,David Mosbach <david.mosbach@uniworx.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:
-- 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
            <span .ico-#{iconText ic}>
          |]


-- Create an icon with fixed width
iconFixed :: Icon -> Markup
iconFixed ic = [shamlet|
                 $newline never
                 <span .ico-#{iconText ic} .fw-ico>
               |]


-- Stack two icons without additional space
iconStacked :: Icon -> Icon -> Markup
iconStacked ic0 ic1
  = [shamlet|
    $newline never
    <span .icon--stacked>
      <span .ico-#{iconText ic0} .medium-ico>
      <span .ico-#{iconText ic1} .medium-ico>
  |]

-- 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