Merge pull request #843 from digitallyinduced/ssc

Serverside components

Guide/Makefile

@@ -42,6 +42,7 @@ HTML_FILES+= websockets.html
 HTML_FILES+= helpful-tips.html
 HTML_FILES+= assets.html
 HTML_FILES+= file-storage.html
+HTML_FILES+= server-side-components.html
 
 all: $(HTML_FILES) bootstrap.css instantclick.js
 

Guide/layout.html

@@ -68,6 +68,7 @@
                 <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 secondary" href="server-side-components.html">Server-Side Components</a>
 
 
                 <a class="nav-link headline" href="tailwindcss.html">Frontend</a>

Guide/server-side-components.markdown

@@ -0,0 +1,218 @@
+# Server-Side Components
+
+```toc
+
+```
+
+## Introduction
+
+IHP Server-Side Components provide a toolkit for building interactive client-side functionality without needing to write too much javascript.
+
+A Server-Side Component consist of a state object, a set of actions and a `render` function.
+
+The typical lifecycle is like this:
+1. The component is rendered based as part of a view
+2. Once loaded, elements inside the component, e.g. a button, can call server-side actions using a simple javascript library
+3. On the server-side the actions are evaluated and a new state object is generated
+4. The new state will trigger a re-render
+5. The re-rendered content will be diffed with the existing HTML and then HTML update instructions will be sent to client and the view is updated accordingly
+6. Repeat at step 2
+7. The component is stopped when the page is closed
+
+The Server-Side Component toolkit is currently still in a early development stage. So expect bugs and API changes.
+
+## Creating a Component
+
+In this example we're building a counter component: The counter shows a number. When a button is clicked the number will be incremented.
+
+To create this new component first we're creating a new file at `Web/Component/Counter.hs` (the `Component` directory likely does not exist yet, so you need to create it):
+
+```haskell
+module Web.Component.Counter where
+
+import IHP.ViewPrelude
+import IHP.ServerSideComponent.Types
+import IHP.ServerSideComponent.ControllerFunctions
+
+-- The state object
+data Counter = Counter { value :: !Int }
+
+-- The set of actions
+data CounterController
+    = IncrementCounterAction
+    deriving (Eq, Show, Data)
+
+$(deriveSSC ''CounterController)
+
+-- The render function and action handlers
+instance Component Counter CounterController where
+    initialState = Counter { value = 0 }
+
+    render Counter { value } = [hsx|
+        Current: {value} <br />
+        <button onclick="callServerAction('IncrementCounterAction')">Plus One</button>
+    |]
+
+    action state IncrementCounterAction = do
+        state
+            |> incrementField #value
+            |> pure
+
+instance SetField "value" Counter Int where setField value' counter = counter { value = value' }
+```
+
+You can see that the `Counter` component has a state object with a number `data Counter = Counter { value :: !Int }`. It has only one action `IncrementCounterAction`. The `initialState = Counter { value = 0 }` means that the counter starts at 0.
+
+Inside the `render` function you can see how server-side actions are triggered from the client-side:
+
+```html
+<button onclick="callServerAction('IncrementCounterAction')">Plus One</button>
+```
+
+When the `callServerAction('IncrementCounterAction')` is called, it will trigger the `action state IncrementCounterAction = do` haskell block to be called on the server.
+
+You can see that the `action` handler get's passed the current state and will return a new state based on the action and the current state.
+
+### FrontController
+
+To make the component available to the app, we need to add it to our `Web.FrontController`.
+
+Open the `Web/FrontController.hs` and add these imports:
+
+```haskell
+import IHP.ServerSideComponent.RouterFunctions
+import Web.Component.Counter
+```
+
+Inside the `instance FrontController WebApplication` add a `routeComponent @Counter`:
+
+```haskell
+
+instance FrontController WebApplication where
+    controllers = 
+        [ startPage WelcomeAction
+        -- ...
+        , routeComponent @Counter
+        ]
+```
+
+Now the websocket server for Counter is activated.
+
+### Using the Component
+
+We're adding the component to the standard Welcome view inside our project. But you can use it basically on any view you want.
+
+Open the `Web/View/Static/Welcome.hs` and add these imports:
+
+```haskell
+import IHP.ServerSideComponent.ViewFunctions
+import Web.Component.Counter
+```
+
+Now we change the welcome view to this:
+
+```haskell
+instance View WelcomeView where
+    html WelcomeView = [hsx|
+        <h1>Counter</h1>
+
+        {counter}
+    |]
+        where
+            counter = component @Counter
+```
+
+If you wonder why we're using the `where` instead of writing `{component @Counter}`: Currently the at-symbol `@` is not supported in HSX expressions.
+
+We also need to load the `ihp-ssc.js` from our `Layout.hs`. Open the `Web/View/Layout.hs` and add `<script src="/vendor/ihp-ssc.js"></script>` inside your `scripts` section:
+
+```
+scripts :: Html
+scripts = [hsx|
+        <!-- ... ->
+        <script src="/vendor/ihp-ssc.js"></script>
+    |]
+```
+
+Now when opening the `WelcomeView` you will see the newly created counter.
+
+## Advanced
+
+### Actions with Parameters
+
+Let's say we have actions like this:
+
+```haskell
+data BooksTableController
+    = SetSearchQuery { searchQuery :: Text }
+    | SetOrderBy { column :: Text }
+    deriving (Eq, Show, Data, Read)
+```
+
+To call the `SetSearchQuery` action with a specific `searchQuery` value, we can pass this to `callServerAction`:
+
+```html
+<input
+    type="text"
+    value={inputValue searchQuery}
+    onkeyup="callServerAction('SetSearchQuery', { searchQuery: this.value })"
+/>
+```
+
+### Fetching from the Database
+
+You can use the typical IHP database operations like `query @Post` or `createRecord` from your actions.
+
+To fill the inital data you can use the `componentDidMount` lifecycle function:
+
+```haskell
+data PostsTable = PostsTable
+    { posts :: Maybe [Post]
+    }
+    deriving (Eq, Show)
+
+
+instance Component PostsTable PostsTableController where
+    initialState = PostsTable { posts = Nothing }
+
+    componentDidMount state = do
+        books <- query @Post |> fetch
+
+        state
+            |> setJust #posts posts
+            |> pure
+
+    render PostsTable { .. } = [hsx|
+        {when (isNothing posts) loadingIndicator}
+        {forEach posts renderPost}
+    |]
+```
+
+The `componentDidMount` get's passed the initial state and returns a new state. It's called right after the first render once the client has wired up the WebSocket connection.
+
+When the `posts` field is set to `Nothing` we know that the data is still being fetched. In that case we render a loading spinner inside our `render` function.
+
+### HTML Diffing & Patching
+
+IHP uses a HTML Diff & Patch approach to update the components HTML. You can see this by analysing the data that is sent over the WebSocket connection.
+
+In the above example, when the `Plus One` button of the counter is clicked, the client will send the following message to the server using the WebSocket connection:
+
+```javascript
+{"action":"IncrementCounterAction"}
+```
+
+After that the server will respond:
+
+```haskell
+[{"type":"UpdateTextContent","textContent":"Current: 1","path":[0]}]
+```
+
+So the server only responds with update instructions that transform the counter's `Current: 0 ` to `Counter: 1`.
+
+This is useful if you have many interactive elements that are controlled by javascript libraries (e.g. a. `<video>` element that is playing). As long as the HTML code of these interactive elements doesn't change on the server-side, the DOM nodes will not be touched by IHP.
+
+
+### Example Components
+
+If you want to see some more code, you can find components inside the [IHP SSC Playground](https://github.com/digitallyinduced/ihp-ssc-playground/tree/master/Web/Component) or inside the [`ihp-ssc-block-editor-demo` repository](https://github.com/digitallyinduced/ihp-ssc-block-editor-demo/blob/master/Web/Component/BlockEditor.hs).

IHP/Fetch.hs

@@ -22,6 +22,7 @@ module IHP.Fetch
 , genericFetchIdsOne
 , fetchCount
 , fetchExists
+, fetchSQLQuery
 )
 where
 
