gistfile1.hs

data Alert = MSuccess | MWarning | MInfo
    deriving (Eq, Enum, Bounded, Show)

mkToCls :: Alert -> Text
mkToCls MSuccess = "alert-success"
mkToCls MWarning = "alert-warning"
mkToCls MInfo    = "alert-info"

class (Enum a, Bounded a, Show a) => MessageKey a

instance MessageKey Alert

msgKey :: Text
msgKey = "_MSG"

setMessage' :: (MonadHandler m, MessageKey k) => k -> Html -> m ()
setMessage' key = let k = T.append msgKey $ T.pack $ show key
                  in setSession k . T.concat . TL.toChunks . RenderText.renderHtml

setMessageI' :: (MonadHandler m, MessageKey k, RenderMessage (HandlerSite m) msg)
             => k
             -> msg
             -> m ()
setMessageI' k msg = do
    mr <- getMessageRender
    setMessage' k $ toHtml $ mr msg

getMessage' :: (MonadHandler m, MessageKey k) => k -> m (Maybe Html)
getMessage' key = do
    let k = T.append msgKey $ T.pack $ show key
    mmsg <- liftM (fmap preEscapedToMarkup) $ lookupSession k
    deleteSession k
    return mmsg

getMessages :: (MonadHandler m, MessageKey k) => m [(k, Html)]
getMessages = do
    let keys = enumFromTo minBound maxBound
    msgs <- mapM (\k -> (,) k `fmap` getMessage' k) keys
    return $ filt msgs
  where
    filt [] = []
    filt ((_,Nothing):ms) = filt ms
    filt ((k,Just m) :ms) = (k,m) : filt ms