Creating a Haskell Application Using Reflex. Part 4
Tags: haskell, functional, programming, tutorial
Published: 2021-06-22 15:11:15

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 3](https://dev.to/typeable/creating-a-haskell-application-using-reflex-part-3-47d6)

Hi there! In our new post, we’ll take a look at how we use [JSFFI](https://github.com/ghcjs/ghcjs/blob/master/doc/foreign-function-interface.md).

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

# JSFFI
Let’s make it possible to set a deadline date in our application. Suppose that we need to make not just the text input, but a dropdown datepicker. Of course, we can write our own datepicker in Reflex but there are lots of various JS libraries we could use. If there exists an off-the-shelf JS code which is, for instance, too long to be rewritten using GHCJS, it’s possible to call it using [JSFFI (JavaScript Foreign Function Interface)](https://github.com/ghcjs/ghcjs/blob/master/doc/foreign-function-interface.md). In our case, we’ll use [flatpickr](https://flatpickr.js.org/).

Let’s create a new `JSFFI` module and immediately add its import to the `Main`. We insert the following code in the created file:
```Haskell
{-# LANGUAGE MonoLocalBinds #-}
module JSFFI where

import Control.Monad.IO.Class
import Reflex.Dom

foreign import javascript unsafe
  "(function() { \
  \ flatpickr($1, { \
  \   enableTime: false, \
  \   dateFormat: \"Y-m-d\" \
  \  }); \
  \})()"
  addDatePicker_js :: RawInputElement GhcjsDomSpace -> IO ()

addDatePicker :: MonadWidget t m => InputElement er GhcjsDomSpace t -> m ()
addDatePicker = liftIO . addDatePicker_js . _inputElement_raw
```

Let’s not forget to add the required script and styles to the `head` element too:
```Haskell
  elAttr "link"
    (  "rel" =: "stylesheet"
    <> "href" =: "https://cdn.jsdelivr.net/npm/flatpickr/dist/flatpickr.min.css" )
    blank
  elAttr "script"
    (  "src" =: "https://cdn.jsdelivr.net/npm/flatpickr")
    blank
```

Now we try to compile the same way as before and get the following error:
```
src/JSFFI.hs:(9,1)-(16,60): error:
    • The `javascript' calling convention is unsupported on this platform
    • When checking declaration:
        foreign import javascript unsafe "(function() {    flatpickr($1, {      enableTime: false,      dateFormat: \"Y-m-d\"    });   })()" addDatePicker_js
          :: RawInputElement GhcjsDomSpace -> IO ()
  |
9 | foreign import javascript unsafe
  |
```
Indeed, now we’re building our application using `GHC` that has no idea of what JSFFI is. Recall that now the server is being launched that sends the updated `DOM` when this is needed using web sockets, and the JavaScript code is alien to it. The conclusion suggests itself that our datepicker just doesn’t work when you build using  `GHC`. Nevertheless, `GHC` won’t be used to build the client’s application production version; we’ll compile to JS using `GHCJS` and embed the JS code we’ve obtained into our page. `ghcid` doesn’t support `GHCJS`, which is why it makes no sense to  run nix shell; we’ll use nix immediately for our build:
```sh
nix-build . -A ghcjs.todo-client -o todo-client-bin
```
The directory `todo-client-bin` with the following structure will appear in the root directory of the application:

```tree
todo-client-bin
└── bin
    ├── todo-client-bin
    └── todo-client-bin.jsexe
        ├── all.js
        ├── all.js.externs
        ├── index.html
        ├── lib.js
        ├── manifest.webapp
        ├── out.frefs.js
        ├── out.frefs.json
        ├── out.js
        ├── out.stats
        ├── rts.js
        └── runmain.js
```

After opening the `index.html` in the browser we’ll see our application. Though we’ve built our project using `GHCJS`, it’s more convenient to carry out development using `GHC` together with `ghcid`, which is why we’ll modify the `JSFFI` module in the following way:

```Haskell
{-# LANGUAGE CPP #-}
{-# LANGUAGE MonoLocalBinds #-}

module JSFFI where

import Reflex.Dom

#ifdef ghcjs_HOST_OS

import Control.Monad.IO.Class

foreign import javascript unsafe
  "(function() {\
    flatpickr($1, {\
      enableTime: false,\
      dateFormat: \"Y-m-d\"\
    }); \
  })()"
  addDatePicker_js :: RawInputElement GhcjsDomSpace -> IO ()

addDatePicker :: MonadWidget t m => InputElement er GhcjsDomSpace t -> m ()
addDatePicker = liftIO . addDatePicker_js . _inputElement_raw

#else

addDatePicker :: MonadWidget t m => InputElement er GhcjsDomSpace t -> m ()
addDatePicker _ = pure ()

#endif
```

We’ve added conditional compilation: depending on the platform, we’ll use either the JS function call or a stub.

Now we need to change the input form for new tasks by adding the date selection field there:
```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)
  dEl <- inputElement $ def
    & initialAttributes .~
      (  "type" =: "text"
      <> "class" =: "form-control"
      <> "placeholder" =: "Deadline"
      <> "style" =: "max-width: 150px" )
  addDatePicker dEl
  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
```

We compile our application, try to run it and still see nothing. If we have a look at the developer console in the browser, we’ll see the following error:

```
uncaught exception in Haskell main thread: ReferenceError: flatpickr is not defined
rts.js:5902 ReferenceError: flatpickr is not defined
    at out.js:43493
    at h$$abX (out.js:43495)
    at h$runThreadSlice (rts.js:6847)
    at h$runThreadSliceCatch (rts.js:6814)
    at h$mainLoop (rts.js:6809)
    at rts.js:2190
    at runIfPresent (rts.js:2204)
    at onGlobalMessage (rts.js:2240)
```
Here we notice that the function we need is not defined. This is because the element `script` with the link, as well as every single element of the page are created dynamically. That’s why when we call the `flatpickr` function, the script containing the library with this function might be not loaded yet. Obviously, we need to set the loading order.
Let’s solve this issue using the package `reflex-dom-contrib`. This package includes many functions useful for development. Adding this dependency is non-trivial. The thing is that [Hackage](https://hackage.haskell.org/package/reflex-dom-contrib) offers an obsolete version of this package, which is why we have to take it directly from [GitHub](https://github.com/reflex-frp/reflex-dom-contrib). Let’s update `default.nix` in the following way.

```
{ reflex-platform ? ((import <nixpkgs> {}).fetchFromGitHub {
    owner = "reflex-frp";
    repo = "reflex-platform";
    rev = "efc6d923c633207d18bd4d8cae3e20110a377864";
    sha256 = "121rmnkx8nwiy96ipfyyv6vrgysv0zpr2br46y70zf4d0y1h1lz5";
    })
}:
(import reflex-platform {}).project ({ pkgs, ... }:
let
  reflexDomContribSrc = builtins.fetchGit {
    url = "https://github.com/reflex-frp/reflex-dom-contrib.git";
    rev = "11db20865fd275362be9ea099ef88ded425789e7";
  };

  override = self: pkg: with pkgs.haskell.lib;
  doJailbreak (pkg.overrideAttrs
  (old: {
    buildInputs = old.buildInputs ++ [ self.doctest self.cabal-doctest ];
  }));

in {
  useWarp = true;

  overrides = self: super: with pkgs.haskell.lib; rec {
    reflex-dom-contrib = dontHaddock (override self
      (self.callCabal2nix "reflex-dom-contrib" reflexDomContribSrc { }));
  };

  packages = {
    todo-common = ./todo-common;
    todo-server = ./todo-server;
    todo-client = ./todo-client;
  };

  shells = {
    ghc = ["todo-common" "todo-server" "todo-client"];
    ghcjs = ["todo-common" "todo-client"];
  };
})
```

We add the import of module `import Reflex.Dom.Contrib.Widgets.ScriptDependent` and make changes in the form:
```Haskell
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)
  dEl <- inputElement $ def
    & initialAttributes .~
      (  "type" =: "text"
      <> "class" =: "form-control"
      <> "placeholder" =: "Deadline"
      <> "style" =: "max-width: 150px" )
  pb <- getPostBuild
  widgetHoldUntilDefined "flatpickr"
    (pb $> "https://cdn.jsdelivr.net/npm/flatpickr")
    blank
    (addDatePicker dEl)
  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
```

We’ve used the new function `widgetHoldUntilDefined` that will build the element passed to it in the last parameter only when the defined script has already been downloaded.
Now, if we open our page created using `GHCJS` we’ll see the datepicker we use.

However, we’ve not used this field in any way. Let’s change the type `Todo` making sure that we’ve added the import of `Data.Time`:

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

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

Now we change the function with the form for a new task:
```Haskell
...
  today <- utctDay <$> liftIO getCurrentTime
  let
    dateStrDyn = value dEl
    dateDyn = fromMaybe today . parseTimeM True
      defaultTimeLocale "%Y-%m-%d" . unpack <$> dateStrDyn
    addNewTodo = \todo date -> Endo $ \todos ->
      insert (nextKey todos) (newTodo todo date) todos
    newTodoDyn = addNewTodo <$> value iEl <*> dateDyn
    btnAttr = "class" =: "btn btn-outline-secondary"
      <> "type" =: "button"
...
```

And add the date to the list item widget:
```Haskell
todoActive
  :: (EventWriter t (Endo Todos) m, MonadWidget t m)
  => Int -> Text -> Day -> m ()
todoActive ix todoText deadline = divClass "d-flex border-bottom" $ do
  elClass "p" "p-2 flex-grow-1 my-auto" $ do
    text todoText
    elClass "span" "badge badge-secondary px-2" $
      text $ pack $ formatTime defaultTimeLocale "%F" deadline
  divClass "p-2 btn-group" $ do
  ...
```

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

In the next part, we’ll see how to use routing in a Reflex-based application.