Create a Haskell web application using Reflex. Part 4
Part 1.
Part 2.
Part 3.
Hello everyone! In the new part, we will look at using JSFFI…
JSFFI
Let’s add the ability to set a deadline date to our application. Let’s say you want to make not just a text input, but for it to be a drop-down datepicker. You can, of course, write your datepicker on reflex, but there are many different JS libraries that you can use. When there is already a ready-made JS code, which, for example, is too large to rewrite using GHCJS, it is possible to connect it using JSFFI (JavaScript Foreign Function Interface)… In our case, we will use flatpickr…
Let’s create a new module JSFFI
, let’s immediately add its import to Main
… Let’s paste the following code into the created file:
{-# 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
Also, do not forget to add to the element head
required script and styles:
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
We try to compile, as before, and we 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 are building our application using GHC
which has no idea what JSFFI is. Recall that now the server is starting, which, using websockets, sends the updated DOM
when required, and JavaScript code is foreign to it. Here the conclusion suggests itself that to use our datepicker when assembling using GHC
will not work. However, in production GHC
will not be used for the client, we will compile to JS using GHCJS
, and embed the resulting JS into our page. ghcid
do not support GHCJS
therefore, it makes no sense to boot into the nix shell, we will use nix immediately for building:
nix-build . -A ghcjs.todo-client -o todo-client-bin
The directory will appear in the root directory of the application todo-client-bin
with the following structure:
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
Opening index.html
in the browser, we will see our application. We put together the project with GHCJS
, but for development it is still more convenient to use GHC
together with ghcid
, so we modify the module JSFFI
as follows:
{-# 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 added conditional compilation: depending on the platform, we will either use a JS function call or a stub.
Now you need to change the form for adding a new task by adding a date selection field there:
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
Let’s compile our application, try to run it, and we still won’t see anything. If we look at the developer console in a browser, we 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)
Note that the function we need is not defined. This happens because the element script
with a link is created dynamically, as well as in general all page elements. So when we use the function call flatpickr
, the script containing the library with this function may not be loaded yet. It is necessary to clearly arrange the order of loading.
Let’s solve this problem with the package reflex-dom-contrib
… This package contains many useful features for development. Its connection is non-trivial. The fact is that on Hackage there is an outdated version of this package, so you will have to take it directly from Github… 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"];
};
})
Add module import import Reflex.Dom.Contrib.Widgets.ScriptDependent
and make changes to the form:
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 taken advantage of a new feature widgetHoldUntilDefined
, which will build the element passed to it in the last parameter, only at the moment when the specified script is loaded.
Now, if we load our page obtained with GHCJS
we will see the datepicker we are using.
But we did not use this field in any way. Change the type Todo
without forgetting to add import Data.Time
:
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 let’s change the function with the form for a new task:
...
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 display in the list:
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
...
The result, as always, can be viewed in our repository…
In the next part, we will look at how to implement routing in a Reflex application.