Creating a Haskell Application Using Reflex. Part 2

Part 1

Part 3

Part 4

Hi there! Let’s continue with our series of tutorials devoted to the development of Reflex-based web applications. In this part, we’ll add the ability to carry out various manipulations on the task list.

Operations on Todo

Let’s make it possible to tick the tasks off as completed, as well as edit and delete them. First of all, we extend the Todo type by adding the state. If the task is not completed, you can edit it.

data TodoState
  = TodoDone
  | TodoActive { stateEdit :: Bool }
  deriving (Generic, Eq, Show)

data Todo = Todo
  { todoText  :: Text
  , todoState :: TodoState }
  deriving (Generic, Eq, Show)

newTodo :: Text -> Todo
newTodo todoText = Todo { todoState = TodoActive False, .. }

After that, we define the events occurring in the system. In our business projects, we used two approaches to this end. The first approach implies enumerating all possible events as individual constructors and implementing the handler function that will update the state depending on the occurred event.

data TodoEvent
  = NewTodo Todo
  | ToggleTodo Int
  | StartEditTodo Int
  | FinishEditTodo (Text,Int)
  | DeleteTodo Int
  deriving (Generic, Eq, Show)

The advantages of this approach include the ability to see what event specifically is taking place in the system and the update it’s carrying (all this is done by the traceEvent function). Nevertheless, it’s not always possible to use the advantages, especially when the event carries a lot of data which is eventually hard to analyze. If you still need to see the values change, the events change Dynamic in any case and you can also trace its value using the function traceDyn.

The second approach is to use the update functions represented as the monoid Endo (roughly speaking, this is an abstraction of the functions whose argument and result types coincide). The essence of this approach is that the value carried by the update event is the function that defines the update logic itself. In this case, we lose the ability to display the event value (as it turns out, this ability is not always useful), but the obvious advantage is that you don’t need to have access to the current status, create the type including all possible events (which can be quite numerous), or define an individual handler to update the state according to the received event.

In this tutorial, we will use the second approach.

Let’s change the structure of the root widget:

rootWidget :: MonadWidget t m => m ()
rootWidget =
  divClass "container" $ do
    elClass "h2" "text-center mt-3" $ text "Todos"
    newTodoEv <- newTodoForm
    rec
      todosDyn <- foldDyn appEndo mempty $ leftmost [newTodoEv, todoEv]
      delimiter
      todoEv <- todoListWidget todosDyn
    blank

What we see here in the first place is the use of the RecursiveDo extension (so you need to enable it). This is one of the most widespread practices in the development of reflex applications because the situations when the event occurring at the bottom of the page affects the elements at the top of the page happen pretty often. In this case, the event todoEv is used to define todosDyn, while todosDyn, in its turn, is the argument for the widget the todoEv event comes from.

After that, we see the update of the foldDyn function parameters. Here the new function leftmost is used. It accepts the events list and returns the event occurring at the moment when any of the events from the events list occurs. If two events from the list occur at a given moment, the leftmost event will be returned (hence the name). The task list is not a list now but IntMap (for the sake of simplicity, we’ll use type Todos = IntMap Todo). In the first place, this is done to allow us to access an element directly by the identifier. appEndo is used to update the list. If we defined each event as an individual constructor, we’d have also had to define the handler function, which would look approximately as follows:

updateTodo :: TodoEvent -> Todos -> Todos
updateTodo ev todos = case ev of
  NewTodo todo           -> nextKey todos =: todo <> todos
  ToggleTodo ix          -> update (Just . toggleTodo) ix todos
  StartEditTodo ix       -> update (Just . startEdit) ix todos
  FinishEditTodo (v, ix) -> update (Just . finishEdit v) ix todos
  DeleteTodo ix          -> delete ix todos

Though it’s not necessary to define this function, we are using several other auxiliary functions here, which we’ll need further, anyway.

startEdit :: Todo -> Todo
startEdit todo = todo { todoState = TodoActive True }

finishEdit :: Text -> Todo -> Todo
finishEdit val todo = todo
  { todoState = TodoActive False, todoText = val }

toggleTodo :: Todo -> Todo
toggleTodo Todo{..} = Todo {todoState = toggleState todoState,..}
  where
    toggleState = \case
      TodoDone     -> TodoActive False
      TodoActive _ -> TodoDone

nextKey :: IntMap Todo -> Int
nextKey = maybe 0 (succ . fst . fst) . maxViewWithKey

The function adding a new element has also changed and now returns the event, not the task itself. Let’s also add the field cleanup after the new task is added.

newTodoForm :: MonadWidget t m => m (Event t (Endo Todos))
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
  pure $ tagPromptlyDyn newTodoDyn $ domEvent Click btnEl

Function todoListWidget now returns the task change. It has slightly changed, too:

todoListWidget :: MonadWidget t m => Dynamic t Todos -> m (Event t (Endo Todos))
todoListWidget todosDyn = rowWrapper $ do
  evs <- listWithKey
    (M.fromAscList . IM.toAscList <$> todosDyn) todoWidget
  pure $ switchDyn $ leftmost . M.elems <$> evs

The first thing we notice is that the simpleList function is replaced with listWithKey. They differ from each other in the type of the first parameter – the first function accepts the list [], the second one accepts Map. The list will be sorted by the key. Here the returned value is important. Each task returns an event (deletion, change). In our specific case, the listWithKey function will look as follows:

listWithKey
  :: MonadWidget t m
  => Dynamic t (Map Int Todo)
  -> (Int -> Dynamic t Todo -> m (Event t TodoEvent))
  -> m (Dynamic t (Map Int TodoEvent))

Note: this function is a part of the reflex package and has a more complex type. Here we show the specialized type.

