headroom-0.4.3.0: src/Headroom/UI/Message.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE StrictData #-}
{-|
Module : Headroom.UI.Message
Description : UI component for message box
Copyright : (c) 2019-2022 Vaclav Svejcar
License : BSD-3-Clause
Maintainer : vaclav.svejcar@gmail.com
Stability : experimental
Portability : POSIX
Module providing UI component for message box (info/warning/error).
-}
module Headroom.UI.Message
( MessageType(..)
, Message(..)
, messageInfo
, messageWarn
, messageError
)
where
import Data.String.Interpolate ( i )
import RIO
-- | Type of the message box (info/warning/error).
data MessageType
= Info -- ^ info message type
| Warn -- ^ warning message type
| Error -- ^ error message type
deriving (Eq, Show)
instance Display MessageType where
textDisplay Info = "[i]"
textDisplay Warn = "[!]"
textDisplay Error = "[x]"
-- | Data type for message box.
data Message = Message MessageType Text
deriving (Eq, Show)
instance Display Message where
textDisplay (Message tp tx) = [i|#{textDisplay tp} #{tx}|]
-- | Creates 'Message' of type 'Info'.
messageInfo :: Text -> Message
messageInfo = Message Info
-- | Creates 'Message' of type 'Warn'.
messageWarn :: Text -> Message
messageWarn = Message Warn
-- | Creates 'Message' of type 'Error'.
messageError :: Text -> Message
messageError = Message Error