{-|
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.
-}
{-# LANGUAGE Strict #-}

module Monomer.Widgets.Containers.Alert (
  -- * Configuration
  AlertCfg,
  -- * Constructors
  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

{-|
Configuration options for alert:

- 'titleCaption': the title of the alert dialog.
- 'closeCaption': the caption of the close button.
-}
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 s, WidgetEvent e)
  => e                -- ^ The event to raise when the dialog is closed.
  -> WidgetNode () e  -- ^ The content to display in the dialog.
  -> WidgetNode s e  -- ^ The created dialog.
alert :: e -> WidgetNode () e -> WidgetNode s e
alert e
evt WidgetNode () e
dialogBody = e -> [AlertCfg] -> WidgetNode () e -> WidgetNode s e
forall s e.
(WidgetModel s, WidgetEvent e) =>
e -> [AlertCfg] -> WidgetNode () e -> WidgetNode s e
alert_ e
evt [AlertCfg]
forall a. Default a => a
def WidgetNode () e
dialogBody

-- | Creates an alert dialog with the provided content. Accepts config.
alert_
  :: (WidgetModel s, WidgetEvent e)
  => e                -- ^ The event to raise when the dialog is closed.
  -> [AlertCfg]        -- ^ The config options for the dialog.
  -> WidgetNode () e  -- ^ The content to display in the dialog.
  -> WidgetNode s e  -- ^ The created dialog.
alert_ :: e -> [AlertCfg] -> WidgetNode () e -> WidgetNode s e
alert_ e
evt [AlertCfg]
configs WidgetNode () e
dialogBody = WidgetNode s e
newNode where
  config :: AlertCfg
config = [AlertCfg] -> AlertCfg
forall a. Monoid a => [a] -> a
mconcat [AlertCfg]
configs
  createUI :: WidgetEnv () e -> () -> WidgetNode () e
createUI = (WidgetEnv () e -> WidgetNode () e)
-> e -> AlertCfg -> WidgetEnv () e -> () -> WidgetNode () e
forall s ep.
(WidgetModel s, WidgetEvent ep) =>
(WidgetEnv s ep -> WidgetNode s ep)
-> ep -> AlertCfg -> WidgetEnv s ep -> s -> WidgetNode s ep
buildUI (WidgetNode () e -> WidgetEnv () e -> WidgetNode () e
forall a b. a -> b -> a
const WidgetNode () e
dialogBody) e
evt AlertCfg
config
  newNode :: WidgetNode s e
newNode = WidgetType
-> WidgetData s ()
-> (WidgetEnv () e -> () -> WidgetNode () e)
-> EventHandler () e s e
-> [CompositeCfg () e s e]
-> WidgetNode s e
forall s e ep sp.
(CompositeModel s, CompositeEvent e, CompositeEvent ep,
 CompParentModel 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 s ()
forall s a. a -> WidgetData s a
WidgetValue ()) WidgetEnv () e -> () -> WidgetNode () e
createUI EventHandler () e s e
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 s, WidgetEvent e)
  => Text              -- ^ The message to display.
  -> e                -- ^ The event to raise when the dialog is closed.
  -> WidgetNode s e  -- ^ The created dialog.
alertMsg :: Text -> e -> WidgetNode s e
alertMsg Text
message e
evt = Text -> e -> [AlertCfg] -> WidgetNode s e
forall s e.
(WidgetModel s, WidgetEvent e) =>
Text -> e -> [AlertCfg] -> WidgetNode s e
alertMsg_ Text
message e
evt [AlertCfg]
forall a. Default a => a
def

-- | Creates an alert dialog with a text message as content. Accepts config.
alertMsg_
  :: (WidgetModel s, WidgetEvent e)
  => Text              -- ^ The message to display.
  -> e                -- ^ The event to raise when the dialog is closed.
  -> [AlertCfg]        -- ^ The config options for the dialog.
  -> WidgetNode s e  -- ^ The created dialog.
alertMsg_ :: Text -> e -> [AlertCfg] -> WidgetNode s e
alertMsg_ Text
message e
evt [AlertCfg]
configs = WidgetNode s e
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 () e -> () -> WidgetNode () e
createUI = (WidgetEnv () e -> WidgetNode () e)
-> e -> AlertCfg -> WidgetEnv () e -> () -> WidgetNode () e
forall s ep.
(WidgetModel s, WidgetEvent ep) =>
(WidgetEnv s ep -> WidgetNode s ep)
-> ep -> AlertCfg -> WidgetEnv s ep -> s -> WidgetNode s ep
buildUI WidgetEnv () e -> WidgetNode () e
forall s e s e. WidgetEnv s e -> WidgetNode s e
dialogBody e
evt AlertCfg
config
  newNode :: WidgetNode s e
newNode = WidgetType
-> WidgetData s ()
-> (WidgetEnv () e -> () -> WidgetNode () e)
-> EventHandler () e s e
-> [CompositeCfg () e s e]
-> WidgetNode s e
forall s e ep sp.
(CompositeModel s, CompositeEvent e, CompositeEvent ep,
 CompParentModel 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 s ()
forall s a. a -> WidgetData s a
WidgetValue ()) WidgetEnv () e -> () -> WidgetNode () e
createUI EventHandler () e s e
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]