{-|
Module      : Monomer.Widgets.Containers.Alert
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Simple alert dialog, displaying a close button and optional title. Usually
embedded in a zstack component and displayed/hidden depending on context.

Config:

- titleCaption: the title of the alert dialog.
- closeCaption: the caption of the close button.
-}
module Monomer.Widgets.Containers.Alert (
  alert,
  alert_,
  alertMsg,
  alertMsg_
) where

import Control.Applicative ((<|>))
import Control.Lens ((&), (.~))
import Data.Default
import Data.Maybe
import Data.Text (Text)

import Monomer.Core
import Monomer.Core.Combinators

import Monomer.Widgets.Composite
import Monomer.Widgets.Containers.Box
import Monomer.Widgets.Containers.Keystroke
import Monomer.Widgets.Containers.Stack
import Monomer.Widgets.Singles.Button
import Monomer.Widgets.Singles.Icon
import Monomer.Widgets.Singles.Label
import Monomer.Widgets.Singles.Spacer

import qualified Monomer.Lens as L

data AlertCfg = AlertCfg {
  AlertCfg -> Maybe Text
_alcTitle :: Maybe Text,
  AlertCfg -> Maybe Text
_alcClose :: Maybe Text
}

instance Default AlertCfg where
  def :: AlertCfg
def = AlertCfg :: Maybe Text -> Maybe Text -> AlertCfg
AlertCfg {
    _alcTitle :: Maybe Text
_alcTitle = Maybe Text
forall a. Maybe a
Nothing,
    _alcClose :: Maybe Text
_alcClose = Maybe Text
forall a. Maybe a
Nothing
  }

instance Semigroup AlertCfg where
  <> :: AlertCfg -> AlertCfg -> AlertCfg
(<>) AlertCfg
a1 AlertCfg
a2 = AlertCfg :: Maybe Text -> Maybe Text -> AlertCfg
AlertCfg {
    _alcTitle :: Maybe Text
_alcTitle = AlertCfg -> Maybe Text
_alcTitle AlertCfg
a2 Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AlertCfg -> Maybe Text
_alcTitle AlertCfg
a1,
    _alcClose :: Maybe Text
_alcClose = AlertCfg -> Maybe Text
_alcClose AlertCfg
a2 Maybe Text -> Maybe Text -> Maybe Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AlertCfg -> Maybe Text
_alcClose AlertCfg
a1
  }

instance Monoid AlertCfg where
  mempty :: AlertCfg
mempty = AlertCfg
forall a. Default a => a
def

instance CmbTitleCaption AlertCfg where
  titleCaption :: Text -> AlertCfg
titleCaption Text
t = AlertCfg
forall a. Default a => a
def {
    _alcTitle :: Maybe Text
_alcTitle = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
  }

instance CmbCloseCaption AlertCfg where
  closeCaption :: Text -> AlertCfg
closeCaption Text
t = AlertCfg
forall a. Default a => a
def {
    _alcClose :: Maybe Text
_alcClose = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
  }

-- | Creates an alert dialog with the provided content.
alert
  :: (WidgetModel sp, WidgetEvent ep)
  => ep                -- ^ The event to raise when the dialog is closed.
  -> WidgetNode () ep  -- ^ The content to display in the dialog.
  -> WidgetNode sp ep  -- ^ The created dialog.
alert :: ep -> WidgetNode () ep -> WidgetNode sp ep
alert ep
evt WidgetNode () ep
dialogBody = ep -> [AlertCfg] -> WidgetNode () ep -> WidgetNode sp ep
forall sp ep.
(WidgetModel sp, WidgetEvent ep) =>
ep -> [AlertCfg] -> WidgetNode () ep -> WidgetNode sp ep
alert_ ep
evt [AlertCfg]
forall a. Default a => a
def WidgetNode () ep
dialogBody

-- | Creates an alert dialog with the provided content. Accepts config.
alert_
  :: (WidgetModel sp, WidgetEvent ep)
  => ep                -- ^ The event to raise when the dialog is closed.
  -> [AlertCfg]        -- ^ The config options for the dialog.
  -> WidgetNode () ep  -- ^ The content to display in the dialog.
  -> WidgetNode sp ep  -- ^ The created dialog.
alert_ :: ep -> [AlertCfg] -> WidgetNode () ep -> WidgetNode sp ep
alert_ ep
evt [AlertCfg]
configs WidgetNode () ep
dialogBody = WidgetNode sp ep
newNode where
  config :: AlertCfg
