{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE Strict #-}
module Monomer.Widgets.Containers.Confirm (
ConfirmCfg,
InnerConfirmEvt,
confirm,
confirm_,
confirmMsg,
confirmMsg_
) 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.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
data ConfirmCfg = ConfirmCfg {
ConfirmCfg -> Maybe Text
_cfcTitle :: Maybe Text,
ConfirmCfg -> Maybe Text
_cfcAccept :: Maybe Text,
ConfirmCfg -> Maybe Text
_cfcCancel :: Maybe Text
}
instance Default ConfirmCfg where
def :: ConfirmCfg
def = ConfirmCfg {
_cfcTitle :: Maybe Text
_cfcTitle = forall a. Maybe a
Nothing,
_cfcAccept :: Maybe Text
_cfcAccept = forall a. Maybe a
Nothing,
_cfcCancel :: Maybe Text
_cfcCancel = forall a. Maybe a
Nothing
}
instance Semigroup ConfirmCfg where
<> :: ConfirmCfg -> ConfirmCfg -> ConfirmCfg
(<>) ConfirmCfg
a1 ConfirmCfg
a2 = ConfirmCfg {
_cfcTitle :: Maybe Text
_cfcTitle = ConfirmCfg -> Maybe Text
_cfcTitle ConfirmCfg
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConfirmCfg -> Maybe Text
_cfcTitle ConfirmCfg
a1,
_cfcAccept :: Maybe Text
_cfcAccept = ConfirmCfg -> Maybe Text
_cfcAccept ConfirmCfg
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConfirmCfg -> Maybe Text
_cfcAccept ConfirmCfg
a1,
_cfcCancel :: Maybe Text
_cfcCancel = ConfirmCfg -> Maybe Text
_cfcCancel ConfirmCfg
a2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ConfirmCfg -> Maybe Text
_cfcCancel ConfirmCfg
a1
}
instance Monoid ConfirmCfg where
mempty :: ConfirmCfg
mempty = forall a. Default a => a
def
instance CmbTitleCaption ConfirmCfg where
titleCaption :: Text -> ConfirmCfg
titleCaption Text
t = forall a. Default a => a
def {
_cfcTitle :: Maybe Text
_cfcTitle = forall a. a -> Maybe a
Just Text
t
}
instance CmbAcceptCaption ConfirmCfg where
acceptCaption :: Text -> ConfirmCfg
acceptCaption Text
t = forall a. Default a => a
def {
_cfcAccept :: Maybe Text
_cfcAccept = forall a. a -> Maybe a
Just Text
t
}
instance CmbCancelCaption ConfirmCfg where
cancelCaption :: Text -> ConfirmCfg
cancelCaption Text
t = forall a. Default a => a
def {
_cfcCancel :: Maybe Text
_cfcCancel = forall a. a -> Maybe a
Just Text
t
}
newtype InnerConfirmEvt e
= ConfirmParentEvt e
deriving (InnerConfirmEvt e -> InnerConfirmEvt e -> Bool
forall e. Eq e => InnerConfirmEvt e -> InnerConfirmEvt e -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InnerConfirmEvt e -> InnerConfirmEvt e -> Bool
$c/= :: forall e. Eq e => InnerConfirmEvt e -> InnerConfirmEvt e -> Bool
== :: InnerConfirmEvt e -> InnerConfirmEvt e -> Bool
$c== :: forall e. Eq e => InnerConfirmEvt e -> InnerConfirmEvt e -> Bool
Eq, Int -> InnerConfirmEvt e -> ShowS
forall e. Show e => Int -> InnerConfirmEvt e -> ShowS
forall e. Show e => [InnerConfirmEvt e] -> ShowS
forall e. Show e => InnerConfirmEvt e -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InnerConfirmEvt e] -> ShowS
$cshowList :: forall e. Show e => [InnerConfirmEvt e] -> ShowS
show :: InnerConfirmEvt e -> String
$cshow :: forall e. Show e => InnerConfirmEvt e -> String
showsPrec :: Int -> InnerConfirmEvt e -> ShowS
$cshowsPrec :: forall e. Show e => Int -> InnerConfirmEvt e -> ShowS
Show)
confirm
:: (WidgetModel s, WidgetEvent e)
=> e
-> e
-> WidgetNode () (InnerConfirmEvt e)
-> WidgetNode s e
confirm :: forall s e.
(WidgetModel s, WidgetEvent e) =>
e -> e -> WidgetNode () (InnerConfirmEvt e) -> WidgetNode s e
confirm e
acceptEvt e
cancelEvt WidgetNode () (InnerConfirmEvt e)
dialogBody = WidgetNode s e
newNode where
newNode :: WidgetNode s e
newNode = forall s e.
(WidgetModel s, WidgetEvent e) =>
e
-> e
-> [ConfirmCfg]
-> WidgetNode () (InnerConfirmEvt e)
-> WidgetNode s e
confirm_ e
acceptEvt e
cancelEvt forall a. Default a => a
def WidgetNode () (InnerConfirmEvt e)
dialogBody
confirm_
:: (WidgetModel s, WidgetEvent e)
=> e
-> e
-> [ConfirmCfg]
-> WidgetNode () (InnerConfirmEvt e)
-> WidgetNode s e
confirm_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
e
-> e
-> [ConfirmCfg]
-> WidgetNode () (InnerConfirmEvt e)
-> WidgetNode s e
confirm_ e
acceptEvt e
cancelEvt [ConfirmCfg]
configs WidgetNode () (InnerConfirmEvt e)
dialogBody = WidgetNode s e
newNode where
config :: ConfirmCfg
config = forall a. Monoid a => [a] -> a
mconcat [ConfirmCfg]
configs
createUI :: WidgetEnv () (InnerConfirmEvt e)
-> () -> WidgetNode () (InnerConfirmEvt e)
createUI = forall s ep.
(WidgetModel s, WidgetEvent ep) =>
(WidgetEnv s (InnerConfirmEvt ep)
-> WidgetNode s (InnerConfirmEvt ep))
-> ep
-> ep
-> ConfirmCfg
-> WidgetEnv s (InnerConfirmEvt ep)
-> s
-> WidgetNode s (InnerConfirmEvt ep)
buildUI (forall a b. a -> b -> a
const WidgetNode () (InnerConfirmEvt e)
dialogBody) e
acceptEvt e
cancelEvt ConfirmCfg
config
compCfg :: [CompositeCfg s e sp ep]
compCfg = [forall s e sp ep. MergeReqsHandler s e sp -> CompositeCfg s e sp ep
compositeMergeReqs forall s e sp. MergeReqsHandler s e sp
mergeReqs]
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
"confirm" (forall s a. a -> WidgetData s a
WidgetValue ()) WidgetEnv () (InnerConfirmEvt e)
-> () -> WidgetNode () (InnerConfirmEvt e)
createUI forall s ep sp.
WidgetEnv s (InnerConfirmEvt ep)
-> WidgetNode s (InnerConfirmEvt ep)
-> s
-> InnerConfirmEvt ep
-> [EventResponse s (InnerConfirmEvt ep) sp ep]
handleEvent forall {s} {e} {sp} {ep}. [CompositeCfg s e sp ep]
compCfg
confirmMsg
:: (WidgetModel s, WidgetEvent e)
=> Text
-> e
-> e
-> WidgetNode s e
confirmMsg :: forall s e.
(WidgetModel s, WidgetEvent e) =>
Text -> e -> e -> WidgetNode s e
confirmMsg Text
msg e
acceptEvt e
cancelEvt = forall s e.
(WidgetModel s, WidgetEvent e) =>
Text -> e -> e -> [ConfirmCfg] -> WidgetNode s e
confirmMsg_ Text
msg e
acceptEvt e
cancelEvt forall a. Default a => a
def
confirmMsg_
:: (WidgetModel s, WidgetEvent e)
=> Text
-> e
-> e
-> [ConfirmCfg]
-> WidgetNode s e
confirmMsg_ :: forall s e.
(WidgetModel s, WidgetEvent e) =>
Text -> e -> e -> [ConfirmCfg] -> WidgetNode s e
confirmMsg_ Text
message e
acceptEvt e
cancelEvt [ConfirmCfg]
configs = WidgetNode s e
newNode where
config :: ConfirmCfg
config = forall a. Monoid a => [a] -> a
mconcat [ConfirmCfg]
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 () (InnerConfirmEvt e)
-> () -> WidgetNode () (InnerConfirmEvt e)
createUI = forall s ep.
(WidgetModel s, WidgetEvent ep) =>
(WidgetEnv s (InnerConfirmEvt ep)
-> WidgetNode s (InnerConfirmEvt ep))
-> ep
-> ep
-> ConfirmCfg
-> WidgetEnv s (InnerConfirmEvt ep)
-> s
-> WidgetNode s (InnerConfirmEvt ep)
buildUI forall {s} {e} {s} {e}. WidgetEnv s e -> WidgetNode s e
dialogBody e
acceptEvt e
cancelEvt ConfirmCfg
config
compCfg :: [CompositeCfg s e sp ep]
compCfg = [forall s e sp ep. MergeReqsHandler s e sp -> CompositeCfg s e sp ep
compositeMergeReqs forall s e sp. MergeReqsHandler s e sp
mergeReqs]
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
"confirm" (forall s a. a -> WidgetData s a
WidgetValue ()) WidgetEnv () (InnerConfirmEvt e)
-> () -> WidgetNode () (InnerConfirmEvt e)
createUI forall s ep sp.
WidgetEnv s (InnerConfirmEvt ep)
-> WidgetNode s (InnerConfirmEvt ep)
-> s
-> InnerConfirmEvt ep
-> [EventResponse s (InnerConfirmEvt ep) sp ep]
handleEvent forall {s} {e} {sp} {ep}. [CompositeCfg s e sp ep]
compCfg
mergeReqs :: MergeReqsHandler s e sp
mergeReqs :: forall s e sp. MergeReqsHandler s e sp
mergeReqs WidgetEnv s e
wenv WidgetNode s e
newNode WidgetNode s e
oldNode sp
parentModel s
oldModel s
model = forall {s} {e}. [WidgetRequest s e]
reqs where
acceptPath :: Maybe (WidgetRequest s e)
acceptPath = forall s e. WidgetId -> WidgetRequest s e
SetFocus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s e. WidgetEnv s e -> WidgetKey -> Maybe WidgetId
widgetIdFromKey WidgetEnv s e
wenv WidgetKey
"acceptBtn"
isVisible :: s -> a
isVisible s
node = s
node forall s a. s -> Getting a s a -> a
^. forall s a. HasInfo s a => Lens' s a
L.info forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a. HasVisible s a => Lens' s a
L.visible
reqs :: [WidgetRequest s e]
reqs
| Bool -> Bool
not (forall {s} {a} {a}. (HasInfo s a, HasVisible a a) => s -> a
isVisible WidgetNode s e
oldNode) Bool -> Bool -> Bool
&& forall {s} {a} {a}. (HasInfo s a, HasVisible a a) => s -> a
isVisible WidgetNode s e
newNode = forall a. [Maybe a] -> [a]
catMaybes [forall {s} {e}. Maybe (WidgetRequest s e)
acceptPath]
| Bool
otherwise = []
buildUI
:: (WidgetModel s, WidgetEvent ep)
=> (WidgetEnv s (InnerConfirmEvt ep) -> WidgetNode s (InnerConfirmEvt ep))
-> ep
-> ep
-> ConfirmCfg
-> WidgetEnv s (InnerConfirmEvt ep)
-> s
-> WidgetNode s (InnerConfirmEvt ep)
buildUI :: forall s ep.
(WidgetModel s, WidgetEvent ep) =>
(WidgetEnv s (InnerConfirmEvt ep)
-> WidgetNode s (InnerConfirmEvt ep))
-> ep
-> ep
-> ConfirmCfg
-> WidgetEnv s (InnerConfirmEvt ep)
-> s
-> WidgetNode s (InnerConfirmEvt ep)
buildUI WidgetEnv s (InnerConfirmEvt ep)
-> WidgetNode s (InnerConfirmEvt ep)
dialogBody ep
pAcceptEvt ep
pCancelEvt ConfirmCfg
config WidgetEnv s (InnerConfirmEvt ep)
wenv s
model = WidgetNode s (InnerConfirmEvt ep)
mainTree where
acceptEvt :: InnerConfirmEvt ep
acceptEvt = forall e. e -> InnerConfirmEvt e
ConfirmParentEvt ep
pAcceptEvt
cancelEvt :: InnerConfirmEvt ep
cancelEvt = forall e. e -> InnerConfirmEvt e
ConfirmParentEvt ep
pCancelEvt
title :: Text
title = forall a. a -> Maybe a -> a
fromMaybe Text
"" (ConfirmCfg -> Maybe Text
_cfcTitle ConfirmCfg
config)
accept :: Text
accept = forall a. a -> Maybe a -> a
fromMaybe Text
"Accept" (ConfirmCfg -> Maybe Text
_cfcAccept ConfirmCfg
config)
cancel :: Text
cancel = forall a. a -> Maybe a -> a
fromMaybe Text
"Cancel" (ConfirmCfg -> Maybe Text
_cfcCancel ConfirmCfg
config)
emptyOverlay :: Style
emptyOverlay = forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s (InnerConfirmEvt ep)
wenv forall s a. HasEmptyOverlayStyle s a => Lens' s a
L.emptyOverlayStyle
acceptBtn :: WidgetNode s (InnerConfirmEvt ep)
acceptBtn = forall e s. WidgetEvent e => Text -> e -> WidgetNode s e
mainButton Text
accept InnerConfirmEvt ep
acceptEvt forall s e. WidgetNode s e -> Text -> WidgetNode s e
`nodeKey` Text
"acceptBtn"
cancelBtn :: WidgetNode s (InnerConfirmEvt ep)
cancelBtn = forall e s. WidgetEvent e => Text -> e -> WidgetNode s e
button Text
cancel InnerConfirmEvt ep
cancelEvt
buttons :: WidgetNode s (InnerConfirmEvt ep)
buttons = forall (t :: * -> *) s e.
Traversable t =>
t (WidgetNode s e) -> WidgetNode s e
hstack [ forall {s}. WidgetNode s (InnerConfirmEvt ep)
acceptBtn, forall s e. WidgetNode s e
spacer, forall {s}. WidgetNode s (InnerConfirmEvt ep)
cancelBtn ]
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 (InnerConfirmEvt ep)
wenv forall s a. HasDialogCloseIconStyle s a => Lens' s a
L.dialogCloseIconStyle
confirmTree :: WidgetNode s (InnerConfirmEvt ep)
confirmTree = 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 (InnerConfirmEvt 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 InnerConfirmEvt ep
cancelEvt] forall s e. WidgetNode s e
closeIcon
],
WidgetEnv s (InnerConfirmEvt ep)
-> WidgetNode s (InnerConfirmEvt ep)
dialogBody WidgetEnv s (InnerConfirmEvt 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 (InnerConfirmEvt ep)
buttons
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 a s t. Semigroup a => ASetter s t a a -> a -> s -> t
<>~ forall s e. WidgetEnv s e -> Lens' ThemeState StyleState -> Style
collectTheme WidgetEnv s (InnerConfirmEvt 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 (InnerConfirmEvt ep)
wenv forall s a. HasDialogFrameStyle s a => Lens' s a
L.dialogFrameStyle
confirmBox :: WidgetNode s (InnerConfirmEvt ep)
confirmBox = 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 InnerConfirmEvt ep
cancelEvt] (forall s e. WidgetNode s e -> WidgetNode s e
boxShadow WidgetNode s (InnerConfirmEvt ep)
confirmTree)
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 (InnerConfirmEvt ep)
mainTree = forall e s.
WidgetEvent e =>
[(Text, e)] -> WidgetNode s e -> WidgetNode s e
keystroke [(Text
"Esc", InnerConfirmEvt ep
cancelEvt)] WidgetNode s (InnerConfirmEvt ep)
confirmBox
handleEvent
:: WidgetEnv s (InnerConfirmEvt ep)
-> WidgetNode s (InnerConfirmEvt ep)
-> s
-> InnerConfirmEvt ep
-> [EventResponse s (InnerConfirmEvt ep) sp ep]
handleEvent :: forall s ep sp.
WidgetEnv s (InnerConfirmEvt ep)
-> WidgetNode s (InnerConfirmEvt ep)
-> s
-> InnerConfirmEvt ep
-> [EventResponse s (InnerConfirmEvt ep) sp ep]
handleEvent WidgetEnv s (InnerConfirmEvt ep)
wenv WidgetNode s (InnerConfirmEvt ep)
node s
model InnerConfirmEvt ep
evt = case InnerConfirmEvt ep
evt of
ConfirmParentEvt ep
pevt -> [forall s e sp ep. ep -> EventResponse s e sp ep
Report ep
pevt]