Creating a Haskell Application Using Reflex. Part 3

Tags: haskell, functional, programming, tutorial
Published: 2021-05-24 13:59:49

Author: Nikita Anisimov

[Part 1](https://dev.to/typeable/creating-a-haskell-application-using-reflex-part-1-3kk3)

[Part 2](https://dev.to/typeable/creating-a-haskell-application-using-reflex-part-2-4jaa)

[Part 4](https://dev.to/typeable/creating-a-haskell-application-using-reflex-part-4-4jn7)

Hi there! In this post we’ll discuss how we use the `EventWriter` class and [ghcjs-dom](https://github.com/ghcjs/ghcjs-dom) library.

![](https://blog.typeable.io/images/reflex/3.gif)

## Using EventWriter

In the current implementation, in order to send events from nested levels, we pass them as return values. This is not always convenient, especially when you need to return something in addition to the event (for example, an input form can return both the click event and data from the form). It would be much more convenient to use a mechanism which can send the events to the top level automatically, saving you the trouble of returning them constantly. Such a mechanism – `EventWriter` – does exist. This class allows writing down events, similarly to the standard `Writer` monad. Let's rewrite our application using the `EventWriter`.

To begin with, let’s consider the `EventWriter` class.
```Haskell
class (Monad m, Semigroup w) => EventWriter t w m | m -> t w where
  tellEvent :: Event t w -> m ()
```
Type `w` is exactly the type of our event; this type is an instance of class `Semigroup`, i.e. The values of this type can be combined. If two different events are written using the `tellEvent` and run simultaneously at a point in time, the events have to be combined in some way into one event of the same type so that the monad execution would result in one event.

There is a transformer representing an instance of this class — `EventWriterT`; it can be run using the function `runEventWriterT`.

After that, we start changing the functions. The function `rootWidget` will undergo the biggest changes.
```Haskell
rootWidget :: MonadWidget t m => m ()
rootWidget =
  divClass "container" $ mdo
    elClass "h2" "text-center mt-3" $ text "Todos"
    (_, ev) <- runEventWriterT $ do
      todosDyn <- foldDyn appEndo mempty ev
      newTodoForm
      delimiter
      todoListWidget todosDyn
    blank
```
We’ve added the transformer runner call and got rid of all return events.

Though the changes in the `newTodoForm` are not so dramatic, they are still worth mentioning:
```Haskell
newTodoForm :: (EventWriter t (Endo Todos) m, MonadWidget t m) => m ()
newTodoForm = rowWrapper $ el "form" $ divClass "input-group" $ mdo
  iEl <- inputElement $ def
    & initialAttributes .~
      (  "type" =: "text"
      <> "class" =: "form-control"
      <> "placeholder" =: "Todo" )
    & inputElementConfig_setValue .~ ("" <$ btnEv)
  let
    addNewTodo = \todo -> Endo $ \todos ->
      insert (nextKey todos) (newTodo todo) todos
    newTodoDyn = addNewTodo <$> value iEl
    btnAttr = "class" =: "btn btn-outline-secondary"
      <> "type" =: "button"
  (btnEl, _) <- divClass "input-group-append" $
    elAttr' "button" btnAttr $ text "Add new entry"
  let btnEv = domEvent Click btnEl
  tellEvent $ tagPromptlyDyn newTodoDyn $ domEvent Click btnEl
```
As you can see, the function type has been updated, now it returns nothing. We have also added the required constraint `EventWriter`. Correspondingly, we’ve removed the return value from the function body and now use the `tellEvent` function.

The function `todoListWidget` has become much simpler.
```Haskell
todoListWidget
  :: (EventWriter t (Endo Todos) m, MonadWidget t m)
  => Dynamic t Todos -> m ()
todoListWidget todosDyn = rowWrapper $
  void $ listWithKey (M.fromAscList . IM.toAscList <$> todosDyn) todoWidget
```
Now we don’t care at all about the returned event and, consequently, we don’t need to extract the `Event` from the `Dynamic` anymore.

The `todoWidget` function has also undergone visible changes. Now we don’t need to work with the return type and transform the `Event t (Event t TodoEvent)`. The function `dyn_` differs from `dyn` in that the former ignores the return value.

```Haskell
todoWidget
  :: (EventWriter t (Endo Todos) m, MonadWidget t m)
  => Int -> Dynamic t Todo -> m ()
todoWidget ix todoDyn' = do
  todoDyn <- holdUniqDyn todoDyn'
  dyn_ $ ffor todoDyn $ \td@Todo{..} -> case todoState of
    TodoDone         -> todoDone ix todoText
    TodoActive False -> todoActive ix todoText
    TodoActive True  -> todoEditable ix todoText
```

The only changes in functions `todoDone`, `todoActive` and `todoEditable` are the new type and the event writing instead of returning.
```Haskell
todoActive
  :: (EventWriter t (Endo Todos) m, MonadWidget t m)
  => Int -> Text -> m ()
todoActive ix todoText = divClass "d-flex border-bottom" $ do
  divClass "p-2 flex-grow-1 my-auto" $
    text todoText
  divClass "p-2 btn-group" $ do
    (doneEl, _) <- elAttr' "button"
      (  "class" =: "btn btn-outline-secondary"
      <> "type" =: "button" ) $ text "Done"
    (editEl, _) <- elAttr' "button"
      (  "class" =: "btn btn-outline-secondary"
      <> "type" =: "button" ) $ text "Edit"
    (delEl, _) <- elAttr' "button"
      (  "class" =: "btn btn-outline-secondary"
      <> "type" =: "button" ) $ text "Drop"
    tellEvent $ Endo <$> leftmost
      [ update (Just . toggleTodo) ix <$ domEvent Click doneEl
      , update (Just . startEdit) ix  <$ domEvent Click editEl
      , delete ix <$ domEvent Click delEl
      ]

todoDone
  :: (EventWriter t (Endo Todos) m, MonadWidget t m)
  => Int -> Text -> m ()
todoDone ix todoText = divClass "d-flex border-bottom" $ do
  divClass "p-2 flex-grow-1 my-auto" $
    el "del" $ text todoText
  divClass "p-2 btn-group" $ do
    (doneEl, _) <- elAttr' "button"
      (  "class" =: "btn btn-outline-secondary"
      <> "type" =: "button" ) $ text "Undo"
    (delEl, _) <- elAttr' "button"
      (  "class" =: "btn btn-outline-secondary"
      <> "type" =: "button" ) $ text "Drop"
    tellEvent $ Endo <$> leftmost
      [ update (Just . toggleTodo) ix <$ domEvent Click doneEl
      , delete ix <$ domEvent Click delEl
      ]

todoEditable
  :: (EventWriter t (Endo Todos) m, MonadWidget t m)
  => Int -> Text -> m ()
todoEditable ix todoText = divClass "d-flex border-bottom" $ do
  updTodoDyn <- divClass "p-2 flex-grow-1 my-auto" $
    editTodoForm todoText
  divClass "p-2 btn-group" $ do
    (doneEl, _) <- elAttr' "button"
      (  "class" =: "btn btn-outline-secondary"
      <> "type" =: "button" ) $ text "Finish edit"
    let updTodos = \todo -> Endo $ update (Just . finishEdit todo) ix
    tellEvent $
      tagPromptlyDyn (updTodos <$> updTodoDyn) (domEvent Click doneEl)
```

The use of `EventWriter` class has made the code simpler and more readable.

# ghcjs-dom

`reflex` allows us only to modify `DOM`, but JS applications are often required to do much more. For example, if you need to copy text by clicking a button, `reflex` won’t give us the necessary tools. `ghcjs-dom` library will come to the rescue. Essentially, this is a `JS API` implementation in Haskell. Here you can find the same types and functions you have in JS.

In pure JS, without using third-party libraries, the text copy function may look as follows:

```JavaScript
function toClipboard(txt){
  var inpEl = document.createElement("textarea");
  document.body.appendChild(inpEl);
  inpEl.value = txt
  inpEl.focus();
  inpEl.select();
  document.execCommand('copy');
  document.body.removeChild(inpEl);
}
```

The common practice is to add this event handler, for example, to a button.
What will it look like in Haskell? First of all, we create a new `GHCJS` module to work with `ghcjs` and define the relevant function.

```Haskell
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MonoLocalBinds #-}
module GHCJS where

import Control.Monad
import Data.Functor (($>))
import Data.Text (Text)
import GHCJS.DOM
import GHCJS.DOM.Document
  (createElement, execCommand, getBodyUnchecked)
import GHCJS.DOM.Element as Element hiding (scroll)
import GHCJS.DOM.HTMLElement as HE (focus)
import GHCJS.DOM.HTMLInputElement as HIE (select, setValue)
import GHCJS.DOM.Node (appendChild, removeChild)
import GHCJS.DOM.Types hiding (Event, Text)
import Reflex.Dom as R

toClipboard :: MonadJSM m => Text -> m ()
toClipboard txt = do
  doc <- currentDocumentUnchecked
  body <- getBodyUnchecked doc
  inpEl <- uncheckedCastTo HTMLInputElement <$> createElement doc
    ("textarea" :: Text)
  void $ appendChild body inpEl
  HE.focus inpEl
  HIE.setValue inpEl txt
  HIE.select inpEl
  void $ execCommand doc ("copy" :: Text) False (Nothing :: Maybe Text)
  void $ removeChild body inpEl
```

Almost each line of the haskell function `toClipboard` has a matching line in JS function. It should be mentioned that we don’t have the familiar class `MonadWidget` here. Instead, we use `MonadJSM`, which is the monad that carries out all work using `ghcjs-dom`. The `MonadWidget` class inherits `MonadJSM`. Let’s show how the handler is bound to the event:

```Haskell
copyByEvent :: MonadWidget t m => Text -> Event t () -> m ()
copyByEvent txt ev =
  void $ performEvent $ ev $> toClipboard txt
```

Here we see a new function, `performEvent`, used to bind the handler to the event. This function is a method of class `PerformEvent`:

```Haskell
class (Reflex t, Monad (Performable m), Monad m) => PerformEvent t m | m -> t where
  type Performable m :: * -> *
  performEvent :: Event t (Performable m a) -> m (Event t a)
  performEvent_ :: Event t (Performable m ()) -> m ()
```

Now let’s change the pending task widget after making sure that we’ve added `import GHCJS`:

```Haskell
todoActive
  :: (EventWriter t TodoEvent m, MonadWidget t m) => Int -> Todo -> m ()
todoActive ix Todo{..} =
  divClass "d-flex border-bottom" $ do
    divClass "p-2 flex-grow-1 my-auto" $
      text todoText
    divClass "p-2 btn-group" $ do
      (copyEl, _) <- elAttr' "button"
        (  "class" =: "btn btn-outline-secondary"
        <> "type" =: "button" ) $ text "Copy"
      (doneEl, _) <- elAttr' "button"
        (  "class" =: "btn btn-outline-secondary"
        <> "type" =: "button" ) $ text "Done"
      (editEl, _) <- elAttr' "button"
        (  "class" =: "btn btn-outline-secondary"
        <> "type" =: "button" ) $ text "Edit"
      (delEl, _) <- elAttr' "button"
        (  "class" =: "btn btn-outline-secondary"
        <> "type" =: "button" ) $ text "Drop"
      copyByEvent todoText $ domEvent Click copyEl
      tellEvent $ leftmost
        [ ToggleTodo ix <$ domEvent Click doneEl
        , StartEditTodo ix <$ domEvent Click editEl
        , DeleteTodo ix <$ domEvent Click delEl
        ]
```
We’ve added the new button `Copy` and a specific function call `copyByEvent`. The same can be done with widgets used for other task states.

As usual, the result we’ve obtained can be found [in our repository](https://github.com/typeable/blog-posts-ru/tree/1156cc99d55c1a6e6b45a82675a5fd3a926f8473/reflex-todo).

In the next post, we’ll discuss using JSFFI (JS Foreign Function Interface).