config = [AlertCfg] -> AlertCfg
forall a. Monoid a => [a] -> a
mconcat [AlertCfg]
configs
  createUI :: WidgetEnv () ep -> () -> WidgetNode () ep
createUI = (WidgetEnv () ep -> WidgetNode () ep)
-> ep -> AlertCfg -> WidgetEnv () ep -> () -> WidgetNode () ep
forall s ep.
(WidgetModel s, WidgetEvent ep) =>
(WidgetEnv s ep -> WidgetNode s ep)
-> ep -> AlertCfg -> WidgetEnv s ep -> s -> WidgetNode s ep
buildUI (WidgetNode () ep -> WidgetEnv () ep -> WidgetNode () ep
forall a b. a -> b -> a
const WidgetNode () ep
dialogBody) ep
evt AlertCfg
config
  newNode :: WidgetNode sp ep
newNode = WidgetType
-> WidgetData sp ()
-> (WidgetEnv () ep -> () -> WidgetNode () ep)
-> EventHandler () ep sp ep
-> [CompositeCfg () ep sp ep]
-> WidgetNode sp ep
forall s e ep sp.
(CompositeModel s, CompositeEvent e, CompositeEvent ep,
 ParentModel sp) =>
WidgetType
-> WidgetData sp s
-> UIBuilder s e
-> EventHandler s e sp ep
-> [CompositeCfg s e sp ep]
-> WidgetNode sp ep
compositeD_ WidgetType
"alert" (() -> WidgetData sp ()
forall s a. a -> WidgetData s a
WidgetValue ()) WidgetEnv () ep -> () -> WidgetNode () ep
createUI EventHandler () ep sp ep
forall s ep e sp.
WidgetEnv s ep
-> WidgetNode s ep -> s -> ep -> [EventResponse s e sp ep]
handleEvent []

-- | Creates an alert dialog with a text message as content.
alertMsg
  :: (WidgetModel sp, WidgetEvent ep)
  => Text              -- ^ The message to display.
  -> ep                -- ^ The event to raise when the dialog is closed.
  -> WidgetNode sp ep  -- ^ The created dialog.
alertMsg :: Text -> ep -> WidgetNode sp ep
alertMsg Text
message ep
evt = Text -> ep -> [AlertCfg] -> WidgetNode sp ep
forall sp ep.
(WidgetModel sp, WidgetEvent ep) =>
Text -> ep -> [AlertCfg] -> WidgetNode sp ep
alertMsg_ Text
message ep
evt [AlertCfg]
forall a. Default a => a
def

-- | Creates an alert dialog with a text message as content. Accepts config.
alertMsg_
  :: (WidgetModel sp, WidgetEvent ep)
  => Text              -- ^ The message to display.
  -> ep                -- ^ The event to raise when the dialog is closed.
  -> [AlertCfg]        -- ^ The config options for the dialog.
  -> WidgetNode sp ep  -- ^ The created dialog.
alertMsg_ :: Text -> ep -> [AlertCfg] -> WidgetNode sp ep
alertMsg_ Text
message ep
evt [AlertCfg]
configs = WidgetNode sp ep
newNode where
  config :: AlertCfg
config = [AlertCfg] -> AlertCfg
forall a. Monoid a => [a] -> a
mconcat [AlertCfg]
configs
  dialogBody :: WidgetEnv s e -> WidgetNode s e
dialogBody WidgetEnv s e
wenv = Text -> [LabelCfg s e] -> WidgetNode s e
forall s e. Text -> [LabelCfg s e] -> WidgetNode s e
label_ Text
message [LabelCfg s e
forall t. CmbMultiline t => t
multiline]
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Style -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s e -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDialogMsgBodyStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dialogMsgBodyStyle
  createUI :: WidgetEnv () ep -> () -> WidgetNode () ep
createUI = (WidgetEnv () ep -> WidgetNode () ep)
-> ep -> AlertCfg -> WidgetEnv () ep -> () -> WidgetNode () ep
forall s ep.
(WidgetModel s, WidgetEvent ep) =>
(WidgetEnv s ep -> WidgetNode s ep)
-> ep -> AlertCfg -> WidgetEnv s ep -> s -> WidgetNode s ep
buildUI WidgetEnv () ep -> WidgetNode () ep
forall s e s e. WidgetEnv s e -> WidgetNode s e
dialogBody ep
evt AlertCfg
config
  newNode :: WidgetNode sp ep
