Building a Haskell web application using Reflex. Part 1

Introduction



Hello everyone! My name is Nikita, and we at Typeable use the FRP approach to develop the frontend for some projects, and specifically its implementation in Haskell - a web framework reflex



. There are no manuals on this framework on Russian-language resources (and there are not so many of them on the English-language Internet), and we decided to fix it a little.







This article series will walk you through building a Haskell web application using the reflex-platform



. reflex-platform



provides packages reflex



and reflex-dom



. The package reflex



is a Haskell implementation of Functional reactive programming (FRP) . The library reflex-dom



contains a large number of functions, classes and types for working with DOM



. These packages are separate because The FRP approach can be used not only in web development. We will develop an application Todo List



that allows you to perform various manipulations with the list of tasks.













A non-zero level of knowledge of the Haskell programming language is required to understand this series of articles, and a prior knowledge of functional reactive programming is helpful.

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.org
binary-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 where

import Reflex.Dom

main :: 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 where

import Reflex.Dom

main :: IO ()
main = mainWidgetWithHead headWidget rootWidget

headWidget :: MonadWidget t m => m ()
headWidget = blank

rootWidget :: 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="https://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 -> Todo
newTodo 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 a
rowWrapper 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



. . .








All Articles