Here we are using the familiar leftmost function for all Map values. The expression leftmost . elems <$> evs is of the following type: Dynamic t (Event t TodoEvent). We use function switchDyn to retrieve the Event from the Dynamic. This function operates in the following way: it returns the event occurring when the internal event takes place. If the Dynamic and Event occur simultaneously, the previous Event will be returned until the event in the Dynamic is updated. The function switchPromtlyDyn operates differently: if the Dynamic update, occurrence of the event existing before the Dynamic update, and triggering of the event now containing the Dynamic take place simultaneously, the new event containing the Dynamic will be returned. If this situation is not possible, it’s always better to use the switchDyn because the switchPromtlyDyn function is more complex, performs additional operations and, moreover, can create cycles.

The task has acquired different states, which is why the function representing one task has also changed:

todoWidget :: MonadWidget t m => Int -> Dynamic t Todo -> m (Event t (Endo Todos))
todoWidget ix todoDyn = do
  todoEvEv <- dyn $ ffor todoDyn $ \td@Todo{..} -> case todoState of
    TodoDone         -> todoDone ix todoText
    TodoActive False -> todoActive ix todoText
    TodoActive True  -> todoEditable ix todoText
  switchHold never todoEvEv

Here we’re using the new function dyn. It has the following type:

dyn
  :: (Adjustable t m, NotReady t m, PostBuild t m)
  => Dynamic t (m a)
  -> m (Event t a)

It accepts the widget wrapped in the Dynamic as the input parameter. This means that each update of the Dynamic will be followed by the DOM update. The output value is the event carrying the value the widget returns. In our case, the specialized type will look as follows:

dyn
  :: MonadWidget t m
  => Dynamic t (m (Event t (Endo Todos)))
  -> m (Event t (Event t (Endo Todos)))

Here we come across an event nested into another event. Two functions from the reflex package can perform operations on such type: coincidence and switchHold. The first function returns the event occurring only when the external and internal events occur simultaneously. That’s not our case. Function switchHold is of the following type:

switchHold :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t)

This function switches to the new event each time the external event occurs. The event passed as the first parameter will hold until the external event occurs for the first time. This is exactly the way we’re using this function in our example. No event can come from the list until the list is changed for the first time, so we use the never event. As the name implies, this is a special event that never occurs.

Function todoWidget uses different widgets for different states.

todoActive :: MonadWidget t m => Int -> Text -> m (Event t (Endo Todos))
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"
    pure $ Endo <$> leftmost
      [ update (Just . toggleTodo) ix <$ domEvent Click doneEl
      , update (Just . startEdit) ix  <$ domEvent Click editEl
      , delete ix <$ domEvent Click delEl
      ]

todoDone :: MonadWidget t m => Int -> Text -> m (Event t (Endo Todos))
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"
    pure $ Endo <$> leftmost
      [ update (Just . toggleTodo) ix <$ domEvent Click doneEl
      , delete ix <$ domEvent Click delEl
      ]

todoEditable :: MonadWidget t m => Int -> Text -> m (Event t (Endo Todos))
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
    pure $
      tagPromptlyDyn (updTodos <$> updTodoDyn) (domEvent Click doneEl)

editTodoForm :: MonadWidget t m => Text -> m (Dynamic t Text)
editTodoForm todo = do
  editIEl <- inputElement $ def
    & initialAttributes .~
      (  "type" =: "text"
      <> "class" =: "form-control"
      <> "placeholder" =: "Todo")
    & inputElementConfig_initialValue .~ todo
  pure $ value editIEl

All functions used here were described before, so we won’t go into detail explaining each individual function.

Optimization

Let’s get back to the listWithKey function:

listWithKey
  :: MonadWidget t m
  => Dynamic t (Map Int Todo)
  -> (Int -> Dynamic t Todo -> m (Event t TodoEvent))
  -> m (Dynamic t (Map Int TodoEvent))

The function operates in such a way that any update of the transmitted Dynamic will initiate the update of each individual element. Even if we, say, change a single element, the update will be passed to each element, though it won’t change the value. Now let’s get back to the todoWidget function.

todoWidget :: MonadWidget t m => Int -> Dynamic t Todo -> m (Event t (Endo Todos))
todoWidget ix todoDyn = do
  todoEvEv <- dyn $ ffor todoDyn $ \td@Todo{..} -> case todoState of
    TodoDone         -> todoDone ix todoText
    TodoActive False -> todoActive ix todoText
    TodoActive True  -> todoEditable ix todoText
  switchHold never todoEvEv

As you remember, the dyn function updates the DOM every time the todoDyn is updated. Considering that the change in one element of the list is passed to each element individually, it turns out that the entire DOM section which displays our tasks will be rebuilt (you can check this using the developer panel in the browser). Obviously, this is not what we want. This is when the holdUniqDyn function comes to the rescue.

todoWidget :: MonadWidget t m => Int -> Dynamic t Todo -> m (Event t TodoEvent)
todoWidget ix todoDyn' = do
  todoDyn <- holdUniqDyn todoDyn'
  todoEvEv <- dyn $ ffor todoDyn $ \td@Todo{..} -> case todoState of
    TodoDone         -> todoDone ix td
    TodoActive False -> todoActive ix td
    TodoActive True  -> todoEditable ix td
  switchHold never todoEvEv

We’ve added the line todoDyn <- holdUniqDyn todoDyn'. What’s going on here? The matter is that though the Dynamic operates, the value it contains remains unchanged. Function holdUniqDyn works just this way, so that if the Dynamic passed to it operates and hasn’t changed its value, the output Dynamic won’t operate and, consequently, in our case, the DOM won’t be rebuilt unnecessarily.

The result we obtained can be viewed in our repository.

In the next part, we’ll consider another way of managing the events and the use of the GHCJS-DOM library.