79d4ae20ee
Support course applications BREAKING CHANGE: auditing for course registrations and deregistrations, more tightly couple exam results, exam registration, and course registration (delete them together now)
179 lines
5.6 KiB
Haskell
179 lines
5.6 KiB
Haskell
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. forall m. (MonadIO m, MonadThrow m, MonadBaseControl IO m)
|
|
=> WidgetT site m ()
|
|
|
|
|
|
-----------
|
|
-- 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
|
|
| IconEnrolTrue
|
|
| IconEnrolFalse
|
|
| IconExam
|
|
| IconExamRegisterTrue
|
|
| IconExamRegisterFalse
|
|
| IconCommentTrue
|
|
| IconCommentFalse
|
|
| IconLink
|
|
| IconFileDownload
|
|
| IconFileZip
|
|
| IconFileCSV
|
|
| IconSFTQuestion -- for SheetFileType only
|
|
| IconSFTHint -- for SheetFileType only
|
|
| IconSFTSolution -- for SheetFileType only
|
|
| IconSFTMarking -- for SheetFileType only
|
|
| IconEmail
|
|
| IconRegisterTemplate
|
|
| IconApplyTrue
|
|
| IconApplyFalse
|
|
deriving (Eq, Ord, Enum, Bounded, Show, Read)
|
|
|
|
iconText :: Icon -> Text
|
|
iconText = \case
|
|
IconNew -> "seedling"
|
|
IconOK -> "check"
|
|
IconNotOK -> "times"
|
|
IconWarning -> "exclamation"
|
|
IconProblem -> "bolt"
|
|
IconVisible -> "eye"
|
|
IconInvisible -> "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" -- comment-alt-slash is not available for free
|
|
IconLink -> "link"
|
|
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
|
|
IconEmail -> "envelope"
|
|
IconRegisterTemplate -> "file-alt"
|
|
IconApplyTrue -> "file-alt"
|
|
IconApplyFalse -> "trash"
|
|
|
|
instance Universe Icon
|
|
instance Finite Icon
|
|
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}>
|
|
|]
|
|
|
|
-- 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
|
|
|
|
iconApply :: Bool -> Markup
|
|
iconApply True = icon IconApplyTrue
|
|
iconApply False = icon IconApplyFalse
|
|
|
|
iconExamRegister :: Bool -> Markup
|
|
iconExamRegister True = icon IconExamRegisterTrue
|
|
iconExamRegister False = icon IconExamRegisterFalse
|
|
|
|
|
|
----------------
|
|
-- 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
|