This tutorial will give you an opinionated introduction to using Haskell on the frontend for web. To benefit, you must:

  1. Have a desire to use Haskell specifically.

  2. Not already have an preferred library for frontend work.

  3. Not be using Windows.

We will use Miso as our framework.

Installing dependencies

First, install stack

$ curl -sSL https://get.haskellstack.org/ | sh

Then, install pi

$ curl -LSfs https://japaric.github.io/trust/install.sh | sh -s -- --git vmchale/project-init

You should also install Google's closure compiler.

$ sudo npm install -g closurecompiler

Starting our first project

To create a new project:

$ pi new miso starter

Navigate to the new directory (starter/), and open src/Lib.hs in a text editor. You should see the following:

{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}

module Lib ( exec ) where

import Miso import Miso.String

type Model = Int

data Action = AddOne | SubtractOne | NoOp deriving (Show, Eq)

exec :: IO () exec = startApp App {..} where initialAction = NoOp model = 0 update = updateModel view = viewModel events = defaultEvents subs = []

updateModel :: Action -> Model -> Effect Action Model updateModel AddOne m = noEff (m + 1) updateModel SubtractOne m = noEff (m - 1) updateModel NoOp m = noEff m

viewModel :: Model -> View Action viewModel x = div_ [] [ button_ [ onClick AddOne ] [ text "+" ] , text (toMisoString (show x)) , button_ [ onClick SubtractOne ] [ text "-" ] ]

We will modify the bundled example (a simple counter) to instead give back the \(n\)th Fibonacci number. To do so, we will need the following:

The first step is easy. We define our Model type as follows:

type Model = Maybe Integer

Next, we will need to define our Action data type. A little bit harder, but still relatively straightforward. We need the Maybe Int to represent an error state.

data Action = Update (Maybe Int) | NoOp

Next, we need some way to view the model and display the input box. We do that with the following.

import Text.Read (readMaybe) import Miso.String (toMisoString)

viewModel :: Model -> View Action viewModel x = div_ [] [ input_ [ onInput (Update . readMaybe . filter (/= '"') . show) ] [] , text (toMisoString (show x)) ]

Note the use of input_ with the onInput attribute. This will trigger a state change every time the user enters something new into the text box.

Notice also that we've gone out of our way to avoid throwing any exceptions. This is because GHCJS won't display anything when they're thrown! In fact, it will lock up the app completely. So we have write a some boilerplate.

We need some way to compute the Fibonacci numbers. We'll use my favorite one-liner in Haskell:

fibs :: [Integer] fibs = 1 : 1 : zipWith (+) fibs (tail fibs)

With that done, we can write updateModel. This is still relatively straightforward, though again there will be a bit of boilerplate to ensure we don't throw any exceptions.

updateModel :: Action -> Model -> Effect Action Model updateModel (Update n) _ | n < Just 0 = noEff Nothing | otherwise = noEff $ fmap (fibs !!) n updateModel NoOp m = noEff m

And that's it! We just need to wire it up to startApp. When all this is done, your src/Lib.hs should look like this:

{-# LANGUAGE RecordWildCards #-}

module Lib ( exec ) where

import Text.Read (readMaybe) import Miso import Miso.String (toMisoString)

type Model = Maybe Integer

data Action = Update (Maybe Int) | NoOp

exec :: IO () exec = startApp App {..} where initialAction = NoOp model = Nothing update = updateModel view = viewModel events = defaultEvents subs = []

fibs :: [Integer] fibs = 1 : 1 : zipWith (+) fibs (tail fibs)

updateModel :: Action -> Model -> Effect Action Model updateModel (Update n) _ | n < Just 0 = noEff Nothing | otherwise = noEff $ fmap (fibs !!) n updateModel NoOp m = noEff m

viewModel :: Model -> View Action viewModel x = div_ [] [ input_ [ onInput (Update . readMaybe . filter (/= '"') . show) ] [] , text (toMisoString (show x)) ]

Great! We've just created an app using GHCJS and Miso.

Building the project

To build your project:

$ ./shake.hs

Inspect your app:

$ firefox target/index.html