Your Web News in One Place

Help Webnuz

Referal links:

Sign up for GreenGeeks web hosting
May 24, 2021 01:59 pm GMT

Creating a Haskell Application Using Reflex. Part 3

Author: Nikita Anisimov

Part 1

Part 2

Hi there! In this post well discuss how we use the EventWriter class and ghcjs-dom library.

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, lets 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

Weve 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, weve 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 dont care at all about the returned event and, consequently, we dont need to extract the Event from the Dynamic anymore.

The todoWidget function has also undergone visible changes. Now we dont 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.

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 wont 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 whereimport Control.Monadimport Data.Functor (($>))import Data.Text (Text)import GHCJS.DOMimport 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 RtoClipboard :: 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 dont 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. Lets 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 lets change the pending task widget after making sure that weve 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        ]

Weve 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 weve obtained can be found in our repository.

In the next post, well discuss using JSFFI (JS Foreign Function Interface).


Original Link: https://dev.to/typeable/creating-a-haskell-application-using-reflex-part-3-47d6

Share this article:    Share on Facebook
View Full Article

Dev To

An online community for sharing and discovering great ideas, having debates, and making friends

More About this Source Visit Dev To