newNode = WidgetType
-> WidgetData sp ()
-> (WidgetEnv () ep -> () -> WidgetNode () ep)
-> EventHandler () ep sp ep
-> [CompositeCfg () ep sp ep]
-> WidgetNode sp ep
forall s e ep sp.
(CompositeModel s, CompositeEvent e, CompositeEvent ep,
 ParentModel sp) =>
WidgetType
-> WidgetData sp s
-> UIBuilder s e
-> EventHandler s e sp ep
-> [CompositeCfg s e sp ep]
-> WidgetNode sp ep
compositeD_ WidgetType
"alert" (() -> WidgetData sp ()
forall s a. a -> WidgetData s a
WidgetValue ()) WidgetEnv () ep -> () -> WidgetNode () ep
createUI EventHandler () ep sp ep
forall s ep e sp.
WidgetEnv s ep
-> WidgetNode s ep -> s -> ep -> [EventResponse s e sp ep]
handleEvent []

buildUI
  :: (WidgetModel s, WidgetEvent ep)
  => (WidgetEnv s ep -> WidgetNode s ep)
  -> ep
  -> AlertCfg
  -> WidgetEnv s ep
  -> s
  -> WidgetNode s ep
buildUI :: (WidgetEnv s ep -> WidgetNode s ep)
-> ep -> AlertCfg -> WidgetEnv s ep -> s -> WidgetNode s ep
buildUI WidgetEnv s ep -> WidgetNode s ep
dialogBody ep
cancelEvt AlertCfg
config WidgetEnv s ep
wenv s
model = WidgetNode s ep
mainTree where
  title :: Text
title = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (AlertCfg -> Maybe Text
_alcTitle AlertCfg
config)
  close :: Text
close = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"Close" (AlertCfg -> Maybe Text
_alcClose AlertCfg
config)

  emptyOverlay :: Style
emptyOverlay = WidgetEnv s ep -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s ep
wenv forall s a. HasEmptyOverlayStyle s a => Lens' s a
Lens' ThemeState StyleState
L.emptyOverlayStyle
  dismissButton :: WidgetNode s ep
dismissButton = [WidgetNode s ep] -> WidgetNode s ep
forall (t :: * -> *) s e.
Traversable t =>
t (WidgetNode s e) -> WidgetNode s e
hstack [Text -> ep -> WidgetNode s ep
forall e s. WidgetEvent e => Text -> e -> WidgetNode s e
button Text
close ep
cancelEvt]
  closeIcon :: WidgetNode s e
closeIcon = IconType -> [IconCfg] -> WidgetNode s e
forall s e. IconType -> [IconCfg] -> WidgetNode s e
icon_ IconType
IconClose [Double -> IconCfg
forall t. CmbWidth t => Double -> t
width Double
2]
    WidgetNode s e
-> (WidgetNode s e -> WidgetNode s e) -> WidgetNode s e
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s e -> Identity (WidgetNode s e)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s e
-> Identity (WidgetNode s e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style)
 -> WidgetNode s e -> Identity (WidgetNode s e))
-> Style -> WidgetNode s e -> WidgetNode s e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s ep -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s ep
wenv forall s a. HasDialogCloseIconStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dialogCloseIconStyle

  alertTree :: WidgetNode s ep
alertTree = [StackCfg] -> [WidgetNode s ep] -> WidgetNode s ep
forall (t :: * -> *) s e.
Traversable t =>
[StackCfg] -> t (WidgetNode s e) -> WidgetNode s e
vstack_ [((SizeReq, SizeReq) -> (SizeReq, SizeReq)) -> StackCfg
forall t.
CmbSizeReqUpdater t =>
((SizeReq, SizeReq) -> (SizeReq, SizeReq)) -> t
sizeReqUpdater (SizeReq, SizeReq) -> (SizeReq, SizeReq)
clearExtra] [
      [WidgetNode s ep] -> WidgetNode s ep
forall (t :: * -> *) s e.
Traversable t =>
t (WidgetNode s e) -> WidgetNode s e
hstack [
        Text -> WidgetNode s ep
forall s e. Text -> WidgetNode s e
label Text
title WidgetNode s ep
-> (WidgetNode s ep -> WidgetNode s ep) -> WidgetNode s ep
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s ep -> Identity (WidgetNode s ep)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s ep -> Identity (WidgetNode s ep))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s ep
-> Identity (WidgetNode s ep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style)
 -> WidgetNode s ep -> Identity (WidgetNode s ep))
-> Style -> WidgetNode s ep -> WidgetNode s ep
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s ep -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s ep
wenv forall s a. HasDialogTitleStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dialogTitleStyle,
        WidgetNode s ep
