75 lines
2.5 KiB
Haskell
75 lines
2.5 KiB
Haskell
module Utils.Frontend.Modal
|
|
( Modal(..)
|
|
, customModal
|
|
, modal, msgModal
|
|
, addMessageModal
|
|
) where
|
|
|
|
import ClassyPrelude.Yesod
|
|
|
|
import Control.Lens
|
|
import Utils.Route
|
|
import Utils.Message
|
|
|
|
import Settings (widgetFile)
|
|
|
|
import Control.Monad.Random.Class (uniform)
|
|
import Control.Monad.Trans.Random (evalRandTIO)
|
|
|
|
|
|
data Modal site = Modal
|
|
{ modalTriggerId
|
|
, modalId :: Maybe Text
|
|
, modalTrigger :: Maybe Text {- Dynamic URL -} -> Text {- TriggerId -} -> WidgetFor site ()
|
|
, modalContent :: Either (SomeRoute site) (WidgetFor site ())
|
|
}
|
|
|
|
customModal :: Modal site -> WidgetFor site ()
|
|
customModal Modal{..} = do
|
|
triggerId' <- maybe newIdent return modalTriggerId
|
|
|
|
$(widgetFile "widgets/modal/modal")
|
|
|
|
route <- traverse toTextUrl $ modalContent ^? _Left
|
|
modalTrigger route triggerId'
|
|
|
|
-- | Create a link to a modal
|
|
modal :: WidgetFor site () -- ^ Widget that represents the link
|
|
-> Either (SomeRoute site) (WidgetFor site ()) -- ^ Modal contant: either dynamic link or static widget
|
|
-> WidgetFor site () -- ^ result widget
|
|
modal modalTrigger' modalContent = customModal Modal{..}
|
|
where
|
|
modalTriggerId = Nothing
|
|
modalId = Nothing
|
|
modalTrigger mRoute triggerId = $(widgetFile "widgets/modal/trigger")
|
|
|
|
|
|
-- | Variant of `modal` for use in messages (uses a different id generator to avoid collisions)
|
|
msgModal :: WidgetFor site ()
|
|
-> Either (SomeRoute site) (WidgetFor site ())
|
|
-> WidgetFor site ()
|
|
msgModal modalTrigger' modalContent = do
|
|
let
|
|
randomIdentifier :: MonadIO m => m Text
|
|
-- ^ Generates valid CSS-Identifiers with roughly 128 bits of entropy
|
|
--
|
|
-- See https://www.w3.org/TR/CSS21/syndata.html#value-def-identifier
|
|
randomIdentifier = fmap pack . evalRandTIO $ do
|
|
prefix <- uniform $ ['a'..'z'] ++ ['A'..'Z']
|
|
suffix <- replicateM 21 . uniform $ ['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9']
|
|
return $ prefix : suffix
|
|
modalTriggerId <- Just <$> randomIdentifier
|
|
modalId <- Just <$> randomIdentifier
|
|
customModal Modal{..}
|
|
where
|
|
modalTrigger mRoute triggerId = $(widgetFile "widgets/modal/trigger")
|
|
|
|
-- | add message alert with a short trigger widget, whose larger content is displayed in a modal
|
|
addMessageModal :: forall m site.
|
|
( MonadHandler m
|
|
, HandlerSite m ~ site
|
|
, Yesod site
|
|
) => MessageStatus -> WidgetFor site () -> Either (SomeRoute site) (WidgetFor site ()) -> m ()
|
|
addMessageModal ms trigger content = addMessageWidget ms $ msgModal trigger content
|
|
|