Merge pull request #539 from digitallyinduced/modal-updates

Refactored modals and added documentation on how to use them
digitallyinduced · Nov 8, 2020 · ed66663 · ed66663
2 parents be9b67b + 57c30d5
commit ed66663
Show file tree

Hide file tree

Showing 46 changed files with 275 additions and 135 deletions.
diff --git a/Guide/Makefile b/Guide/Makefile
@@ -29,6 +29,7 @@ HTML_FILES+= auto-refresh.html
 HTML_FILES+= mail.html
 HTML_FILES+= design-goals.html
 HTML_FILES+= troubleshooting.html
+HTML_FILES+= modal.html
 
 all: $(HTML_FILES) bootstrap.css instantclick.js
 

diff --git a/Guide/images/modal/modal-2.png b/Guide/images/modal/modal-2.png
diff --git a/Guide/images/modal/modal.png b/Guide/images/modal/modal.png
diff --git a/Guide/layout.html b/Guide/layout.html
@@ -59,9 +59,11 @@
                 <a class="nav-link secondary" href="auto-refresh.html">Auto Refresh</a>
                 <a class="nav-link secondary" href="package-management.html">Package Management</a>
                 <a class="nav-link secondary" href="deployment.html">Deployment</a>
+                <a class="nav-link secondary" href="design-goals.html">IHP Design Goals</a>
 
 
                 <a class="nav-link headline" href="javascript:alert('The frontend section is coming soon')">Frontend</a>
+                <a class="nav-link secondary" href="modal.html">Modal</a>
                 <a class="nav-link secondary" href="javascript:alert('The frontend section is coming soon')">Static Assets</a>
                 <a class="nav-link secondary" href="javascript:alert('The frontend section is coming soon')">Form Customization</a>
 
@@ -76,9 +78,7 @@
                 <a class="nav-link secondary" href="authorization.html">Authorization</a>
 
                 <a class="nav-link headline" href="recipes.html">Recipes</a>
-								<a class="nav-link headline" href="design-goals.html">IHP Design Goals</a>
-								<a class="nav-link headline" href="troubleshooting.html">Troubleshooting</a>
-
+                <a class="nav-link headline" href="troubleshooting.html">Troubleshooting</a>
 
                 <a class="nav-link headline" href="#">LINKS</a>
                 <a class="nav-link" href="https://github.com/digitallyinduced/ihp" target="_blank">GitHub</a>