@@ -226,3 +227,9 @@ instance (model ~ GetModelById (Id' table), value ~ Id' table, HasField "id" mod
     fetchOneOrNothing = genericfetchIdsOneOrNothing
     {-# INLINE fetchOne #-}
     fetchOne = genericFetchIdsOne
+
+fetchSQLQuery :: (PG.FromRow model, ?modelContext :: ModelContext) => SQLQuery -> IO [model]
+fetchSQLQuery theQuery = do
+    let (sql, theParameters) = toSQL' theQuery
+    trackTableRead (get #selectFrom theQuery)
+    sqlQuery (Query $ cs sql) theParameters

IHP/ModelSupport.hs

@@ -37,7 +37,7 @@ import qualified Control.Newtype.Generics as Newtype
 import Control.Applicative (Const)
 import qualified GHC.Types as Type
 import qualified Data.Text as Text
-import Data.Aeson (ToJSON (..))
+import Data.Aeson (ToJSON (..), FromJSON (..))
 import qualified Data.Aeson as Aeson
 import qualified Data.Set as Set
 import qualified Text.Read as Read
@@ -699,6 +699,8 @@ fieldWithUpdate name model
 instance (ToJSON (PrimaryKey a)) => ToJSON (Id' a) where
   toJSON (Id a) = toJSON a
 
+instance (FromJSON (PrimaryKey a)) => FromJSON (Id' a) where
+    parseJSON value = Id <$> parseJSON value
 
 -- | Thrown by 'fetchOne' when the query result is empty
 data RecordNotFoundException

IHP/QueryBuilder.hs

@@ -46,6 +46,10 @@ module IHP.QueryBuilder
 , toSQL
 , toSQL'
 , buildQuery
+, SQLQuery (..)
+, OrderByClause (..)
+, OrderByDirection (..)
+, Condition (..)
 , innerJoin
 , innerJoinThirdTable
 , HasQueryBuilder

IHP/ServerSideComponent/Controller/ComponentsController.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE  UndecidableInstances #-}
+module IHP.ServerSideComponent.Controller.ComponentsController where
+
+import IHP.ControllerPrelude
+import IHP.ServerSideComponent.Types as SSC
+import IHP.ServerSideComponent.ControllerFunctions as SSC
+
+import qualified Data.Aeson as Aeson
+import qualified Text.Blaze.Html.Renderer.Text as Blaze
+
+instance (Component component controller, FromJSON controller) => WSApp (ComponentsController component) where
+    initialState = ComponentsController
+
+    run = do
+        let state :: component = SSC.initialState
+        instanceRef <- newIORef (ComponentInstance { state })
+        let ?instanceRef = instanceRef
+
+        nextState <- componentDidMount state
+        SSC.setState nextState
+
+        forever do
+            actionPayload :: LByteString <- receiveData
+
+            let theAction = Aeson.eitherDecode @controller actionPayload
+
+            case theAction of
+                Right theAction -> do
+                    currentState <- SSC.getState
+
+                    nextState <- SSC.action currentState theAction
+                    SSC.setState nextState
+                Left error -> putStrLn (cs error)

IHP/ServerSideComponent/ControllerFunctions.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-|
+Module: IHP.ServerSideComponent.ControllerFunctions
+Copyright: (c) digitally induced GmbH, 2021
+-}
+module IHP.ServerSideComponent.ControllerFunctions where
+
+import IHP.Prelude
+import IHP.ControllerPrelude
+import IHP.ServerSideComponent.Types as SSC
+
+import qualified Network.WebSockets as WebSocket
+import qualified Text.Blaze.Html.Renderer.Text as Blaze
+
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.TH as Aeson
+
+import IHP.ServerSideComponent.HtmlParser
+import IHP.ServerSideComponent.HtmlDiff
+
+setState :: (?instanceRef :: IORef (ComponentInstance state), ?connection :: WebSocket.Connection, Component state action, ?context :: ControllerContext) => state -> IO ()
+setState state = do
+    oldState <- get #state <$> readIORef ?instanceRef
+    let oldHtml = oldState
+            |> SSC.render
+            |> Blaze.renderHtml
+            |> cs
+    let newHtml = state
+            |> SSC.render
+            |> Blaze.renderHtml
+            |> cs
+
+    modifyIORef' ?instanceRef (\componentInstance -> componentInstance { state })
+
+    case diffHtml oldHtml newHtml of
+        Left error -> putStrLn (tshow error)
+        Right patches -> sendTextData (Aeson.encode patches)
+
+
+getState :: _ => _
+getState = get #state <$> readIORef ?instanceRef
+
+deriveSSC = Aeson.deriveJSON Aeson.defaultOptions { sumEncoding = defaultTaggedObject { tagFieldName = "action", contentsFieldName = "payload" }}
+
+
+$(Aeson.deriveJSON Aeson.defaultOptions { sumEncoding = defaultTaggedObject { tagFieldName = "type" }} ''Node)
+$(Aeson.deriveJSON Aeson.defaultOptions { sumEncoding = defaultTaggedObject { tagFieldName = "type" }} ''Attribute)
+$(Aeson.deriveJSON Aeson.defaultOptions { sumEncoding = defaultTaggedObject { tagFieldName = "type" }} ''NodeOperation)
+$(Aeson.deriveJSON Aeson.defaultOptions { sumEncoding = defaultTaggedObject { tagFieldName = "type" }} ''AttributeOperation)