{-|
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.

A simple text message can be displayed with 'alertMsg', providing the message
text and the event to generate when the user closes the alert:

@
alertMsg "En error occurred" AlertClosedEvent
@

Alternatively, a custom widget can be provided to display as content:

@
customAlert = alert AlertClosedEvent content where
  content = hstack [
      label "Error:",
      filler,
      label errorDescription
    ]
@
-}
{-# 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 qualified Data.Sequence as Seq

import Monomer.Core
import Monomer.Core.Combinators

import Monomer.Widgets.Composite
import Monomer.Widgets.Container
import Monomer.Widgets.Containers.Box
import Monomer.Widgets.Containers.BoxShadow
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 {
    _alcTitle :: Maybe Text
_alcTitle = forall a. Maybe a
Nothing,
    _alcClose :: Maybe Text
_alcClose = forall a. Maybe a
Nothing
  }

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

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

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

instance CmbCloseCaption AlertCfg where
  closeCaption :: Text -> AlertCfg
closeCaption Text
t = forall a. Default a => a
def {
    _alcClose :: Maybe Text
_alcClose = 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 :: forall s e.
(WidgetModel s, WidgetEvent e) =>
e -> WidgetNode () e -> WidgetNode s e
alert e
evt WidgetNode () e
dialogBody = forall s e.
(WidgetModel s, WidgetEvent e) =>
e -> [AlertCfg] -> WidgetNode () e -> WidgetNode s e
alert_ e
evt 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_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
e -> [AlertCfg] -> WidgetNode () e -> WidgetNode s e
alert_ e
evt [AlertCfg]
configs WidgetNode () e
dialogBody = WidgetNode s e
newNode where
  config :: AlertCfg
config = forall a. Monoid a => [a] -> a
mconcat [AlertCfg]
configs
  createUI :: WidgetEnv () e -> () -> WidgetNode () e
createUI = forall s ep.
(WidgetModel s, WidgetEvent ep) =>
(WidgetEnv s ep -> WidgetNode s ep)
-> ep -> AlertCfg -> WidgetEnv s ep -> s -> WidgetNode s ep
buildUI (forall a b. a -> b -> a
const WidgetNode () e
dialogBody) e
evt AlertCfg
config
  newNode :: WidgetNode s e
newNode = 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" (forall s a. a -> WidgetData s a
WidgetValue ()) WidgetEnv () e -> () -> WidgetNode () e
createUI 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 :: forall s e.
(WidgetModel s, WidgetEvent e) =>
Text -> e -> WidgetNode s e
alertMsg Text
message e
evt = forall s e.
(WidgetModel s, WidgetEvent e) =>
Text -> e -> [AlertCfg] -> WidgetNode s e
alertMsg_ Text
message e
evt 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_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
Text -> e -> [AlertCfg] -> WidgetNode s e
alertMsg_ Text
message e
evt [AlertCfg]
configs = WidgetNode s e
newNode where
  config :: AlertCfg
config = forall a. Monoid a => [a] -> a
mconcat [AlertCfg]
configs
  dialogBody :: WidgetEnv s e -> WidgetNode s e
dialogBody WidgetEnv s e
wenv = forall s e. Text -> [LabelCfg s e] -> WidgetNode s e
label_ Text
message [forall t. CmbMultiline t => t
multiline]
    forall a b. a -> (a -> b) -> b
& forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasStyle s a => Lens' s a
L.style forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s e
wenv forall s a. HasDialogMsgBodyStyle s a => Lens' s a
L.dialogMsgBodyStyle
  createUI :: WidgetEnv () e -> () -> WidgetNode () e
createUI = forall s ep.
(WidgetModel s, WidgetEvent ep) =>
(WidgetEnv s ep -> WidgetNode s ep)
-> ep -> AlertCfg -> WidgetEnv s ep -> s -> WidgetNode s ep
buildUI forall {s} {e} {s} {e}. WidgetEnv s e -> WidgetNode s e
dialogBody e
evt AlertCfg
config
  newNode :: WidgetNode s e
newNode = 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" (forall s a. a -> WidgetData s a
WidgetValue ()) WidgetEnv () e -> () -> WidgetNode () e
createUI 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 :: forall s ep.
(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
dialogBody ep
cancelEvt AlertCfg
config WidgetEnv s ep
wenv s
model = WidgetNode s ep
mainTree where
  title :: Text
title = forall a. a -> Maybe a -> a
fromMaybe Text
"" (AlertCfg -> Maybe Text
_alcTitle AlertCfg
config)
  close :: Text
close = forall a. a -> Maybe a -> a
fromMaybe Text
"Close" (AlertCfg -> Maybe Text
_alcClose AlertCfg
config)

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

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