diff --git a/Guide/modal.markdown b/Guide/modal.markdown
@@ -0,0 +1,114 @@
+# Modal
+
+```toc
+```
+
+## Introduction
+
+IHP provides support to render [Bootstrap 4 Modals](https://getbootstrap.com/docs/4.5/components/modal/) out of the box. Here's how the result can look like:
+
+![](images/modal/modal.png)
+
+## Layout Setup
+
+Before we can build our modal, we have to make sure that your current application layout has rendering for modals enabled.
+
+Open your `Web/View/Layout.hs` and add a `{modal}` just before the closing `</body>` tag:
+
+```haskell
+defaultLayout :: Html -> Html
+defaultLayout inner = H.docTypeHtml ! A.lang "en" $ [hsx|
+<body>
+    {inner}
+    {modal}
+</body>
+|]
+```
+
+In case there is a `{modal}` already you can skip this step. Don't add the `{modal}` twice.
+
+## Rendering Modal Views
+
+Let's say we have a `ProjectsAction` displaying a list of projects. We have a `NewProjectAction` that you can use to add projects.
+
+```haskell
+data ProjectsController
+    = ProjectsAction
+    | NewProjectAction
+```
+
+Let's turn the `NewProjectAction` into a modal that renders on top of the projects list.
+
+First we need to modify our `NewProjectAction`. It currently looks like this:
+
+```haskell
+action NewProjectAction = do
+    let project = newRecord
+    render NewView { .. }
+```
+
+We need to call `setModal NewView { .. }` to turn the `NewView` into a modal. We also need to call `jumpToAction ProjectsAction` to render the `NewView` on top of the `ProjectsView` which is going to be rendered by the `ProjectsAction`:
+
+```haskell
+action NewProjectAction = do
+    let project = newRecord
+    setModal NewView { .. }
+
+    jumpToAction ProjectsAction
+```
+
+Let's take a look at `/NewPost`, it now looks like this:
+
+![](images/modal/modal-2.png)
+
+The `NewView` is now rendered inside the `ProjectsView` (it's rendered where the `{modal}` is placed). Next we're going to add the modal styling.
+
+## Modal Styling
+
+The `Web/View/Projects/New.hs` view looks like this at the moment:
+
+```haskell
+module Web.View.Projects.New where
+import Web.View.Prelude
+
+data NewView = NewView { project :: Project }
+
+instance View NewView where
+    html NewView { .. } = [hsx|
+        <div class="container">
+            <nav>
+                <ol class="breadcrumb">
+                    <li class="breadcrumb-item"><a href={ProjectsAction}>Projects</a></li>
+                    <li class="breadcrumb-item active">New Project</li>
+                </ol>
+            </nav>
+            <h1>New Project</h1>
+            {renderForm project}
+        </div>
+    |]
+```
+
+We're going to use `renderModal` inside the `html NewView { .. }` definition to turn this into a bootstrap-styled Modal view:
+
+```haskell
+module Web.View.Projects.New where
+import Web.View.Prelude
+
+data NewView = NewView { project :: Project }
+
+instance View NewView where
+    html NewView { .. } = renderModal Modal
+                { modalTitle = "New Project"
+                , modalCloseUrl = pathTo ProjectsAction
+                , modalFooter = Nothing
+                , modalContent = [hsx|
+                        {renderForm project}
+                    |]
+                }
+```
+
+After that our `/NewProject` view looks like this:
+
+![](images/modal/modal.png)
+
+The call to `renderModal Modal { .. }` returns the HTML code for the bootstrap modal. You can think of it as a template function where `modalTitle`, `modaCloseUrl`, etc. just fill in the placeholder variables for the modal.
diff --git a/Guide/troubleshooting.markdown b/Guide/troubleshooting.markdown
@@ -1,8 +1,10 @@
+## Troubleshooting
+
 This page helps you to solve a few common issues with IHP. Longterm we should find solutions for these issues, so that they don't appear every again. Until then, we have this page so that you can find a solution when you paste the error message into Google.
 
 In case your problem cannot be solved with the steps on this page, [join our awesome gitter community](https://gitter.im/digitallyinduced/ihp?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge). We're happy to help!
 
-# Auto Troubleshooting
+## Auto Troubleshooting
 
 Run this to automatically check for the most common IHP issues:
 
@@ -12,7 +14,9 @@ curl https://raw.githubusercontent.com/digitallyinduced/ihp/master/Troubleshoot/
 
 It will tell you what is wrong and the steps you need to do to fix it.
 
-# Makefile:7: /../lib/IHP/Makefile.dist: No such file or directory
+## Common Issues
+
+### Makefile:7: /../lib/IHP/Makefile.dist: No such file or directory
 
 **Problem:**
 
@@ -53,7 +57,7 @@ nix-shell --run 'make build/ihp-lib'
 Now this should succeed.
 
 
-# Running `ihp-new` builds a lot of haskell packages and takes hours to complete
+### Running `ihp-new` builds a lot of haskell packages and takes hours to complete
 
 **Problem:**
 
@@ -63,7 +67,7 @@ When you try to start a new ihp project by running `ihp-new someproject`, nix se
 
 This is most likely caused by a change we did to our binary cache. Run `cachix use digitallyinduced` to fix this.
 
-# warning: substituter 'https://digitallyinduced.cachix.org' does not have a valid signature for path ...
+### warning: substituter 'https://digitallyinduced.cachix.org' does not have a valid signature for path ...
 
 **Problem:**
 
@@ -73,7 +77,7 @@ When running `ihp-new someproject` to create a new project, nix seems to not use
 
 This is caused by a change we did to our binary cache. Open `~/.config/nix/nix.conf`. There take a look at the `trusted-public-keys =` property. You should have two entries there (the public key of our old binary cache, and the new one). Remove the old one `digitallyinduced.cachix.org-1:3mGU1b6u5obFp2VUfI55Xe8/+mawl7y9Eztu3rb94PI= ` (should be first of the two digitallyinduced keys). Then save the file and the problem is fixed.
 
-# error: file '/build/db/.s.PGSQL.5432' has an unsupported type
+### error: file '/build/db/.s.PGSQL.5432' has an unsupported type
 
 **Problem:**
 
@@ -90,7 +94,7 @@ This happens because nix cannot deal the postgres unix socket which is in `build
 
 When the dev server is not running, check that you have no postgres processes belonging to this unix socket running anymore. In case there are no processes running anymore, try to remove the file via `rm -f`.
 
-# `Unbound implicit parameter (?modelContext::ModelContext)`
+### `Unbound implicit parameter (?modelContext::ModelContext)`
 
 Full error message looks like this:
 
@@ -129,7 +133,7 @@ fetchUser name = do
     return users
 ```
 
-# Creating a new IHP project with ihp-new yields git error
+### Creating a new IHP project with ihp-new yields git error
 
 When you followed the steps as described on the getting started page (i.e. installing nix and ihp) but one of the steps
 erred during installation (e.g. connection issues, privileges not set correctly) the cache utilized by nix might not

diff --git a/IHP/Controller/Context.hs b/IHP/Controller/Context.hs
@@ -105,7 +105,7 @@ maybeFromContext = do
 maybeFromFrozenContext :: forall value. (?context :: ControllerContext, Typeable value) => Maybe value
 maybeFromFrozenContext = case ?context of
         FrozenControllerContext { customFields } -> TypeMap.lookup @value customFields
-        ControllerContext {} -> error "maybeFromFrozenContext called on a non frozen context"
+        ControllerContext {} -> error ("maybeFromFrozenContext called on a non frozen context while trying to access " <> (show (Typeable.typeRep (Typeable.Proxy @value))))
 {-# INLINE maybeFromFrozenContext #-}
 
 -- | Puts a value into the context

diff --git a/IHP/Controller/Layout.hs b/IHP/Controller/Layout.hs
@@ -4,6 +4,7 @@ Copyright: (c) digitally induced GmbH, 2020
 -}
 module IHP.Controller.Layout
 ( setLayout
+, getLayout
 , ViewLayout (..)
 ) where
 
@@ -17,3 +18,8 @@ newtype ViewLayout = ViewLayout ((?context :: ControllerContext) => Layout)
 setLayout :: (?context :: ControllerContext) => ((?context :: ControllerContext) => Layout) -> IO ()
 setLayout layout = do
     putContext (ViewLayout layout)
+
+getLayout :: (?context :: ControllerContext) => IO Layout
+getLayout = do
+    (ViewLayout layout) <- fromContext
+    pure layout
diff --git a/IHP/ControllerPrelude.hs b/IHP/ControllerPrelude.hs
@@ -22,6 +22,8 @@ module IHP.ControllerPrelude
     , module IHP.FlashMessages.Types
     , module IHP.FlashMessages.ControllerFunctions
     , module IHP.Controller.Context
+    , module IHP.Modal.Types
+    , module IHP.Modal.ControllerFunctions
     , Only (..)
     ) where
 import IHP.Prelude
@@ -48,4 +50,7 @@ import IHP.Mail (sendMail)
 import Database.PostgreSQL.Simple.Types (Only (..))
 import IHP.FlashMessages.Types
 import IHP.FlashMessages.ControllerFunctions
-import IHP.Controller.Context
+import IHP.Controller.Context
+
+import IHP.Modal.Types
+import IHP.Modal.ControllerFunctions
diff --git a/IHP/ControllerSupport.hs b/IHP/ControllerSupport.hs
@@ -19,6 +19,7 @@ module IHP.ControllerSupport
 , runActionWithNewContext
 , respondAndExit
 , ResponseException (..)
+, jumpToAction
 ) where
 
 import ClassyPrelude
@@ -88,6 +89,12 @@ runActionWithNewContext controller = do
         Right context -> do
             runAction controller
 
+jumpToAction :: forall action. (Controller action, ?context :: ControllerContext, ?modelContext :: ModelContext) => action -> IO ()
+jumpToAction theAction = do
+    let ?theAction = theAction
+    beforeAction @action
+    action theAction
+
 {-# INLINE getRequestBody #-}
 getRequestBody :: (?context :: ControllerContext) => IO ByteString
 getRequestBody = Network.Wai.getRequestBodyChunk request

diff --git a/IHP/IDE/CodeGen/View/Generators.hs b/IHP/IDE/CodeGen/View/Generators.hs
@@ -4,7 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.CodeGen.Types
 import qualified Data.Text as Text
 import IHP.IDE.SchemaDesigner.View.Layout

diff --git a/IHP/IDE/CodeGen/View/NewAction.hs b/IHP/IDE/CodeGen/View/NewAction.hs
@@ -4,7 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.SchemaDesigner.View.Layout
 import IHP.IDE.CodeGen.Types
 import IHP.IDE.CodeGen.View.Generators (renderPlan)

diff --git a/IHP/IDE/CodeGen/View/NewApplication.hs b/IHP/IDE/CodeGen/View/NewApplication.hs
@@ -4,7 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.SchemaDesigner.View.Layout
 import IHP.IDE.CodeGen.Types
 import IHP.IDE.CodeGen.View.Generators (renderPlan)

diff --git a/IHP/IDE/CodeGen/View/NewController.hs b/IHP/IDE/CodeGen/View/NewController.hs
@@ -5,7 +5,6 @@ import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.CodeGen.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.SchemaDesigner.View.Layout
 import qualified IHP.IDE.CodeGen.ControllerGenerator as ControllerGenerator
 import qualified Data.Text as Text

diff --git a/IHP/IDE/CodeGen/View/NewMail.hs b/IHP/IDE/CodeGen/View/NewMail.hs
@@ -4,7 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.SchemaDesigner.View.Layout
 import IHP.IDE.CodeGen.Types
 import IHP.IDE.CodeGen.View.Generators (renderPlan)

diff --git a/IHP/IDE/CodeGen/View/NewScript.hs b/IHP/IDE/CodeGen/View/NewScript.hs
@@ -4,7 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.SchemaDesigner.View.Layout
 import IHP.IDE.CodeGen.Types
 import IHP.IDE.CodeGen.View.Generators (renderPlan)

diff --git a/IHP/IDE/CodeGen/View/NewView.hs b/IHP/IDE/CodeGen/View/NewView.hs
@@ -4,7 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.SchemaDesigner.View.Layout
 import IHP.IDE.CodeGen.Types
 import IHP.IDE.CodeGen.View.Generators (renderPlan)

diff --git a/IHP/IDE/Data/View/EditRow.hs b/IHP/IDE/Data/View/EditRow.hs
@@ -4,7 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.SchemaDesigner.View.Layout
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.Data.View.ShowDatabase
@@ -34,7 +33,7 @@ instance View EditRowView where
             </div>
             {customQuery ""}
         </div>
-        {Just modal}
+        {renderModal modal}
     |]
         where
             tableBody = [hsx|<tbody>{forEach rows renderRow}</tbody>|]

diff --git a/IHP/IDE/Data/View/EditValue.hs b/IHP/IDE/Data/View/EditValue.hs
@@ -4,7 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.SchemaDesigner.View.Layout
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.Data.View.ShowDatabase

diff --git a/IHP/IDE/Data/View/NewRow.hs b/IHP/IDE/Data/View/NewRow.hs
@@ -4,7 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.SchemaDesigner.View.Layout
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.Data.View.ShowDatabase
@@ -29,7 +28,7 @@ instance View NewRowView where
             </div>
             {customQuery ""}
         </div>
-        {Just modal}
+        {renderModal modal}
     |]
         where
             tableBody = [hsx|<tbody>{forEach rows renderRow}</tbody>|]

diff --git a/IHP/IDE/Data/View/ShowDatabase.hs b/IHP/IDE/Data/View/ShowDatabase.hs
@@ -4,7 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.SchemaDesigner.View.Layout
 import IHP.IDE.Data.View.Layout
 

diff --git a/IHP/IDE/Data/View/ShowQuery.hs b/IHP/IDE/Data/View/ShowQuery.hs
@@ -4,7 +4,6 @@ import IHP.ViewPrelude
 import IHP.IDE.SchemaDesigner.Types
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.ToolServer.Layout
-import IHP.View.Modal
 import IHP.IDE.SchemaDesigner.View.Layout
 import IHP.IDE.ToolServer.Types
 import IHP.IDE.Data.View.ShowDatabase