Введение

Всем привет! Меня зовут Никита, и мы в Typeable для разработки фронтенда для части проектов используем FRP-подход, а конкретно его реализацию на Haskell веб-фреймоворк reflex. На русскоязычных ресурсах отсутствуют какие-либо руководства по данному фреймворку (да и в англоязычном интернете их не так много), и мы решили это немного исправить.

В этой серии статей будет рассмотрено создание веб-приложения на Haskell с использованием платформы reflex-platform. reflex-platform предоставляет пакеты reflex и reflex-dom. Пакет reflex является реализацией Functional reactive programming (FRP) на языке Haskell. В библиотеке reflex-dom содержится большое число функций, классов и типов для работы с DOM. Эти пакеты разделены, т.к. FRP-подход можно использовать не только в веб-разработке. Разрабатывать мы будем приложение Todo List, которое позволяет выполнять различные манипуляции со списком задач.

Для понимания данной серии статей требуется ненулевой уровень знания языка программирования Haskell и будет полезно предварительное ознакомление с функциональным реактивным программированием.

Здесь не будет подробного описания подхода FRP. Единственное, что действительно стоит упомянуть это два основных полиморфных типа, на которых базируется этот подход:

• Behavior a реактивная переменная, изменяющаяся во времени. Представляет собой некоторый контейнер, который на протяжении всего своего жизненного цикла содержит значение.
• Event a событие в системе. Событие несет в себе информацию, которую можно получить только во время срабатывания события.

Пакет reflex предоставляет еще один новый тип:

• Dynamic a является объединением Behavior a и Event a, т.е. это контейнер, который всегда содержит в себе некоторое значение, и, подобно событию, он умеет уведомлять о своем изменении, в отличие от Behavior a.

В reflex используется понятие фрейма минимальной единицы времени. Фрейм начинается вместе с возникшим событием и продолжается, пока данные в этом событии не перестанут обрабатываться. Событие может порождать другие события, полученные, например, через фильтрацию, маппинг и т.д., и тогда эти зависимые события также будут принадлежать этому фрейму.

Подготовка

В первую очередь потребуется установленный пакетный менеджер nix. Как это сделать описано здесь.

Чтобы ускорить процесс сборки, имеет смысл настроить кэш nix. В случае, если вы не используете NixOS, то вам нужно добавить следующие строки в файл /etc/nix/nix.conf:

binary-caches = https://cache.nixos.org https://nixcache.reflex-frp.orgbinary-cache-public-keys = cache.nixos.org-1:6NCHdD59X431o0gWypbMrAURkbJ16ZPMQFGspcDShjY= ryantrinkle.com-1:JJiAKaRv9mWgpVAz8dwewnZe0AzzEAzPkagE9SP5NWI=binary-caches-parallel-connections = 40

Если используете NixOS, то в файл /etc/nixos/configuration.nix:

nix.binaryCaches = [ "https://nixcache.reflex-frp.org" ];nix.binaryCachePublicKeys = [ "ryantrinkle.com-1:JJiAKaRv9mWgpVAz8dwewnZe0AzzEAzPkagE9SP5NWI=" ];

В этом туториале мы будем придерживаться стандартной структуры с тремя пакетами:

• todo-client клиентская часть;
• todo-server серверная часть;
• todo-common содержит общие модули, которые используются сервером и клиентом (например типы API).

Далее необходимо подготовить окружение для разработки. Для этого надо повторить действия из документации:

• Создать директорию приложения: todo-app;
• Создать проекты todo-common (library), todo-server (executable), todo-client (executable) в todo-app;
• Настроить сборку через nix (файл default.nix в директории todo-app);
  
  • Также надо не забыть включить опцию useWarp = true;;
• Настроить сборку через cabal (файлы cabal.project и cabal-ghcjs.project).

На момент публикации статьи default.nix будет выглядеть примерно следующим образом:

