36 lines
1.1 KiB
Haskell
36 lines
1.1 KiB
Haskell
{-# 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)
|