Create a Haskell web application using Reflex. Part 3
Part 1.
Part 2.
Hello everyone! In this part, we will look at using the class EventWriter and libraries ghcjs-dom…
Using EventWriter
Now, in order to throw events from deeper levels, we pass them as return values. This is not always convenient, especially when you need to return something other than an event (for example, an input form can return both a button click event and data from a form at the same time). It would be much more convenient to use a mechanism that can “throw” events up automatically, without thinking about the fact that you need to constantly return them. And there is such a mechanism – EventWriter… This class allows you to write events like the standard monad Writer… Let’s rewrite our application using EventWriter…
First, let’s look at the class itself. EventWriter:
class (Monad m, Semigroup w) => EventWriter t w m | m -> t w where
tellEvent :: Event t w -> m ()A type w this is exactly the type of our event, and this type is an instance of the class Semigroup, i.e. values of this type can be combined with each other. In the event that two different events are recorded using tellEvent, and they are triggered at one and the same moment, then they must somehow be combined into one event of the same type so that the result of the execution of the monad is one event.
There is a transformer being an instance of this class – EventWriterT, to run it, use the function runEventWriterT…
Next, we move on to changing the functions. The biggest changes await feature rootWidget…
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
blankWe added the launch of the transformer and got rid of all returned events.
Changes in newTodoForm not so big, but still worth noting:
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 btnElWe see that the type of the function has been updated, now it does not return anything, and the necessary constraint has been added EventWriter… In the body of the function, respectively, we got rid of the return value and now use the function tellEvent…
Function todoListWidget greatly simplified.
todoListWidget
:: (EventWriter t (Endo Todos) m, MonadWidget t m)
=> Dynamic t Todos -> m ()
todoListWidget todosDyn = rowWrapper $
void $ listWithKey (M.fromAscList . IM.toAscList <$> todosDyn) todoWidgetNow we are not interested in the returned event at all, and, accordingly, there is no need to retrieve Event of Dynamic…
In function todoWidget there have also been noticeable changes. You no longer need to work with the return type – convert Event t (Event t TodoEvent)… Feature Difference dyn_ from function dyn, in that it ignores the return value.
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 todoTextThe only change in features todoDone, todoActive and todoEditable it is a new type and record of the event instead of returning it.
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)Class application EventWriter simplified the code and made it more readable.
ghcjs-dom
reflex only allows us to modify DOM, but often more is required from JS applications. For example, if you want to copy the text by clicking on the button, then reflex does not provide the means we need to do this. The library comes to the rescue ghcjs-dom… Essentially, this is an implementation JS API in Haskell. In it you can find all the same types and functions that are in JS.
In pure JS, without using third-party libraries, the text copying function might look like this:
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);
}In the usual use, we hang this handler, for example, on a button.
How would it look in Haskell? First of all, let’s create a new module GHCJS to work with ghcjs and define the corresponding function.
{-# 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 inpElAlmost every line from the haskell function toClipboard there is a correspondence from the JS function. It is worth noting that there is no familiar class here. MonadWidget, and used MonadJSM – this is the monad in which all work is done using ghcjs-dom… Class MonadWidget inherits class MonadJSM… Let’s see how the handler is bound to the event:
copyByEvent :: MonadWidget t m => Text -> Event t () -> m ()
copyByEvent txt ev =
void $ performEvent $ ev $> toClipboard txtHere we see a new function for us performEvent, and it is used to bind the handler to the event. It is a method of the class PerformEvent:
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 we will change the widget of the uncompleted task, having previously not forgotten to add the import import GHCJS:
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
]A new button has been added Copy and calling a specific function copyByEvent… You can do the same with widgets for other job states.
The result, as always, can be viewed in our repository…
In the next part, we’ll look at using JSFFI (JS Foreign Function Interface).
