Slightly More Involved Page

Following from the last post where we made a very simple component in Halogen, let’s now make a slightly more involved one.

Here, I want to show how it is possible to use Purescripts strong typing to model our data in such a way that it will be impossible to create an application that can be in an invalid state. If we do something invalid, our code should not compile.

Our app has multiple stages. We will make sure that in order to display a particular stage, all the required data for that stage will have had to have been collected.

Setup

Setup the project as per here.

Code

Edit src/Main.purs and add the following imports :

import Prelude
import Data.Const (Const)
import Data.Maybe (Maybe(..))
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP
import Halogen.HTML.Events as HE
import Halogen.VDom.Driver (runUI)
import Effect (Effect)

Data

First we setup our types.

Our app has three stages :

type AskNameStage = { name :: Maybe String }

type AskPlanetStage = { name :: String
                      , planet :: Maybe Planet
                      }

type GreetStage = { name :: String
                  , planet :: Planet
                  }

data Stage = AskName AskNameStage
           | AskPlanet AskPlanetStage
           | Greet GreetStage

We have a Stage data type that can be one of our possible stages. Each of these stages will contain the data that is required for each stage.

The first stage - AskName doesn’t need any data, but it has the optional name field which is what we fill in at this stage. The second stage - AskPlanet has to have the name. The optional planet field is what we are filling out. The final stage - Greet needs both the name and the planet, so it can output the full greeting.

It is impossible to create a Greet stage without the name and a valid planet.

Application state

The state for our application is simply :

type State = { stage :: Stage }

All the data stored for the app must be contained within the current Stage, ensuring that no invalid data can leak through.

Note, here we could get away with just saying type State = Stage, or in fact just using the Stage type as our components state. However, chances are in any component of any significant size you probably will need to store additional state that is separate from the stage, so your state would likely contain some additional fields.

Actions

We have four actions :

data Action
  = UpdateName AskNameStage String
  | SetPlanet AskPlanetStage Planet
  | GotoPlanetStage AskPlanetStage
  | GotoGreetStage GreetStage

UpdateName updates the name. In order to update the name we need to have the AskNameStage data and the new name. Now since the app only has data from the Stage, and the only stage that has any AskNameStage data is the AskName stage this Action ensures that we can only update the name whilst we are in the AskName stage.

SetPlanet has similar constraints.

To run the GotoPlanetStage stage, we have to have all the data required in order to go to this stage. Without the data, it will be impossible to get into this state.

Component

Setup the component as before :

page :: forall m. H.Component HH.HTML (Const Void) Unit Void m 
page = 
    H.mkComponent { initialState: const initialState
                  , render
                  , eval: H.mkEval $ H.defaultEval
                    { handleAction = handleAction }
                  }

State

Setup the state so that we are at the initial stage of AskName :

initialState :: State
initialState = { stage : AskName { name : Nothing } }

This is the only stage we can start at as we don’t have the data to put the application in any other state. We could, of course just make up some random data - but that would be dumb. We could alse fetch the data from local storage or an http server if we needed to persist the current stage over sessions. Naturally, even if we did we would still need to have valid data for the stage, so it would still be impossible to be in an invalid state.

Actions

handleAction has the type :

handleAction :: forall m. Action -> H.HalogenM State Action () Void m Unit

The first action we handle is UpdateName :

handleAction ( UpdateName stage newName ) = 
    let
      updated = stage { name = Just newName }
    in 
      H.modify_ _{ stage = AskName updated }

Here we are replacing the given stage with the new name and then updating our state to point to the stage with the new name. Naturally, in this handler, the only stage we can set our app state to is the AskName stage since this is the only data we currently have.

SetPlanet is similar :

handleAction ( SetPlanet stage newPlanet ) =
    let
      updated = stage { planet = Just newPlanet }
    in 
      H.modify_ _{ stage = AskPlanet updated}

The actions to move to the next stage already have all the required data within them :

