refactor(icons): only allow semantic icons from now on
This commit is contained in:
Steffen Jost
parent
bc675006d8
commit
f2963cff07
182
src/Utils/Icon.hs
Normal file
182
src/Utils/Icon.hs
Normal file
@ -0,0 +1,182 @@
|
||||
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
|
||||
Loading…
Reference in New Issue
Block a user