An Interest In:
Web News this Week
- March 19, 2024
- March 18, 2024
- March 17, 2024
- March 16, 2024
- March 15, 2024
- March 14, 2024
- March 13, 2024
Creating a Haskell Application Using Reflex. Part 4
Author: Nikita Anisimov
Hi there! In our new post, well take a look at how we use JSFFI.
JSFFI
Lets 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, its possible to call it using JSFFI (JavaScript Foreign Function Interface). In our case, well use flatpickr.
Lets create a new JSFFI
module and immediately add its import to the Main
. We insert the following code in the created file:
{-# LANGUAGE MonoLocalBinds #-}module JSFFI whereimport Control.Monad.IO.Classimport Reflex.Domforeign 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
Lets not forget to add the required script and styles to the head
element too:
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 were 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 doesnt work when you build using GHC
. Nevertheless, GHC
wont be used to build the clients application production version; well compile to JS using GHCJS
and embed the JS code weve obtained into our page. ghcid
doesnt support GHCJS
, which is why it makes no sense to run nix shell; well use nix immediately for our build:
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:
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 well see our application. Though weve built our project using GHCJS
, its more convenient to carry out development using GHC
together with ghcid
, which is why well modify the JSFFI
module in the following way:
{-# LANGUAGE CPP #-}{-# LANGUAGE MonoLocalBinds #-}module JSFFI whereimport Reflex.Dom#ifdef ghcjs_HOST_OSimport Control.Monad.IO.Classforeign 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#elseaddDatePicker :: MonadWidget t m => InputElement er GhcjsDomSpace t -> m ()addDatePicker _ = pure ()#endif
Weve added conditional compilation: depending on the platform, well 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:
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, well see the following error:
uncaught exception in Haskell main thread: ReferenceError: flatpickr is not definedrts.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. Thats 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.
Lets 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 offers an obsolete version of this package, which is why we have to take it directly from GitHub. Lets 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:
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
Weve 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
well see the datepicker we use.
However, weve not used this field in any way. Lets change the type Todo
making sure that weve added the import of Data.Time
:
data Todo = Todo { todoText :: Text , todoDeadline :: Day , todoState :: TodoState } deriving (Generic, Eq, Show)newTodo :: Text -> Day -> TodonewTodo todoText todoDeadline = Todo {todoState = TodoActive False, ..}
Now we 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 to the list item widget:
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 weve got can be found in our repository.
In the next part, well see how to use routing in a Reflex-based application.
Original Link: https://dev.to/typeable/creating-a-haskell-application-using-reflex-part-4-4jn7
Dev To
An online community for sharing and discovering great ideas, having debates, and making friendsMore About this Source Visit Dev To