handleAction (GotoPlanetStage stage) = 
    H.modify_ _{ stage = AskPlanet stage }

handleAction (GotoGreetStage stage ) =
    H.modify_ _{ stage = Greet stage } 

Render

First lets create a useful function to help us render the Next > button. This button should be disabled if the user is not allowed to press it yet - this would happen if they haven’t filled out all the required data yet :

The renderNextButton is defined as :

renderNextButton :: forall m. Maybe Action -> H.ComponentHTML Action () m
renderNextButton action =
  HH.button
  ( case action of
      Nothing -> [ HP.disabled true ]
      Just action' -> [ HE.onClick <<< const $ Just action' ] )
  [ HH.text "Next >" ]

The parameter is a Maybe Action. If we don’t have an Action defined (Nothing is passed) we simple disable the button. If we do have an Action we create the button with this as it’s onClick action.

Each stage is rendered differently. First the AskName stage :

render :: forall m. State -> H.ComponentHTML Action () m
render { stage: AskName stage } = 
    HH.div_ [ HH.p_ [ HH.text "What is your name?" ]
            , HH.input [ HP.type_ HP.InputText
                       , HE.onValueInput $ Just <<< UpdateName stage
                       ]
            , renderNextButton $ makeNextStage <$> stage.name
            ]
    where
      makeNextStage name = GotoPlanetStage { name
                                           , planet: Nothing
                                           }

We set up some simple Html to ask for the users name. The input field sends the action field UpdateName stage on the onValueInput event. Because we are in the correct stage (AskName) we have all the data needed to create the UpdateName data required.

When we render the next button we pass it makeNextStage <$> stage.name. <$> is calling fmap on the Functor instance of Maybe. So if stage.name is Nothing then Nothing is simple passed. If stage.name is Just then we call the makeNextStage function on the value of this name. The result of makeNextStage is then passed to renderNextButton.

It is similar to the following code :

  renderNextButton $ case stage.name of
                       Nothing -> Nothing
                       Just name' -> makeNextStage name'

If stage.name has not been filled out we are not able to create our GotoPlanetStage action, so all we can pass to renderNextButton is Nothing. This ensures the button is disabled and nothing happens if you click it.

We need an extra function to render a radio button for each planet, but beyond that rendering the AskPlanet stage is similar :

render { stage: AskPlanet stage } =
  HH.div_ [ HH.p_ [ HH.text $ "So " <> stage.name <> ", what planet do you hail from?" ]
          , makeButton Mars
          , makeButton Neptune
          , makeButton Uranus
          , renderNextButton $ makeNextStage <$> pure stage.name <*> stage.planet
          ]
    where
      makeButton planet =
        HH.div_  [ HH.input [ HP.type_ HP.InputRadio
                            , HP.checked $ stage.planet == Just planet
                            , HE.onChecked <<< const <<< Just $ SetPlanet stage planet ]
                 , HH.label_ [ HH.text $ show planet ]
                 ]
          
      makeNextStage name planet = GotoGreetStage { name
                                                 , planet
                                                 } 

And finally, our Greet stage :

render { stage: Greet stage } = 
    HH.div_ [ HH.text $ "Greetings " <>
                        stage.name <>
                        " from " <> 
                        show stage.planet ]

Since we have all the data we need in this stage, we can simply output it.

Main

Finally wrap it all up with the main function.

main :: Effect Unit
main = HA.runHalogenAff $
       HA.awaitBody >>= runUI page unit

I hope this has demonstrated how useful the Purescript type system is at writing robust front end code. All too often developers are faced with the situation where changing the code in one area breaks things in a different area. Sometimes the breakage isn’t even discovered until much later. With Purescript it really is possible to avoid a lot of these problems, or at the very least discover the problems almost as soon as they arise.

This was only a very small example, as the size of the application increases, when there are more developers involved in the project and when the business requirements change more and more frequently such a style of development becomes more and more critical to the long term success of the project.

You can find the source code here