This post deals with two essentially different approaches to reactive programming.
Elm, unlike Reflex, is a separate language, not a library, which is why it’s not quite correct to compare it with Reflex. Nevertheless, it is possible to show the difference between the approaches and describe the practical challenges you may face when developing software using each of the technologies.
Elm is a functional programming language used to create reactive web applications. Elm applications must follow The Elm Architecture (TEA), i.e. a simple design pattern that breaks down the the code into three parts – model, view and update:
Reflex is a framework that allows creating reactive web applications in Haskell.
In contrast to Elm, Reflex doesn’t impose any strict constraints on the application architecture. The framework provides abstractions to control the state and the programmer is free to use them in any combination.
There are three main abstractions, namely Event, Behavior and Dynamic.
Event is an abstraction used to describe discrete events occurring instantaneously from time to time. The events are parametrized by the type of the value they contain.
Behavior can be regarded as a changing value which can be sampled at any point in time. However, it is not possible to “subscribe” to the value update.
Conceptually, Dynamic is a pair consisting of the Event and Behavior.
You can obtain each of the Dynamic components using the pure functions updated
and current
:
current :: … => Dynamic t a -> Behavior t a
updated :: … => Dynamic t a -> Event t a
(Here and elsewhere, the parameter of t type can be ignored – this is an implementation feature. For the sake of legibility, the constraints in type signatures here and in some places below are replaced with ellipses).
Dynamic guarantees that the following invariants hold true:
It’s not possible to create an “incorrect” Dynamic using the library functions.
Dynamic is convenient for the programmer because it rules out errors relating to any missed status updates. All events potentially affecting the Dynamic must be explicitly listed during its creation, which is why the errors relating to an accidental status update (for example, from another part of the program) are also eliminated.
It’s important to note that the Dynamic can be “updated” with the same value it had before. If the values in the Dynamic determine a DOM section, it will be rebuilt because the framework is not able to test random values for equality (further down we will show how to avoid this).
We will consider two implementations of an interactive questionnaire widget based on the two technologies. The users see a list of questions with the answer options known in advance. The users select one answer for each question from these options and can compare their answers with the correct ones after clicking the check button.
The check button must not be available until an answer is selected for each of the questions. After the check, we must show the score, i.e. the number of correct answers.
To find the complete code of both applications follow this link. (For convenience, the links to the main files are Elm, Reflex).
For the Reflex example, we use the Obelisk framework. It allows implementing both the frontend and backend, and is also responsible for the server-side rendering and routing. We will use it as a build system only (we have no backend here).
Like Haskell, Elm supports algebraic data types. The code below declares the data types we need to create our application (Model). Similar declarations in Haskell are not conceptually different in any way, so we will not show them.
type alias QuestionText = String
type alias AnswerText = String
type IsChosen = Chosen | NotChosen
type IsCorrect = Correct | Incorrect
type CanCheckAnswers = CanCheckAnswers | CantCheckAnswers
type AreAnswersShown = AnswersShown | AnswersHidden
type alias Answer =
{ answerText : AnswerText
, isCorrect : IsCorrect
}
type Score
= NoScore
| Score { totalQuestions : Int, correctAnswers : Int }
type alias Questions = List (QuestionText, List (Answer, IsChosen))
type alias Model =
{ areAnswersShown : AreAnswersShown
, allQuestions : Questions
, canCheckAnswers : CanCheckAnswers
, score : Score
}
The type describing an Elm message contains all the values we may need to update the status. We will use two indices to select an answer option: the question number and the number of the answer to this question. For the sake of simplicity, we also store the new value IsChosen in the event payload.
type Msg
= SelectAnswer
{ questionNumber : Int
, answerNumber : Int
, isChosen : IsChosen }
| CheckAnswers
In Reflex, we deal with several independent event values, that’s why we use an individual type to describe each of them:
-- | Answer option selection.
data SelectAnswer
= SelectAnswer
{ questionNumber :: Int
, answerNumber :: Int }
-- | Payload for the event "show answers"
data CheckAnswers = CheckAnswers
Much has been said about the architecture of Elm applications — dozens of posts on the topic are available. However, we don’t use Elm at Typeable, so we cannot share our experience in this area, but we can provide the reader with references to other sources:
Despite the fact that Reflex doesn’t impose strict constraints on the architecture, it makes sense to follow some agreements on the code organization.
Our experience with Reflex has resulted in a certain pattern we will describe further.
Let’s start with general considerations.
It’s rather convenient to separate the application representation (interface) and internal logic. But what exactly does the representation mean? Conceptually, the representation can be defined as the function that takes on the widget status (in the case of Reflex, it’s dynamic, as it’s fully or partially “wrapped” in Dynamic) and returns an interface description and multiple events occurring during interaction with the interface.
The monad constrained by DomBuilder
is responsible for the “interface description”. Here and elsewhere we use the ObeliskWidget
constraint (from Obelisk) that includes the DomBuilder
.
Thus, in a general case, the representation description in the form of a Haskell function could have the following type (for now, we don’t specify the type variables events and state):
ui :: ObeliskWidget js t route m => state -> m events
The application logic will be implemented in another function which, contrarily, takes on multiple events and returns the dynamic status:
model :: ObeliskWidget js t route m => events -> m state
To use them together, let’s declare an auxiliary high-order function, mkWidget
:
mkWidget :: ObeliskWidget js t route m
=> (events -> m state) -> (state -> m events) -> m ()
mkWidget model ui = void (mfix (model >=> ui))
We used function mfix
(a combinator of the fixed point for the monadic computation) with the type MonadFix
m => (a -> m a) -> m a
, as well as a combination of Kleisli arrows – sometimes called a fish
:
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)`
The division into UI and the “model” turns out to be rather convenient when you write dynamic widgets. You may notice the similarity between UI and view in Elm, just as between the “model” and its update. The difference is how exactly we transfer the status and the events.
Let’s get back to our widget.
Let’s specify the state and event variables for our questionnaire widget.
According to the specification, there are only two events: the answer selection and clicking on the check button:
data QuizEvents t = QuizEvents
{ selectAnswer :: Event t SelectAnswer
, showAnswers :: Event t CheckAnswers }
The structure containing the dynamic data will be somewhat more complex:
data QuizState t = QuizState
{ areAnswersShown :: Dynamic t AreAnswersShown
, allQuestions :: [(QuestionText, [(Answer, Dynamic t IsChosen)])]
, canCheckAnswers :: Dynamic t CanCheckAnswers
, score :: Dynamic t Score }
We “wrap” in Dynamic only the status parts which may change. In particular, the allQuestions
field has only the value of IsChosen
type, “wrapped” in Dynamic. Of course, using a single Dynamic would allow writing a simpler code. But in this case, we would have had to rebuild even the static DOM parts.
This is another important difference between the two frameworks — in Reflex we control the DOM update ourselves, while the VDOM implementation built into Elm does this for us.
Function update receives the message and the previous state, and returns the new one:
update : Msg -> Model -> Model
update msg = case msg of
SelectAnswer { questionNumber, answerNumber, isChosen } ->
updateCanCheckAnswers <<
( mapAllQuestions
<| updateAt questionNumber
<| Tuple.mapSecond
<| updateAnswers answerNumber isChosen )
CheckAnswers -> mapAnswersShown (\_ -> AnswersShown) >> updateScore
We use auxiliary functions and the function composition operator (>>
) to perform the status update in parts.
The rather awkward syntax used to update the fields of record types in Elm makes it necessary to manually declare such functions as mapAnswersShown
, mapAllQuestions
and the like, which simply apply the function to the field value. In Haskell, we could use lenses (refer to the lens package and its analogs) generated automatically for each data type.
updateCanCheckAnswers : Model -> Model
updateCanCheckAnswers model =
{ model | canCheckAnswers =
if List.all hasChosenAnswer model.allQuestions
then CanCheckAnswers
else CantCheckAnswers }
updateScore : Model -> Model
updateScore model =
let
hasCorrectAnswer (_, answers) =
List.any isCorrectAnswerChosen answers
correctAnswers =
List.length <| List.filter hasCorrectAnswer model.allQuestions
totalQuestions = List.length model.allQuestions
in
{ model | score =
Score { correctAnswers = correctAnswers
, totalQuestions = totalQuestions } }
updateAnswers : Int -> IsChosen -> List (Answer, IsChosen) -> List (Answer, IsChosen)
updateAnswers answerIx newIsChosen =
List.indexedMap <| \aix ->
Tuple.mapSecond <| \isChosen ->
if aix /= answerIx
then
if newIsChosen == Chosen
then NotChosen
else isChosen
else newIsChosen
We form the dynamic status by receiving the widget events at the input, and then saving all dynamic data in the fields of the returned QuizState
value:
mkQuizModel :: ObeliskWidget js t route m
=> [(QuestionText, [Answer])]
-- ^ List of questions with answers
-> QuizEvents t
-> m (QuizState t)
mkQuizModel questions events = do
areAnswersShown <- holdDyn AnswersHidden (showAnswers events $> AnswersShown)
allQuestions <- mkAllQuestionsModel questions events
canCheckAnswers <- mkCanCheckAnswersModel allQuestions
score <- mkScoreModel areAnswersShown allQuestions
return QuizState{..}
To this end, we use several combinators from the Reflex.Dynamic module.
holdDyn :: MonadHold t m => a -> Event t a -> m (Dynamic t a)
holdDyn
is probably the easiest way of creating the Dynamic from the Event. Each time an event occurs, the value in the obtained Dynamic changes to the one contained in the event. At the same time, until the first event takes place, the Dynamic will contain the value we had passed as the first argument.
Thus, dynamic value areAnswersShown
will include AnswersHidden
until the event stored in the field showAnswers
occurs and, after that, it will change to AnswersShown
.
In the auxiliary function mkAllQuestionsModel
we perform an iteration by the enumerated list of questions and, in the internal cycle, – by the list of answers to each of them, in order to provide each of them with a dynamic status with IsChosen
type:
mkAllQuestionsModel :: ObeliskWidget js t route m
=> [(QuestionText, [Answer])]
-- ^ List of questions with answers
-> QuizEvents t
-> m [(QuestionText, [(Answer, Dynamic t IsChosen)])]
mkAllQuestionsModel questions events = do
for (enumerate questions)
\(qNum, (questionText, answers)) -> do
(questionText, ) <$> for (enumerate answers)
\(aNum, Answer{..}) -> do
let
updChosenState SelectAnswer{questionNumber,answerNumber} isChosen = do
guard (questionNumber == qNum)
return
if answerNumber == aNum
then toggleChosen isChosen
else NotChosen
isChosenDyn <- foldDynMaybe updChosenState NotChosen
(selectAnswer events)
return (Answer{..}, isChosenDyn)
Expression (questionText,)
is the syntax sugar for (\x -> (questionText, x))
.
Combinator foldDynMaybe
allows updating the Dynamic considering its previous status, as well as the event payload. Maybe
allows omitting the update, if it is not required:
foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
Expression foldDynMaybe updChosenState NotChosen (selectAnswer events)
creates the Dynamic that changes between the two values: Chosen
and NotChosen
when a click on the answer option occurs.
The function used to update the status looks as follows:
updChosenState SelectAnswer{questionNumber,answerNumber} isChosen = do
guard (questionNumber == qNum)
return
if answerNumber == aNum
then toggleChosen isChosen
else NotChosen
We used guard :: Alternative f => Bool -> f ()
to return Nothing
(by doing so, we omit the Dynamic update — remember that Maybe
has an Alternative
instance) in case the event is not related to the current question. Otherwise, we either change the value IsChosen
or set it to NotChosen
, if the other answer option was clicked. In this way, it is possible to select only one answer.
Further, in function mkCanCheckAnswersModel
we form the dynamic value CanCheckAnswers
that takes on the value CanCheckAnswers only when every question has a selected answer (otherwise, it will be CantCheckAnswers):
mkCanCheckAnswersModel :: ObeliskWidget js t route m
=> [(QuestionText, [(Answer, Dynamic t IsChosen)])]
-> m (Dynamic t CanCheckAnswers)
mkCanCheckAnswersModel allQuestions = holdUniqDyn do
-- At least one answer was selected for each question
allQuestionsAnswered <- all (Chosen `elem`) <$> do
for allQuestions \(_, answers) -> do
for answers \(_, dynIsChosen) -> dynIsChosen
return if allQuestionsAnswered then CanCheckAnswers else CantCheckAnswers
Dynamic is in the Monad type class, which is why we can use the do-notation.
It has to be noted that we don’t want to update the canCheckAnswers
value each time we choose an answer, as this would cause a useless DOM rebuilding. We are interested only in the updates that really change the value. This is why we use holdUniqDyn
to deal with “unnecessary” updates:
holdUniqDyn :: (Eq a, ...) => Dynamic t a -> m (Dynamic t a)
Constraint Eq a
means that the equality check function must be defined for type a
.
Similarly, we form the dynamic value Score
that contains the NoScore
value, if the results have not been counted yet, or the results, in the opposite case.
mkScoreModel :: ObeliskWidget js t route m
=> Dynamic t AreAnswersShown
-> [(QuestionText, [(Answer, Dynamic t IsChosen)])]
-> m (Dynamic t Score)
mkScoreModel areAnswersShown allQuestions = holdUniqDyn do
areAnswersShown >>= \case
AnswersHidden -> return NoScore
AnswersShown -> do
correctAnswers <- flip execStateT 0 do
for_ allQuestions \(_, answers) -> do
for_ answers \(answer, dynIsChosen) -> do
isChosen <- lift dynIsChosen
when (isChosen == Chosen && isCorrect answer == Correct) do
modify (+ 1)
return Score { correctAnswers, totalQuestions = length allQuestions }
Using the monad transformer StateT
allows describing the process of counting correct answers in a more “imperative” way.
In Elm, rendering is rather obvious and needs no detailed explanation.
view : Model -> Html Msg
view model =
div [] <|
List.indexedMap (viewQuestion model.areAnswersShown) model.allQuestions ++
[ div [ class "check-answers-button-container" ] [ viewFooter model ] ]
viewQuestion : AreAnswersShown -> Int -> (QuestionText, List (Answer, IsChosen)) -> Html Msg
viewQuestion areShown questionIx (question, answers) =
div [class "question"] <|
[ text question ] ++
[ div [class "answers"]
<| List.indexedMap (viewAnswer areShown questionIx) answers ]
viewAnswer : AreAnswersShown -> Int -> Int -> (Answer, IsChosen) -> Html Msg
viewAnswer areShown questionIx answerIx (answer, isChosen) =
let
events = [ onClick <|
SelectAnswer { questionNumber = questionIx
, answerNumber = answerIx
, isChosen = toggleChosen isChosen
}]
className = String.join " " <|
["answer"] ++
( if isChosen == Chosen
then ["answer-chosen"]
else [] ) ++
( if areShown == AnswersShown
then ["answer-shown"]
else ["answer-hidden"] ) ++
( if answer.isCorrect == Correct
then ["answer-correct"]
else ["answer-incorrect"] )
attrs = [ class className ]
in
div (attrs ++ events) [ text answer.answerText ]
viewFooter : Model -> Html Msg
viewFooter model =
case model.score of
NoScore ->
case model.canCheckAnswers of
CanCheckAnswers ->
button [ onClick CheckAnswers ] [ text "Check answers" ]
CantCheckAnswers ->
div [ class "unfinished-quiz-notice" ]
[ text "Select answers for all questions before you can get the results." ]
Score { totalQuestions, correctAnswers } ->
text <|
"Your score: " ++ String.fromInt correctAnswers ++
" of " ++ String.fromInt totalQuestions
We have fully described the widget. Now let’s get down to initializing it:
initialModel =
{ areAnswersShown = AnswersHidden
, allQuestions = allQuestions
, score = NoScore
, canCheckAnswers = CantCheckAnswers
}
main =
Browser.sandbox { init = initialModel, update = update, view = view }
quizUI :: ObeliskWidget js t route m => QuizState t -> m (QuizEvents t)
quizUI QuizState{..} = wrapUI do
selectAnswer <- leftmost <$> for (enumerate allQuestions)
\(qNum, (questionText, answers)) -> do
divClass "question" do
text questionText
answersUI qNum areAnswersShown answers
showAnswers <- footerUI canCheckAnswers score
return QuizEvents{..}
Function leftmost
allows combining several events of the same type into one.
leftmost :: Reflex t => [Event t a] -> Event t a
It’s important to note that the events in Reflex can occur simultaneously. This is why it has to be kept in mind that it iss possible to lose something important, as in this case leftmost
ignores all events except the first one.
Here we use leftmost to turn the list of events returned – as the result of the iteration by the question list – into one event. In this case, it’s not possible to click on two answer options simultaneously, so this is safe.
We also use leftmost to create the answer list:
answersUI :: ObeliskWidget js t route m
=> Int
-> Dynamic t AreAnswersShown
-> [(Answer, Dynamic t IsChosen)]
-> m (Event t SelectAnswer)
answersUI qNum areAnswersShown answers = elClass "div" "answers" do
leftmost <$> for (enumerate answers)
\(aNum, (Answer{answerText,isCorrect}, dynIsChosen)) -> do
event <- answerUI areAnswersShown answerText isCorrect dynIsChosen
return (event $> SelectAnswer { questionNumber = qNum, answerNumber = aNum })
In function answersUI
we iterate by the answers list, each time calling function answerUI
, by which we build a new Dynamic containing the Map
from the dynamic attributes of the DOM, which is an answer option. We make use of the fact that the Dynamic is a monad to form the class name for an HTML element with an answer option. We use Writer
for the sake of “imperativeness”.
We use $> SelectAnswer { questionNumber = qNum, answerNumber = aNum }
to replace the empty value ()
(called “unit”), which is the payload of the “click” event by default, with the payload we need that shows the answer we clicked on.
answerUI :: ObeliskWidget js t route m
=> Dynamic t AreAnswersShown
-> AnswerText
-> IsCorrect
-> Dynamic t IsChosen
-> m (Event t ())
answerUI areAnswersShown answerText isCorrect dynIsChosen =
domEvent Click . fst <$> elDynAttr' "div" dynAttrs do
text answerText
where
dynAttrs = do
isChosen <- dynIsChosen
areShown <- areAnswersShown
let
className = T.intercalate " " $ execWriter do
tell ["answer"]
when (isChosen == Chosen) $ tell ["answer-chosen"]
tell [ if areShown == AnswersShown
then "answer-shown"
else "answer-hidden" ]
tell [ if isCorrect == Correct
then "answer-correct"
else "answer-incorrect" ]
return $ "class" =: className
Construction domEvent Click . fst <$> elDynAttr'…
allows obtaining the click event in the form of a value.
footerUI
is a widget containing either a text offering to answer all questions, or a check button, or information on the results:
footerUI :: ObeliskWidget js t route m
=> Dynamic t CanCheckAnswers -> Dynamic t Score -> m (Event t CheckAnswers)
footerUI canCheckAnswersDyn dynScore = wrapContainer do
evt <- switchHold never <=< dyn $ do
canCheckAnswers <- canCheckAnswersDyn
score <- dynScore
return if score /= NoScore
then return never
else case canCheckAnswers of
CanCheckAnswers -> checkAnswersButton
CantCheckAnswers -> cantCheckNote
dyn_ $ dynScore <&> \case
NoScore -> blank
Score{totalQuestions, correctAnswers} -> do
text "Your score: "
text . T.pack $ show correctAnswers
text " of "
text . T.pack $ show totalQuestions
return (evt $> CheckAnswers)
where
wrapContainer = divClass "check-answers-button-container"
checkAnswersButton = do
domEvent Click . fst <$> do
el' "button" do
text "Check answers"
cantCheckNote = do
divClass "unfinished-quiz-notice" do
text "Select answers for all questions before you can get the results."
return never
Expression switchHold never <=< dyn $ do …
can also be often seen in the code. We use it when we want to get an event from a dynamically changing widget.
It makes sense to explain in detail what is going on here.
First of all, the correct way for placing the brackets is as follows: (switchHold never <=< dyn) $ do…
Let’s follow the types:
switchHold :: ... => Event t a -> Event t (Event t a) -> m (Event t a)
never :: ... => Event t a
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
dyn :: ... => Dynamic t (m a) -> m (Event t a)
switchHold
makes it possible to “switch” the events we are subscribed to as they become available. They are received as payloads of another event. The event passed as the first argument is the one that will be active until the second event occurs.never
is just an event that never occurs.(<=<)
is the fish we already know.dyn
allows “using” a dynamic widget. The returned event activates each time the dynamic changes.This implies that:
switchHold never <=< dyn :: Dynamic t (m (Event t a)) -> m (Event t a)
It’s clear that at any point in time there will be a widget inside the Dynamic returning the event. This is the widget that will be “used”.
We use if score /= NoScore then return never…
because if the result has been counted already, the event “count the result” must never occur.
A significant difference of the code shown above from the Elm code is that we return the events explicitly; we don’t simply assign them as the element attributes. The requirement to push the events through is the cost of the ability to process and combine them in any way, anywhere we need. However, we don’t always do so in our production code. Sometimes, we can use the type class EventWriter
that offers the tellEvent
function. tellEvent
looks very much like the tell in a standard Writer:
tellEvent :: EventWriter t w m => Event t w -> m ()
tell :: MonadWriter w m => w -> m ()
After fully describing the widget, we can make it operable using the function mkWidget
, created previously:
mkQuizWidget :: ObeliskWidget js t route m => [(QuestionText, [Answer])] -> m ()
mkQuizWidget qs =
mkWidget (mkQuizModel qs) quizUI
Widget preview:
Elm’s advantages as compared to Reflex:
Drawbacks:
Though Elm has several important advantages, we still opted for Reflex as it is rather convenient to use the same language both for backend and frontend development.
Typeable OU ("us", "we", or "our") operates https://typeable.io (the "Site"). This page informs you of our policies regarding the collection, use and disclosure of Personal Information we receive from users of the Site.
We use your Personal Information only for providing and improving the Site. By using the Site, you agree to the collection and use of information in accordance with this policy.
While using our Site, we may ask you to provide us with certain personally identifiable information that can be used to contact or identify you. Personally identifiable information may include, but is not limited to your name ("Personal Information").
Like many site operators, we collect information that your browser sends whenever you visit our Site ("Log Data").
This Log Data may include information such as your computer's Internet Protocol ("IP") address, browser type, browser version, the pages of our Site that you visit, the time and date of your visit, the time spent on those pages and other statistics.
In addition, we may use third party services such as Google Analytics that collect, monitor and analyze this ...
Cookies are files with small amount of data, which may include an anonymous unique identifier. Cookies are sent to your browser from a web site and stored on your computer's hard drive.
Like many sites, we use "cookies" to collect information. You can instruct your browser to refuse all cookies or to indicate when a cookie is being sent. However, if you do not accept cookies, you may not be able to use some portions of our Site.
The security of your Personal Information is important to us, so we don't store any personal information and use third-party GDPR-compliant services to store contact data supplied with a "Contact Us" form and job applications data, suplied via "Careers" page.
This Privacy Policy is effective as of @@privacePolicyDate and will remain in effect except with respect to any changes in its provisions in the future, which will be in effect immediately after being posted on this page.
We reserve the right to update or change our Privacy Policy at any time and you should check this Privacy Policy periodically. Your continued use of the Service after we post any modifications to the Privacy Policy on this page will constitute your acknowledgment of the modifications and your consent to abide and be bound by the modified Privacy Policy.
If we make any material changes to this Privacy Policy, we will notify you either through the email address you have provided us, or by placing a prominent notice on our website.
If you have any questions about this Privacy Policy, please contact us.