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: Alert-Icons must be registered in alert-icons.js as well!!!
---------------------------------------------------------------------------
data Icon
  = IconNew
  | IconOK
  | IconNotOK
  | IconWarning
  | IconProblem
  | IconVisible
  | IconInvisible
  | IconCourse
  | 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
  | IconApplyTrue
  | IconApplyFalse
  | IconNoCorrectors
  | IconApplicationVeto
  | IconApplicationFiles
  | IconTooltipDefault
  | IconNotificationSuccess
  | IconNotificationInfo
  | IconNotificationWarning
  | IconNotificationError
  | IconFavourite
  | IconLanguage
  | IconNavContainerClose | IconPageActionChildrenClose
  | IconMenuNews
  | IconMenuHelp
  | IconMenuProfile
  | IconMenuLogin | IconMenuLogout
  | IconBreadcrumbsHome
  | IconMenuExtra
  | IconMenuCourseList
  | IconMenuCorrections
  | IconMenuExams
  | IconMenuAdmin
  | IconPageActionPrimaryExpand | IconPageActionSecondary
  | IconBreadcrumbSeparator
  | IconMissingAllocationPriority
  | IconFileUploadSession
  | IconStandaloneFieldError
  | IconFileUser
  | IconNotification | IconNoNotification
  | IconAllocationRegister | IconAllocationRegistrationEdit
  | IconAllocationApplicationEdit
  | IconPersonalIdentification
  | IconMenuWorkflows
  | IconVideo
  | IconSubmissionUserDuplicate
  | IconNoAllocationUser
  | IconSubmissionNoUsers
  | IconRemoveUser
  | IconReset
  | IconBlocked
  deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)
  deriving anyclass (Universe, Finite, NFData)

iconText :: Icon -> Text
iconText = \case
    IconNew                     -> "seedling"
    IconOK                      -> "check"
    IconNotOK                   -> "times"
    IconWarning                 -> "exclamation"
    IconProblem                 -> "bolt"
    IconVisible                 -> "eye"
    IconInvisible               -> "eye-slash"
    IconCourse                  -> "graduation-cap"
    IconCourseFavouriteManual   -> "star"
    IconCourseFavouriteAutomatic -> "star-half-alt"
    IconCourseFavouriteOff      -> "slash" -- TODO use FA regular style star for stacked icon
    IconEnrolTrue               -> "user-plus"
    IconEnrolFalse              -> "user-slash"
    IconPlanned                 -> "cog"
    IconAnnounce                -> "bullhorn"
    IconExam                    -> "poll-h"
    IconExamRegisterTrue        -> "calendar-check"
    IconExamRegisterFalse       -> "calendar-times"
    IconExamAutoOccurrenceNudgeUp -> "user-plus"
    IconExamAutoOccurrenceNudgeDown -> "user-minus"
    IconExamAutoOccurrenceIgnore -> "users-slash"
    IconExamAutoOccurrenceReconsider -> "users"
    IconCommentTrue             -> "comment-alt"
    IconCommentFalse            -> "comment-alt-slash"
    IconLink                    -> "link"
    IconFileDownload            -> "file-download"
    IconFileUpload              -> "file-upload"
    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"
    IconNoCorrectors            -> "user-slash"
    IconRemoveUser              -> "user-slash"
    IconApplicationVeto         -> "times"
    IconApplicationFiles        -> "file-alt"
    IconTooltipDefault          -> "question-circle"
    IconNotificationSuccess     -> "check-circle"
    IconNotificationInfo        -> "info-circle"
    IconNotificationWarning     -> "exclamation-circle"
    IconNotificationError       -> "exclamation-triangle"
    IconFavourite               -> "star"
    IconLanguage                -> "flag-alt"
    IconNavContainerClose       -> "chevron-up"
    IconPageActionChildrenClose -> "chevron-up"
    IconMenuNews                -> "megaphone"
    IconMenuHelp                -> "question"
    IconMenuProfile             -> "cogs"
    IconMenuLogin               -> "sign-in-alt"
    IconMenuLogout              -> "sign-out-alt"
    IconBreadcrumbsHome         -> "home"
    IconMenuExtra               -> "ellipsis-h"
    IconMenuCourseList          -> "graduation-cap"
    IconMenuCorrections         -> "check"
    IconMenuExams               -> "poll-h"
    IconMenuAdmin               -> "screwdriver"
    IconPageActionPrimaryExpand -> "bars"
    IconPageActionSecondary     -> "ellipsis-h"
    IconBreadcrumbSeparator     -> "angle-right"
    IconMissingAllocationPriority -> "empty-set"
    IconFileUploadSession       -> "file-upload"
    IconStandaloneFieldError    -> "exclamation"
    IconFileUser                -> "file-user"
    IconNotification            -> "envelope"
    IconNoNotification          -> "times"
    IconAllocationRegister      -> "user-plus"
    IconAllocationRegistrationEdit -> "pencil-alt"
    IconAllocationApplicationEdit -> "pencil-alt"
    IconPersonalIdentification  -> "id-card"
    IconMenuWorkflows           -> "project-diagram"
    IconVideo                   -> "video"
    IconSubmissionUserDuplicate -> "copy"
    IconNoAllocationUser        -> "user-slash"
    IconSubmissionNoUsers       -> "user-slash"
    IconReset                   -> "undo" -- From fontawesome v6 onwards: "arrow-rotate-left"
    IconBlocked                 -> "ban"

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}>
          |]
  
-- Create an icon from font-awesome with fixed width
iconFixed :: Icon -> Markup
iconFixed ic = [shamlet|
                 $newline never
                 <i .fas .fa-fw .fa-#{iconText ic}>
               |]

-- Stack two icons from font-awesome without additional space
iconStacked :: Icon -> Icon -> Markup
iconStacked ic0 ic1
  = [shamlet|
    $newline never
    <span .fa-stack .icon--stacked>
      <i .fas .fa-stack-2x .fa-#{iconText ic0}>
      <i .fas .fa-stack-2x .fa-#{iconText ic1}>
  |]

-- Create an icon (defaults to "?") with a specified tooltip
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

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