{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-}


module Utils.Message
  ( MessageClass(..)
  , addMessage, addMessageI
  ) where


import Data.Text as Text (toLower)
import Data.Universe
import Utils.PathPiece (finiteFromPathPiece, nullaryToPathPiece)

import qualified ClassyPrelude.Yesod (addMessage, addMessageI)
import ClassyPrelude.Yesod (PathPiece(..),MonadHandler,HandlerSite,RenderMessage,Html)


data MessageClass = Error | Warning | Info | Success
  deriving (Eq,Ord,Enum,Bounded,Show,Read)

instance Universe MessageClass
instance Finite   MessageClass

$( return [] ) -- forces order of splices, error otherwise, see https://ghc.haskell.org/trac/ghc/ticket/9813

instance PathPiece MessageClass where
  toPathPiece   = $(nullaryToPathPiece ''MessageClass [Text.toLower])
  fromPathPiece = finiteFromPathPiece

addMessage :: MonadHandler m => MessageClass-> Html -> m ()
addMessage mc  = ClassyPrelude.Yesod.addMessage  (toPathPiece mc)

addMessageI :: (MonadHandler m, RenderMessage (HandlerSite m) msg) => MessageClass -> msg -> m ()
addMessageI mc = ClassyPrelude.Yesod.addMessageI (toPathPiece mc)