ihp-modal (empty) → 1.0.0
raw patch · 5 files changed
+185/−0 lines, 5 filesdep +basedep +blaze-htmldep +ihp-context
Dependencies added: base, blaze-html, ihp-context, ihp-hsx, text, vault, wai
Files
- IHP/Modal/ControllerFunctions.hs +21/−0
- IHP/Modal/Types.hs +40/−0
- IHP/Modal/ViewFunctions.hs +62/−0
- LICENSE +21/−0
- ihp-modal.cabal +41/−0
+ IHP/Modal/ControllerFunctions.hs view
@@ -0,0 +1,21 @@+{-|+Module: IHP.Modal.ControllerFunctions+Description: Controller Helper Functions to use modals+Copyright: (c) digitally induced GmbH, 2020+-}+module IHP.Modal.ControllerFunctions (setModal) where++import Prelude+import Data.IORef (writeIORef)+import Text.Blaze.Html5 (Html)+import Network.Wai (Request)+import IHP.Modal.Types++-- | Store modal HTML in the context for later rendering.+--+-- In IHP, you typically use this with a rendered view:+--+-- > setModal (html MyModalView { .. })+--+setModal :: (?request :: Request) => Html -> IO ()+setModal modalHtml = writeIORef (lookupModalVault modalContainerVaultKey ?request) (Just (ModalContainer modalHtml))
+ IHP/Modal/Types.hs view
@@ -0,0 +1,40 @@+{-|+Module: IHP.Modal.Types+Copyright: (c) digitally induced GmbH, 2020+-}+module IHP.Modal.Types+( Modal (..)+, ModalContainer (..)+, modalContainerVaultKey+, lookupModalVault+) where++import Prelude+import Data.IORef (IORef)+import Data.Text (Text)+import Data.Typeable (Typeable, typeRep)+import Data.Proxy (Proxy(..))+import Text.Blaze.Html5 (Html)+import qualified Data.Vault.Lazy as Vault+import Network.Wai+import System.IO.Unsafe (unsafePerformIO)++data Modal = Modal+ { modalContent :: Html+ , modalFooter :: Maybe Html+ , modalCloseUrl :: Text+ , modalTitle :: Text+ }++-- | Stores the current modal inside the request vault+newtype ModalContainer = ModalContainer Html++modalContainerVaultKey :: Vault.Key (IORef (Maybe ModalContainer))+modalContainerVaultKey = unsafePerformIO Vault.newKey+{-# NOINLINE modalContainerVaultKey #-}++lookupModalVault :: forall value. Typeable value => Vault.Key value -> Request -> value+lookupModalVault key req =+ case Vault.lookup key req.vault of+ Just v -> v+ Nothing -> error $ "lookupModalVault: Could not find " <> show (typeRep (Proxy @value) ) <> " in request vault. Did you forget to add the Modal middleware?"
+ IHP/Modal/ViewFunctions.hs view
@@ -0,0 +1,62 @@+{-|+Module: IHP.Modal.ViewFunctions+Description: View Helper Functions to use modals+Copyright: (c) digitally induced GmbH, 2020+-}+module IHP.Modal.ViewFunctions (modal, renderModal) where++import Prelude+import Data.IORef (readIORef)+import Data.Text (Text)+import System.IO.Unsafe (unsafePerformIO)+import Network.Wai (Request)+import IHP.HSX.QQ (hsx)+import IHP.Modal.Types+import Text.Blaze.Html5 (Html)++renderModal :: Modal -> Html+renderModal modal = renderModal' modal True++renderModal' :: Modal -> Bool -> Html+renderModal' Modal { .. } show = [hsx|+ <div class={modalClassName} id="modal" tabindex="-1" role="dialog" aria-labelledby="modal-title" aria-hidden="true" style={displayStyle} onclick="if (event.target.id === 'modal') document.getElementById('modal-backdrop').click()">+ {modalInner}+ </div>+ <a id="modal-backdrop" href={modalCloseUrl} class={backdropClassName} style={displayStyle}/>+ |]+ where+ modalClassName :: Text+ modalClassName = "modal fade overflow-auto " <> if show then "show" else ""+ backdropClassName :: Text+ backdropClassName = "modal-backdrop fade " <> if show then "show" else ""+ displayStyle :: Text+ displayStyle = if show then "display: block" else "display: none"++ modalInner = [hsx|+ <div class="modal-dialog" role="document" id="modal-inner">+ <div class="modal-content">+ {renderModalHeader modalTitle modalCloseUrl}+ <div class="modal-body">{modalContent}</div>+ {renderModalFooter}+ </div>+ </div>+ |]++ renderModalFooter =+ case modalFooter of+ Just modalFooter -> [hsx|<div class="modal-footer">{modalFooter}</div>|]+ Nothing -> mempty++renderModalHeader :: Text -> Text -> Html+renderModalHeader title closeUrl = [hsx|+ <div class="modal-header">+ <h5 class="modal-title" id="modal-title">{title}</h5>+ <a href={closeUrl} class="btn-close" data-bs-dismiss="modal" aria-label="Close"></a>+ </div>+|]++modal :: (?request :: Request) => Html+modal =+ case unsafePerformIO (readIORef (lookupModalVault modalContainerVaultKey ?request)) of+ Just (ModalContainer html) -> html+ Nothing -> mempty
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2020 digitally induced GmbH++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ ihp-modal.cabal view
@@ -0,0 +1,41 @@+cabal-version: 2.2+name: ihp-modal+version: 1.0.0+synopsis: Modal dialog support for IHP applications+description: Provides modal dialog functionality with Bootstrap-compatible markup.+ Can be used with the full IHP framework or standalone with ihp-context and ihp-hsx.+license: MIT+license-file: LICENSE+author: digitally induced GmbH+maintainer: hello@digitallyinduced.com+homepage: https://ihp.digitallyinduced.com/+bug-reports: https://github.com/digitallyinduced/ihp/issues+copyright: (c) digitally induced GmbH+category: Web, IHP++common shared-properties+ default-language: GHC2021+ build-depends:+ base >= 4.17.0 && < 4.22+ , ihp-context+ , ihp-hsx+ , text+ , blaze-html+ , vault+ , wai+ default-extensions:+ OverloadedStrings+ , ImplicitParams+ , DataKinds+ , RecordWildCards+ , QuasiQuotes+ , OverloadedRecordDot+ ghc-options: -Werror=incomplete-patterns -Werror=unused-imports -Werror=missing-fields++library+ import: shared-properties+ hs-source-dirs: .+ exposed-modules:+ IHP.Modal.Types+ , IHP.Modal.ControllerFunctions+ , IHP.Modal.ViewFunctions