183 lines
5.1 KiB
Haskell
183 lines
5.1 KiB
Haskell
module Utils.Icon where
|
|
|
|
-- | A @Widget@ for any site; no language interpolation, etc.
|
|
type WidgetSiteless = forall site. forall m. (MonadIO m, MonadThrow m, MonadBaseControl IO m)
|
|
=> WidgetT site m ()
|
|
|
|
import Data.Universe
|
|
import Utils.PathPiece
|
|
import Text.Hamlet
|
|
|
|
|
|
-----------
|
|
-- 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
|
|
| IconNotVisible
|
|
| IconCourse
|
|
| IconEnrolTrue
|
|
| IconEnrolFalse
|
|
| IconExam
|
|
| IconExamRegisterTrue
|
|
| IconExamRegisterFalse
|
|
| IconCommentTrue
|
|
| IconCommentFalse
|
|
| IconFileDownload
|
|
| IconFileZip
|
|
| IconFileCSV
|
|
| IconSFTQuestion -- for SheetFileType only
|
|
| IconSFTHint -- for SheetFileType only
|
|
| IconSFTSolution -- for SheetFileType only
|
|
| IconSFTMarking -- for SheetFileType only
|
|
deriving (Eq, Enum, Bounded, Show, Read)
|
|
|
|
iconText :: Icon -> Text
|
|
iconText = \case
|
|
IconNew -> "seedling"
|
|
IconOK -> "check"
|
|
IconNotOK -> "times"
|
|
IconWarning -> "exclamation"
|
|
IconProblem -> "bolt"
|
|
IconVisible -> "eye"
|
|
IconNotVisible -> "eye-slash"
|
|
IconCourse -> "graduation-cap"
|
|
IconEnrolTrue -> "user-plus"
|
|
IconEnrolFalse -> "user-slash"
|
|
IconExam -> "file-invoice"
|
|
IconExamRegisterTrue -> "calendar-check"
|
|
IconExamRegisterFalse -> "calendar-times"
|
|
IconCommentTrue -> "comment-alt"
|
|
IconCommentFalse -> "comment-slash"
|
|
IconFileDownload -> "file-download"
|
|
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
|
|
|
|
instance Universe Icon
|
|
instance Finte Icon
|
|
nullaryPathPiece ''Icon $ camelToPathPiece' 1
|
|
|
|
-- Create an icon from font-awesome without additional space
|
|
icon :: Icon -> Markup
|
|
icon iconName =
|
|
[shamlet|$newline never
|
|
<i .fas .fa-#{iconText iconName}>|]
|
|
|
|
|
|
-- for compatibility and convenience
|
|
iconShortcuts :: Q [Dec]
|
|
iconShortcuts = forM universeF
|
|
(\ic ->
|
|
iname <- newName $ 'i' : (drop 1 $ show ic)
|
|
valD (varP iname) (normalB [|icon iname|])
|
|
)
|
|
|
|
iconQuestion :: Markup
|
|
iconQuestion = icon IconQuestion
|
|
|
|
iconNew :: Markup
|
|
iconNew = icon IconNew
|
|
|
|
iconOK :: Markup
|
|
iconOK = icon IconOK
|
|
|
|
iconNotOK :: Markup
|
|
iconNotOK = icon IconNotOK
|
|
|
|
iconWarning :: Markup
|
|
iconWarning = icon IconWarning
|
|
|
|
iconProblem :: Markup
|
|
iconProblem = icon IconProblem
|
|
|
|
iconHint :: Markup
|
|
iconHint = icon
|
|
|
|
-- Icons for Course
|
|
iconCourse :: Markup
|
|
iconCourse = fontAwesomeIcon "graduation-cap"
|
|
|
|
iconExam :: Markup
|
|
iconExam = fontAwesomeIcon "file-invoice"
|
|
|
|
iconEnrol :: Bool -> Markup
|
|
iconEnrol True = fontAwesomeIcon "user-plus"
|
|
iconEnrol False = fontAwesomeIcon "user-slash"
|
|
|
|
iconExamRegister :: Bool -> Markup
|
|
iconExamRegister True = fontAwesomeIcon "calendar-check"
|
|
iconExamRegister False = fontAwesomeIcon "calendar-times"
|
|
|
|
|
|
-- Icons for SheetFileType
|
|
iconSolution :: Markup
|
|
iconSolution =fontAwesomeIcon "exclamation-circle"
|
|
|
|
iconMarking :: Markup
|
|
iconMarking = fontAwesomeIcon "check-circle"
|
|
|
|
fileDownload :: Markup
|
|
fileDownload = fontAwesomeIcon "file-download"
|
|
|
|
zipDownload :: Markup
|
|
zipDownload = fontAwesomeIcon "file-archive"
|
|
|
|
iconCSV :: Markup
|
|
iconCSV = fontAwesomeIcon "file-csv"
|
|
|
|
|
|
-- Generic Conditional icons
|
|
|
|
isVisible :: Bool -> Markup
|
|
-- ^ Display an icon that denotes that something™ is visible or invisible
|
|
isVisible True = fontAwesomeIcon "eye"
|
|
isVisible False = fontAwesomeIcon "eye-slash"
|
|
--
|
|
-- 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
|
|
|
|
-- Other _frequently_ used icons:
|
|
hasComment :: Bool -> Markup
|
|
-- ^ Display an icon that denotes that something™ has a comment or not
|
|
hasComment True = fontAwesomeIcon "comment-alt"
|
|
hasComment False = fontAwesomeIcon "comment-slash" -- comment-alt-slash is not available for free
|
|
|
|
hasTickmark :: Bool -> Markup
|
|
-- ^ Display an icon that denotes that something™ is okay
|
|
hasTickmark True = iconOK
|
|
hasTickmark False = mempty
|
|
|
|
isBad :: Bool -> Markup
|
|
-- ^ Display an icon that denotes that something™ is bad
|
|
isBad True = iconProblem
|
|
isBad False = mempty
|
|
|
|
isNew :: Bool -> Markup
|
|
isNew True = iconNew
|
|
isNew False = mempty
|
|
|
|
boolSymbol :: Bool -> Markup
|
|
boolSymbol True = iconOK
|
|
boolSymbol False = iconNotOK
|