From f2963cff0765073b2be0cff84a3cd21c6f5e5db9 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Wed, 24 Jul 2019 15:02:12 +0200 Subject: [PATCH] refactor(icons): only allow semantic icons from now on --- src/Utils/Icon.hs | 182 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 182 insertions(+) create mode 100644 src/Utils/Icon.hs diff --git a/src/Utils/Icon.hs b/src/Utils/Icon.hs new file mode 100644 index 000000000..865bba69f --- /dev/null +++ b/src/Utils/Icon.hs @@ -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 + |] + + +-- 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