Hi there! In this post we’ll discuss how we use the EventWriter
class and ghcjs-dom library.
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.
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.
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:
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.
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.
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.
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.
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:
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.
{-# 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:
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
:
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
:
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.
In the next post, we’ll discuss using JSFFI (JS Foreign Function Interface).
Typeable OU ("us", "we", or "our") operates https://typeable.io (the "Site"). This page informs you of our policies regarding the collection, use and disclosure of Personal Information we receive from users of the Site.
We use your Personal Information only for providing and improving the Site. By using the Site, you agree to the collection and use of information in accordance with this policy.
While using our Site, we may ask you to provide us with certain personally identifiable information that can be used to contact or identify you. Personally identifiable information may include, but is not limited to your name ("Personal Information").
Like many site operators, we collect information that your browser sends whenever you visit our Site ("Log Data").
This Log Data may include information such as your computer's Internet Protocol ("IP") address, browser type, browser version, the pages of our Site that you visit, the time and date of your visit, the time spent on those pages and other statistics.
In addition, we may use third party services such as Google Analytics that collect, monitor and analyze this ...
Cookies are files with small amount of data, which may include an anonymous unique identifier. Cookies are sent to your browser from a web site and stored on your computer's hard drive.
Like many sites, we use "cookies" to collect information. You can instruct your browser to refuse all cookies or to indicate when a cookie is being sent. However, if you do not accept cookies, you may not be able to use some portions of our Site.
The security of your Personal Information is important to us, so we don't store any personal information and use third-party GDPR-compliant services to store contact data supplied with a "Contact Us" form and job applications data, suplied via "Careers" page.
This Privacy Policy is effective as of @@privacePolicyDate and will remain in effect except with respect to any changes in its provisions in the future, which will be in effect immediately after being posted on this page.
We reserve the right to update or change our Privacy Policy at any time and you should check this Privacy Policy periodically. Your continued use of the Service after we post any modifications to the Privacy Policy on this page will constitute your acknowledgment of the modifications and your consent to abide and be bound by the modified Privacy Policy.
If we make any material changes to this Privacy Policy, we will notify you either through the email address you have provided us, or by placing a prominent notice on our website.
If you have any questions about this Privacy Policy, please contact us.