Часть 1.

Часть 2.

Часть 3.

Всем привет! В новой части мы рассмотрим использование JSFFI.

JSFFI

Добавим в наше приложение возможность установки даты дедлайна. Допустим, требуется сделать не просто текстовый input, а чтобы это был выпадающий datepicker. Можно, конечно, написать свой datepicker на рефлексе, но ведь существует большое множество различных JS библиотек, которыми можно воспользоваться. Когда существует уже готовый код на JS, который, например, слишком большой, чтобы переписывать с использованием GHCJS, есть возможность подключить его с помощью JSFFI (JavaScript Foreign Function Interface). В нашем случае мы будем использовать flatpickr.

Создадим новый модуль JSFFI, сразу добавим его импорт в Main. Вставим в созданный файл следующий код:

{-# 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

Так же не забудем добавить в элемент head необходимые скрипт и стили:

  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

Пробуем скомпилировать, так же как и раньше, и получаем следующую ошибку:

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  |

Действительно, сейчас мы собираем наше приложение с помощью GHC, который понятия не имеет, что такое JSFFI. Напомним, что сейчас запускается сервер, который с помощью вебсокетов отправляет обновленный DOM, когда требуется, и код на JavaScript для него чужд. Здесь напрашивается вывод, что использовать наш datepicker при сборке с помощью GHC не получится. Тем не менее, в продакшене GHC для клиента не будет использоваться, мы будем компилировать в JS при помощи GHCJS, и полученный JS встраивать уже в нашу страницу. ghcid не поддерживает GHCJS поэтому смысла грузиться в nix shell нет, мы будем использовать nix сразу для сборки:

nix-build . -A ghcjs.todo-client -o todo-client-bin

В корневой директории приложения появится директория todo-client-bin со следующей структурой:

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

Открыв index.html в браузере, увидим наше приложение. Мы собрали проект с помощью GHCJS, но ведь для разработки все равно удобнее использовать GHC вместе с ghcid, поэтому модифицируем модуль JSFFI следующем образом:

{-# 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

Мы добавили условную компиляцию: в зависимости от платформы, либо будем использовать вызов JS функций, либо заглушку.

Теперь требуется изменить форму добавления нового задания, добавив туда поле выбора даты:

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

Скомпилируем наше приложение, попробуем его запустить, и мы все еще ничего не увидим. Если посмотрим в консоль разработчика в браузере, увидим следующую ошибку:

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)

Замечаем, что необходимая нам функция не определена. Так получается, потому что элемент script со ссылкой создается динамически, равно как и вообще все элементы страницы. Поэтому, когда мы используем вызов функции flatpickr, скрипт, содержащий библиотеку с этой функцией может быть еще не загружен. Надо явно расставить порядок загрузки.
Решим эту проблему при помощи пакета reflex-dom-contrib. Этот пакет содержит много полезных при разработке функций. Его подключение нетривиально. Дело в том, что на Hackage лежит устаревшая версия этого пакета, поэтому придется брать его напрямую c GitHub. Обновим default.nix следующим образом.

{ 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"];  };})

Добавим импорт модуля import Reflex.Dom.Contrib.Widgets.ScriptDependent и внесем изменения в форму:

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

Мы воспользовались новой функцией widgetHoldUntilDefined, которая построит элемент, переданный ей в последнем параметре, только в тот момент, когда указанный скрипт будет загружен.
Теперь, если загрузим нашу страницу, полученную при помощи GHCJS, мы увидим используемый нами datepicker.

Но мы никак не задействовали это поле. Изменим тип Todo, не забыв добавить импорт 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, ..}

Теперь изменим функцию с формой для нового задания:

...  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"...

И добавим отображение даты в списке:

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  ...

Полученный результат, как всегда, можно посмотреть в нашем репозитории.

В следующей части мы рассмотрим как реализовать роутинг в приложении на Reflex.