packages feed

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