{ reflex-platform ? ((import <nixpkgs> {}).fetchFromGitHub {    owner = "reflex-frp";    repo = "reflex-platform";    rev = "efc6d923c633207d18bd4d8cae3e20110a377864";    sha256 = "121rmnkx8nwiy96ipfyyv6vrgysv0zpr2br46y70zf4d0y1h1lz5";    })}:(import reflex-platform {}).project ({ pkgs, ... }:{  useWarp = true;  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"];  };})

Примечание: в документации предлагается вручную склонировать репозиторий reflex-platform. В данном примере мы воспользовались средствами nix для получения платформы из репозитория.

Во время разработки клиента удобно пользоваться инструментом ghcid. Он автоматически обновляет и перезапускает приложение при изменении исходников.

Чтобы убедиться, что все работает, добавим в todo-client/src/Main.hs следующий код:

{-# LANGUAGE OverloadedStrings #-}module Main whereimport Reflex.Dommain :: IO ()main = mainWidget $ el "h1" $ text "Hello, reflex!"

Вся разработка ведется из nix-shell, поэтому в самом начале необходимо войти в этот shell:

$ nix-shell . -A shells.ghc

Для запуска через ghcid требуется ввести следующую команду:

$ ghcid --command 'cabal new-repl todo-client' --test 'Main.main'

Если все работает, то по адресу localhost:3003 вы увидите приветствие Hello, reflex!

Почему 3003?

Номер порта ищется в переменной окружения JSADDLE_WARP_PORT. Если эта переменная не установлена, то по умолчанию берется значение 3003.

Как это работает

Вы можете заметить, мы использовали при сборке не GHCJS, а обычный GHC. Это возможно благодаря пакетам jsaddle и jsaddle-warp. Пакет jsaddle предоставляет интерфейс для JS для работы из-под GHC и GHCJS. С помощью пакета jsaddle-warp мы можем запустить сервер, который посредством веб-сокетов будет обновлять DOM и играть роль JS-движка. Как раз для этого и был установлен флаг useWarp = true;, иначе по умолчанию использовался бы пакет jsaddle-webkit2gtk, и при запуске мы бы увидели десктопное приложение. Стоит отметить, что еще существуют прослойки jsaddle-wkwebview (для iOS приложений) и jsaddle-clib (для Android приложений).

Простейшее приложение TODO

Приступим к разработке!

Добавим следующий код в todo-client/src/Main.hs.

{-# LANGUAGE MonoLocalBinds #-}{-# LANGUAGE OverloadedStrings #-}module Main whereimport Reflex.Dommain :: IO ()main = mainWidgetWithHead headWidget rootWidgetheadWidget :: MonadWidget t m => m ()headWidget = blankrootWidget :: MonadWidget t m => m ()rootWidget = blank

Можно сказать, что функция mainWidgetWithHead представляет собой элемент <html> страницы. Она принимает два параметра head и body. Существуют еще функции mainWidget и mainWidgetWithCss. Первая функция принимает только виджет с элементом body. Вторая первым аргументом принимает стили, добавляемые в элемент style, и вторым аргументом элемент body.

Виджетами мы будем называть любой HTML элемент, или группу элементов. Виджет может обладать своей сетью событий и продуцирует некоторый HTML код. По сути, любая функция, требующая классов типов, ответственных за построения DOM, в типе выходного значения, будет называться виджетом.

Функция blank равносильна pure () и она ничего не делает, никак не изменяет DOM и никак не влияет на сеть событий.

Теперь опишем элемент <head> нашей страницы.

headWidget :: MonadWidget t m => m ()headWidget = do  elAttr "meta" ("charset" =: "utf-8") blank  elAttr "meta"    (  "name" =: "viewport"    <> "content" =: "width=device-width, initial-scale=1, shrink-to-fit=no" )    blank  elAttr "link"    (  "rel" =: "stylesheet"    <> "href" =: "https://stackpath.bootstrapcdn.com/bootstrap/4.4.1/css/bootstrap.min.css"    <> "integrity" =: "sha384-Vkoo8x4CGsO3+Hhxv8T/Q5PaXtkKtu6ug5TOeNV6gBiFeWPGFN9MuhOf23Q9Ifjh"    <> "crossorigin" =: "anonymous")    blank  el "title" $ text "TODO App"

Данная функция сгенерирует следующее содержимое элемента head:

<meta charset="utf-8"><meta content="width=device-width, initial-scale=1, shrink-to-fit=no" name="viewport"><link crossorigin="anonymous" href="http://personeltest.ru/aways/stackpath.bootstrapcdn.com/bootstrap/4.4.1/css/bootstrap.min.css"  integrity="sha384-Vkoo8x4CGsO3+Hhxv8T/Q5PaXtkKtu6ug5TOeNV6gBiFeWPGFN9MuhOf23Q9Ifjh" rel="stylesheet"><title>TODO App</title>

Класс MonadWidget позволяет строить или перестраивать DOM, а также определять сеть событий, которые происходят на странице.

Функция elAttr имеет следующий тип:

elAttr :: forall t m a. DomBuilder t m => Text -> Map Text Text -> m a -> m a

Она принимает название тэга, атрибуты и содержимое элемента. Возвращает эта функция, и вообще весь набор функций, строящих DOM, то, что возвращает их внутренний виджет. В данном случае наши элементы пустые, поэтому используется blank. Это одно из наиболее частых применений этой функции когда требуется сделать тело элемента пустым. Так же используется функция el. Ее входными параметрами являются только название тэга и содержимое, другими словами это упрощенная версия функции elAttr без атрибутов. Другая функция, используемая здесь text. Ее задача вывод текста на странице. Эта функция экранирует все возможные служебные символы, слова и тэги, и поэтому именно тот текст, который передан в нее, будет выведен. Для того чтобы встроить кусок html, существует функция elDynHtml.

Надо сказать, что в приведенном выше примере использование MonadWidget является избыточным, т.к. эта часть строит неизменяемый участок DOM. А, как было сказано выше, MonadWidget позволяет строить или перестраивать DOM, а также позволяет определять сеть событий. Функции, которые используются здесь, требуют только наличие класса DomBuilder, и тут, действительно, мы могли написать только это ограничение. Но в общем случае, ограничений на монаду гораздо больше, что затрудняет и замедляет разработку, если мы будем прописывать только те классы, которые нам нужны сейчас. Поэтому существует класс MonadWidget, которые представляет собой эдакий швейцарский нож. Для любопытных приведём список всех классов, которые являются надклассами MonadWidget:

type MonadWidgetConstraints t m =  ( DomBuilder t m  , DomBuilderSpace m ~ GhcjsDomSpace  , MonadFix m  , MonadHold t m  , MonadSample t (Performable m)  , MonadReflexCreateTrigger t m  , PostBuild t m  , PerformEvent t m  , MonadIO m  , MonadIO (Performable m)#ifndef ghcjs_HOST_OS  , DOM.MonadJSM m  , DOM.MonadJSM (Performable m)#endif  , TriggerEvent t m  , HasJSContext m  , HasJSContext (Performable m)  , HasDocument m  , MonadRef m  , Ref m ~ Ref IO  , MonadRef (Performable m)  , Ref (Performable m) ~ Ref IO  )class MonadWidgetConstraints t m => MonadWidget t m

Теперь перейдем к элементу body страницы, но для начала определим тип данных, который будем использовать для задания:

newtype Todo = Todo  { todoText :: Text }newTodo :: Text -> TodonewTodo todoText = Todo {..}

Тело будет иметь следующую структуру:

rootWidget :: MonadWidget t m => m ()rootWidget =  divClass "container" $ do    elClass "h2" "text-center mt-3" $ text "Todos"    newTodoEv <- newTodoForm    todosDyn <- foldDyn (:) [] newTodoEv    delimiter    todoListWidget todosDyn

Функция elClass на вход принимает название тэга, класс (классы) и содержимое. divClass это сокращенная версия elClass "div".

Все выше описанные функции отвечают за визуальное представление и не несут в себе никакой логики, в отличие от функции foldDyn. Она является частью пакета reflex и имеет следующую сигнатуру:

foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)

Она похожа на foldr :: (a -> b -> b) -> b -> [a] -> b и, по сути, выполняет такую же роль, только в роли списка здесь событие. Результирующее значение обернуто в контейнер Dynamic, т.к. оно будет обновляться после каждого события. Процесс обновления задаётся функцией-параметром, которая принимает на вход значение из возникшего события и текущее значение из Dynamic. На их основе формируется новое значение, которое будет находиться в Dynamic. Это обновление будет происходить каждый раз при возникновении события.

В нашем примере функция foldDyn будет обновлять динамический список заданий (изначально пустой), как только будет добавлено новое задание из формы ввода. Новые задания добавляются в начало списка, т.к. используется функция (:).

Функция newTodoForm строит ту часть DOM, в которой будет форма ввода описания задания, и возвращает событие, которое несет в себе новое Todo. Именно при возникновении этого события будет обновляться список заданий.

newTodoForm :: MonadWidget t m => m (Event t Todo)newTodoForm = rowWrapper $  el "form" $    divClass "input-group" $ do      iEl <- inputElement $ def        & initialAttributes .~          (  "type" =: "text"          <> "class" =: "form-control"          <> "placeholder" =: "Todo" )      let        newTodoDyn = newTodo <$> value iEl        btnAttr = "class" =: "btn btn-outline-secondary"          <> "type" =: "button"      (btnEl, _) <- divClass "input-group-append" $        elAttr' "button" btnAttr $ text "Add new entry"      pure $ tagPromptlyDyn newTodoDyn $ domEvent Click btnEl

Первое нововведение, которое мы встречаем тут, это функция inputElement. Ее название говорит само за себя, она добавляет элемент input. В качестве параметра она принимает тип InputElementConfig. Он имеет много полей, наследует несколько различный классов, но в данном примере нам наиболее интересно добавить нужные атрибуты этому тегу, и это можно сделать при помощи линзы initialAttributes. Функция value является методом класса HasValue и возвращает значение, которое находится в данном input. В случае типа InputElement оно имеет тип Dynamic t Text. Это значение будет обновляться при каждом изменении, происходящем в поле input.

Следующее изменение, которое тут можно заметить, это использование функции elAttr'. Отличие функций со штрихом от функций без штриха для построения DOM заключается в том, что эти функции вдобавок возвращают сам элемент страницы, с которым мы можем производить различные манипуляции. В нашем случае он необходим, чтобы мы могли получить событие нажатия на этот элемент. Для этого служит функция domEvent. Эта функция принимает название события, в нашем случае Click и сам элемент, с которым связано это событие. Функция имеет следующую сигнатуру:

domEvent :: EventName eventName -> target -> Event t (DomEventType target eventName)

Ее возвращаемый тип зависит от типа события и типа элемента. В нашем случае это ().

Следующая функция, которую мы встречаем tagPromptlyDyn. Она имеет следующий тип:

tagPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a

Ее задача заключается в том, чтобы при срабатывании события, поместить в него значение, которое находится в данный момент внутри Dynamic. Т.е. событие, являющееся результатом функции tagPromptlyDyn valDyn btnEv возникает одновременно с btnEv, но несёт в себе значение, которое было в valDyn. Для нашего примера это событие будет происходить при нажатии кнопки и нести в себе значение из текстового поля ввода.

Тут следует сказать про то, что функции, которые содержат в своём названии слово promptly, потенциально опасные они могут вызывать циклы в сети событий. Внешне это будет выглядеть так, как будто приложение зависло. Вызов tagPromplyDyn valDyn btnEv, по возможности, надо заменять на tag (current valDyn) btnEv. Функция current получает Behavior из Dynamic. Эти вызовы не всегда взаимозаменяемые. Если обновление Dynamic и событие Event в tagPromplyDyn возникают в один момент, т.е. в одном фрейме, то выходное событие будет содержать те данные, которые получил Dynamic в этом фрейме. В случае, если мы будем использовать tag (current valDyn) btnEv, то выходное событие будет содержать те данные, которыми исходный current valDyn, т.е. Behavior, обладал в прошлом фрейме.

Здесь мы подошли к еще одному различию между Behavior и Dynamic: если Behavior и Dynamic получают обновление в одном фрейме, то Dynamic будет обновлен уже в этом фрейме, а Behavior приобретет новое значение в следующем. Другими словами, если событие произошло в момент времени t1 и в момент времени t2, то Dynamic будет обладать значением, которое принесло событие t1 в промежутке времени [t1, t2), а Behavior (t1, t2].

Задача функции todoListWidget заключается в выводе всего списка Todo.

todoListWidget :: MonadWidget t m => Dynamic t [Todo] -> m ()todoListWidget todosDyn = rowWrapper $  void $ simpleList todosDyn todoWidget

Здесь встречается функция simpleList. Она имеет следующую сигнатуру:

simpleList  :: (Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m)  => Dynamic t [v]  -> (Dynamic t v -> m a)  -> m (Dynamic t [a])

Эта функция является частью пакета reflex, и в нашем случае она используется для построения повторяющихся элементов в DOM, где это будут подряд идущие элементы div. Она принимает Dynamic список, который может изменяться во времени, и функцию для обработки каждого элемента в отдельности. В данном случае это просто виджет для вывода одного элемента списка:

todoWidget :: MonadWidget t m => Dynamic t Todo -> m ()todoWidget todoDyn =  divClass "d-flex border-bottom" $    divClass "p-2 flex-grow-1 my-auto" $      dynText $ todoText <$> todoDyn

Функция dynText отличается от функции text тем, что на вход принимает текст, обернутый в Dynamic. В случае, если элемент списка будет изменен, то это значение также обновится в DOM.

Также было использовались 2 функции, о которых не было ничего сказано: rowWrapper и delimiter. Первая функция является оберткой над виджетом. В ней нет ничего нового и выглядит следующим образом:

rowWrapper :: MonadWidget t m => m a -> m arowWrapper ma =  divClass "row justify-content-md-center" $    divClass "col-6" ma

Функция delimiter просто добавляет элемент-разделитель.

delimiter :: MonadWidget t m => m ()delimiter = rowWrapper $  divClass "border-top mt-3" blank

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

Это все, что требуется для построения простого и урезанного приложения Todo. В этой части мы рассмотрели настройку окружения и приступили непосредственно к самой разработке приложения. В следующей части будет добавлена работа с элемента списка.

Часть 1.

Часть 2.

Всем привет! В этой части мы рассмотрим использование класса EventWriter и библиотеки ghcjs-dom.

Использование EventWriter

Сейчас, для того, чтобы прокинуть события с более глубоких уровней, мы передаем их в качестве возвращемых значений. Это не всегда удобно, особенно, когда надо возвращать что-то, помимо события (например, форма ввода может возвращать одновременно и событие нажатия кнопки, и данные из формы). Гораздо удобнее было бы использовать механизм, который может "прокинуть" события наверх автоматически, не задумываясь о том, что надо их постоянно возвращать. И такой механизм есть EventWriter. Этот класс позволяет записывать события, наподобие стандартной монады Writer. Перепишем наше приложение с использованием EventWriter.

Для начала рассмотрим сам класс EventWriter:

class (Monad m, Semigroup w) => EventWriter t w m | m -> t w where  tellEvent :: Event t w -> m ()

Тип w как раз и есть тип нашего события, и этот тип является экземпляром класса Semigroup, т.е. значения этого типа можно комбинировать друг с другом. В том случае, если два разных события записываются с помощью tellEvent, и они в какой-то один и тот же момент срабатывают, то они должны быть как-то объединены в одно событие того же типа, чтобы результатом выполнения монады было одно событие.

Существует трансформер, являющийся экземпляром этого класса EventWriterT, для его запуска используется функция runEventWriterT.

Далее переходим к изменению функций. Наибольшие изменения ожидают функцию rootWidget.

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

Мы добавили запуск трансформера и избавились от всех возвращаемых событий.

Изменения в newTodoForm не такие большие, но все же, стоит их отметить:

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

Мы видим, что обновился тип функции, она теперь ничего не возвращает, и добавлено необходимое ограничение EventWriter. В теле функции, соответственно, мы избавились от возвращаемого значения и теперь используем функцию tellEvent.

Функция todoListWidget сильно упростилась.

todoListWidget  :: (EventWriter t (Endo Todos) m, MonadWidget t m)  => Dynamic t Todos -> m ()todoListWidget todosDyn = rowWrapper $  void $ listWithKey (M.fromAscList . IM.toAscList <$> todosDyn) todoWidget

Нас теперь вообще не интересует возвращаемое событие, и, соответственно, отпала необходимость в извлечении Event из Dynamic.

В функции todoWidget также произошли заметные изменения. Больше нет необходимости работать с возвращаемым типом преобразовывать Event t (Event t TodoEvent). Отличие функции dyn_ от функции dyn, в том, что она игнорирует возвращаемое значение.

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

Единственное изменение в функциях todoDone, todoActive и todoEditable это новый тип и запись события вместо его возврата.

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)

Применение класса EventWriter упростило код и сделало его более читаемым.

ghcjs-dom

reflex позволяет нам только модифицировать DOM, но зачастую от JS-приложений требуется больше. Например, если требуется копировать текст по нажатию на кнопку, то reflex не предоставляет нужных нам для этого средств. На помощь приходит библиотека ghcjs-dom. По сути, это реализация JS API на Haskell. В ней можно найти все те же самые типы и функции, которые есть в JS.

На чистом JS, без использования сторонних библиотек, функция копирования текста может выглядеть следующим образом:

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);}

В привычном использовании мы вешаем этот обработчик, например, на кнопку.
Как это будет выглядеть на Haskell? В первую очередь, создадим новый модуль GHCJS для работы с ghcjs и определим соответствующую функцию.

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

Почти каждой строке из haskell функции toClipboard есть соответствие из JS функции. Стоит отметить, что здесь нет привычного класса MonadWidget, а используется MonadJSM это та монада, в которой производятся вся работы с помощью ghcjs-dom. Класс MonadWidget наследует класс MonadJSM. Рассмотрим, как осуществляется привязка обработчика к событию:

copyByEvent :: MonadWidget t m => Text -> Event t () -> m ()copyByEvent txt ev =  void $ performEvent $ ev $> toClipboard txt

Здесь мы видим новую для нас функцию performEvent, и с помощью нее осуществляется привязка обработчика к событию. Она является методом класса 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 ()

Теперь изменим виджет невыполненного задания, предварительно не забыв добавить импорт 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        ]

Была добавлена новая кнопка Copy и вызов определенной функции copyByEvent. Эти же самые действия можно проделать с виджетами для других состояний задания.

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

В следующей части рассмотрим использование JSFFI (JS Foreign Function Interface).

Часть 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.