Création d'une application Web Haskell à l'aide de Reflex. Partie 1

introduction



Bonjour à tous! Je m'appelle Nikita, et chez Typeable, nous utilisons l'approche FRP pour développer l'interface de certains projets, et plus particulièrement sa mise en œuvre dans Haskell - un framework Web reflex



. Il n'y a pas de manuels sur ce framework sur les ressources en russe (et il n'y en a pas beaucoup sur Internet en anglais), et nous avons décidé de le corriger un peu.







Cette série d'articles vous guidera tout au long de la création d'une application Web Haskell à l'aide du reflex-platform



. reflex-platform



fournit des packages reflex



et reflex-dom



. Le package reflex



est une implémentation Haskell de la programmation fonctionnelle réactive (FRP) . La bibliothèque reflex-dom



contient un grand nombre de fonctions, de classes et de types avec lesquels travailler DOM



. Ces packages sont séparés car L'approche FRP peut être utilisée non seulement dans le développement Web. Nous développerons une application Todo List



qui vous permettra d'effectuer diverses manipulations avec la liste des tâches.













Un niveau de connaissance non nul du langage de programmation Haskell est nécessaire pour comprendre cette série d'articles, et une connaissance préalable de la programmation réactive fonctionnelle est utile.

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