forall s e. WidgetNode s e
filler,
        [BoxCfg s ep] -> WidgetNode s ep -> WidgetNode s ep
forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ [BoxCfg s ep
forall t. CmbAlignTop t => t
alignTop, ep -> BoxCfg s ep
forall t e. CmbOnClick t e => e -> t
onClick ep
cancelEvt] WidgetNode s ep
forall s e. WidgetNode s e
closeIcon
      ],
      WidgetEnv s ep -> WidgetNode s ep
dialogBody WidgetEnv s ep
wenv,
      WidgetNode s ep
forall s e. WidgetNode s e
filler,
      [BoxCfg s ep] -> WidgetNode s ep -> WidgetNode s ep
forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ [BoxCfg s ep
forall t. CmbAlignRight t => t
alignRight] WidgetNode s ep
forall s. WidgetNode s ep
dismissButton
        WidgetNode s ep
-> (WidgetNode s ep -> WidgetNode s ep) -> WidgetNode s ep
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s ep -> Identity (WidgetNode s ep)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s ep -> Identity (WidgetNode s ep))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s ep
-> Identity (WidgetNode s ep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style)
 -> WidgetNode s ep -> Identity (WidgetNode s ep))
-> Style -> WidgetNode s ep -> WidgetNode s ep
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s ep -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s ep
wenv forall s a. HasDialogButtonsStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dialogButtonsStyle
    ] WidgetNode s ep
-> (WidgetNode s ep -> WidgetNode s ep) -> WidgetNode s ep
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s ep -> Identity (WidgetNode s ep)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s ep -> Identity (WidgetNode s ep))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s ep
-> Identity (WidgetNode s ep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style)
 -> WidgetNode s ep -> Identity (WidgetNode s ep))
-> Style -> WidgetNode s ep -> WidgetNode s ep
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WidgetEnv s ep -> Lens' ThemeState StyleState -> Style
forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s ep
wenv forall s a. HasDialogFrameStyle s a => Lens' s a
Lens' ThemeState StyleState
L.dialogFrameStyle
  alertBox :: WidgetNode s ep
alertBox = [BoxCfg s ep] -> WidgetNode s ep -> WidgetNode s ep
forall s e.
(WidgetModel s, WidgetEvent e) =>
[BoxCfg s e] -> WidgetNode s e -> WidgetNode s e
box_ [ep -> BoxCfg s ep
forall t e. CmbOnClickEmpty t e => e -> t
onClickEmpty ep
cancelEvt] WidgetNode s ep
alertTree
    WidgetNode s ep
-> (WidgetNode s ep -> WidgetNode s ep) -> WidgetNode s ep
forall a b. a -> (a -> b) -> b
& (WidgetNodeInfo -> Identity WidgetNodeInfo)
-> WidgetNode s ep -> Identity (WidgetNode s ep)
forall s a. HasInfo s a => Lens' s a
L.info ((WidgetNodeInfo -> Identity WidgetNodeInfo)
 -> WidgetNode s ep -> Identity (WidgetNode s ep))
-> ((Style -> Identity Style)
    -> WidgetNodeInfo -> Identity WidgetNodeInfo)
-> (Style -> Identity Style)
-> WidgetNode s ep
-> Identity (WidgetNode s ep)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Style -> Identity Style)
-> WidgetNodeInfo -> Identity WidgetNodeInfo
forall s a. HasStyle s a => Lens' s a
L.style ((Style -> Identity Style)
 -> WidgetNode s ep -> Identity (WidgetNode s ep))
-> Style -> WidgetNode s ep -> WidgetNode s ep
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Style
emptyOverlay
  mainTree :: WidgetNode s ep
mainTree = [(Text, ep)] -> WidgetNode s ep -> WidgetNode s ep
forall e s.
WidgetEvent e =>
[(Text, e)] -> WidgetNode s e -> WidgetNode s e
keystroke [(Text
"Esc", ep
cancelEvt)] WidgetNode s ep
alertBox

handleEvent
  :: WidgetEnv s ep
  -> WidgetNode s ep
  -> s
  -> ep
  -> [EventResponse s e sp ep]
handleEvent :: WidgetEnv s ep
-> WidgetNode s ep -> s -> ep -> [EventResponse s e sp ep]
handleEvent WidgetEnv s ep
wenv WidgetNode s ep
node s
model ep
evt = [ep -> EventResponse s e sp ep
forall s e sp ep. ep -> EventResponse s e sp ep
Report ep
evt]