Introduction

Elm is easily my favorite language for building webapps. I'd love to show you how to use Elm to build a Single Page App that interacts with our GraphQL backend.

Setting up a basic browser application

I'm assuming you've already installed Elm 0.19. We'll begin by making a new project:

mkdir firestorm_elm
cd firestorm_elm
elm init

This produces an elm.json file for us. Next, we need a basic application shell. We'll create that in src/Main.elm:

-- src/Main.elm
module Main exposing (main)

import Browser
import Browser.Navigation as Nav
import Html as H
import Json.Decode
import Url exposing (Url)


main =
    Browser.application
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        , onUrlRequest = onUrlRequest
        , onUrlChange = onUrlChange
        }


type alias Model =
    {}


type Msg
    = NoOp


subscriptions =
    always Sub.none


onUrlRequest =
    always NoOp


onUrlChange =
    always NoOp


view : model -> Browser.Document Msg
view model =
    { title = "Forums"
    , body =
        [ H.text "Forums" ]
    }


update msg model =
    case msg of
        NoOp ->
            ( model, Cmd.none )


init : Json.Decode.Value -> Url -> Nav.Key -> ( Model, Cmd Msg )
init flags url key =
    ( {}, Cmd.none )

This is just a basic Browser.application shell. We need to install a few dependencies:~Browser~, Json, and Url:

elm install elm/json
elm install elm/url

Now we should be able to run the app and see it in the browser:

elm reactor

Pretty exciting, right?

Introducing elm-ui

elm-ui is a package for building user interfaces in Elm. It has the best API for this that I've ever experienced, so we'll be using it.

We need to install the dependency:

elm install mdgriffith/elm-ui

Now we can use it in our view function:

module Main exposing (main)

-- ...
import Element exposing (Element, el, text)
-- ...
view : model -> Browser.Document Msg
view model =
    { title = "Forums"
    , body =
        [ Element.layout [] <| text "Forums" ]
    }
-- ...

This is extremely barebones, but you can already see we have a nice typography stack to start with.

Let's introduce a layout. I want the layout to work similarly to Material Design; that means we want a top bar (the AppBar) and a body for now - we'll introduce a FloatingActionButton later.

module Main exposing (main)

-- ...
import Element
    exposing
        ( Element
        -- ...
        , inFront
        , rgb
        , row
        -- ...
        )
import Element.Background as Background
-- ...
view : model -> Browser.Document Msg
view model =
    { title = "Forums"
    , body =
        [ Element.layout
            [ inFront <| appBar ]
          <|
            column
                [ width fill
                , height fill
                ]
                [ el
                    [ Element.padding 50 ]
                  <|
                    text "Forums"
                ]
        ]
    }


appBar : Element msg
appBar =
    row
        [ width fill
        , height (Element.px 50)
        , Background.color (rgb 255 0 0)
        ]
        [ text "Header" ]
-- ...

This gives us a rough approximation of what we're looking for…but it's not great yet. Let's start by breaking out things like padding and colors into a Brand module. I've already created this, so we'll bring it in as well as a module I built that has the Material Design color palette:

-- src/Brand.elm
module Brand exposing (appBarHeight, canvasColor, cardColor, defaultBodyPadding, defaultPadding, defaultPaddingAmount, primaryColor, primaryColorBolder, primaryTextColor, shadowColor, subtleTextColor, toElmColor)

import Color
import Element exposing (padding, rgb255, rgba255)
import Material.Color exposing (..)


primaryColor =
    red500


primaryColorBolder =
    red700


primaryTextColor =
    rgb255 255 255 255


canvasColor =
    rgb255 250 250 250


toElmColor =
    Element.toRgb >> Color.fromRgba


cardColor =
    rgb255 255 255 255


shadowColor =
    rgba255 0 0 0 0.05


subtleTextColor =
    rgb255 200 200 200


defaultPadding =
    padding defaultPaddingAmount


defaultPaddingAmount =
    20


defaultBodyPadding =
    Element.paddingEach
        { top = appBarHeight + defaultPaddingAmount
        , left = defaultPaddingAmount
        , right = defaultPaddingAmount
        , bottom = defaultPaddingAmount
        }


appBarHeight =
    75

I've created a Material Color module that returns Element.Color. You can get it from a gist:

mkdir src/Material
wget https://gist.githubusercontent.com/knewter/76d6bcb6599b0ebeb370c6fc3bd6a4e2/raw/61030e80ee8be060ac0516e7fec7bf3dbce57455/Color.elm -O src/Material/Color.elm

We also need to add the Color package:

elm install avh4/elm-color

Now we can use these in our view:

module Main exposing (main)

import Brand
-- ...
import Element.Border as Border
import Element.Font as Font
-- ...
appBody =
    row
        [ Background.color Brand.canvasColor
        , height fill
        , width fill
        , Brand.defaultBodyPadding
        ]
    <|
        [ column
            [ height fill
            , width fill
            ]
            [ text "Forums"
            ]
        ]


appBar : Element msg
appBar =
    row
        [ width fill
        , height (Element.px Brand.appBarHeight)
        , Brand.defaultPadding
        , Background.color Brand.primaryColor
        , Font.color Brand.primaryTextColor
        , Border.shadow
            { offset = ( 1, 1 )
            , size = 2
            , blur = 4
            , color = Element.rgba255 0 0 0 0.2
            }
        ]
        [ text "Header" ]
-- ...

This is looking a bit better.

Extracting a Layout module

There's a lot going on in Main now. Let's move our view-related functions into a Layout module for now.

-- src/Layout.elm
module Layout exposing (view)

import Brand
import Browser
import Element
    exposing
        ( Element
        , column
        , el
        , fill
        , height
        , inFront
        , rgb
        , row
        , text
        , width
        )
import Element.Background as Background
import Element.Border as Border
import Element.Font as Font
import Html as H


view : model -> Browser.Document msg
view model =
    { title = "Forums"
    , body =
        [ Element.layout
            [ inFront <| appBar ]
          <|
            column
                [ width fill
                , height fill
                ]
                [ appBody ]
        ]
    }


appBody =
    row
        [ Background.color Brand.canvasColor
        , height fill
        , width fill
        , Brand.defaultBodyPadding
        ]
    <|
        [ column
            [ height fill
            , width fill
            ]
            [ text "Forums"
            ]
        ]


appBar : Element msg
appBar =
    row
        [ width fill
        , height (Element.px Brand.appBarHeight)
        , Brand.defaultPadding
        , Background.color Brand.primaryColor
        , Font.color Brand.primaryTextColor
        , Border.shadow
            { offset = ( 1, 1 )
            , size = 2
            , blur = 4
            , color = Element.rgba255 0 0 0 0.2
            }
        ]
        [ text "Header" ]

Then we'll call this from our main view function:

module Main exposing (main)

import Browser
import Browser.Navigation as Nav
import Json.Decode
import Layout
import Url exposing (Url)
-- ...
view : Model -> Browser.Document Msg
view model =
    Layout.view model
-- ...

We've reduced the number of imports in Main, which is nice.

Listing categories

The root route for our application will list the categories in the forum. Let's mock that out:

-- src/Layout.elm
module Layout exposing (view)
-- ...
appBody =
    row
        [ -- ...
        ]
    <|
        [ column
            [ -- ...
            ]
            [ categoriesList
            ]
        ]


type alias Category =
    { title : String
    }


mockCategories : List Category
mockCategories =
    [ { title = "First category" }
    , { title = "Second category" }
    , { title = "Third category" }
    , { title = "Fourth category" }
    ]


categoriesList : Element msg
categoriesList =
    column
        [ height fill
        , width fill
        , Element.scrollbarY
        ]
    <|
        List.map categoryListItem mockCategories


categoryListItem : Category -> Element msg
categoryListItem category =
    row
        [ width fill
        , Brand.defaultPadding
        ]
        [ el
            [ Element.pointer
            ]
            (text category.title)
        ]
-- ...

Now we have a list of categories. Let's extract the Category type to a Types module:

-- src/Types.elm
module Types exposing (Category)


type alias Category =
    { title : String
    }
-- src/Layout.elm
module Layout exposing (view)
-- ...
import Types exposing (..)

Introducing Routing

When we click a category, we'd like to show it. We need to introduce a Route to our model so it knows what screen to show.

We'll start with a Route module:

module Route exposing (Route(..), fromUrl, parser, pushUrl, replaceUrl)

import Browser.Navigation as Nav
import Html exposing (Attribute)
import Html.Attributes as Attr
import Url exposing (Url)
import Url.Parser as Parser exposing ((</>), Parser, map, oneOf, s, string, top)



-- ROUTING


-- We start with three routes - categories, a single category, and 404
type Route
    = Categories
    | Category String
    | FourOhFour


-- We use url parser to parse a route from the URL
parser : Parser (Route -> a) a
parser =
    oneOf
        [ map Categories top
        , map Category (s "categories" </> string)
        ]



-- PUBLIC HELPERS


-- This is a little hack that lets us use the url fragment with the parser. I found this in Richard Feldman's elm-spa-example
fromUrl : Url -> Maybe Route
fromUrl url =
    -- Treat the fragment as the url itself. Doing this primarily to aid in reactor-based development for the moment.
    { url | path = Maybe.withDefault "" url.fragment, fragment = Nothing }
        |> Parser.parse parser


-- This makes it easy for us to create an href for a given route
href : Route -> Attribute msg
href targetRoute =
    Attr.href (toString targetRoute)


-- We can replace the url with the url for a given route
-- We need the navigation key in order to use `Nav` functions, which we'll store in our model
replaceUrl : Nav.Key -> Route -> Cmd msg
replaceUrl key route =
    Nav.replaceUrl key (toString route)


-- We can also push a URL with pushstate
pushUrl : Nav.Key -> Route -> Cmd msg
pushUrl key route =
    Nav.pushUrl key (toString route)


-- We need the ability to generate a string that will parse back to the route
toString : Route -> String
toString page =
    let
        pieces =
            case page of
                Categories ->
                    []

                Category categoryId ->
                    [ "categories", categoryId ]

                FourOhFour ->
                    [ "404" ]
    in
    "#/" ++ String.join "/" pieces

This uses Browser.Navigation, which can be used with a Browser.application to change the browser's URL. To do that, we need access to the Nav.Key that is provided when we start the application. We'll store it in the Model, as well as the current Route. First, let's give it its own module:

-- src/Model.elm
module Model exposing
    ( Model
    , init
    )

import Browser.Navigation as Nav
import Route exposing (Route)
import Types exposing (..)


init key url =
    let
        route =
            Route.fromUrl url
                |> Maybe.withDefault Route.FourOhFour
    in
    { key = key
    , route = route
    }


type alias Model =
    { key : Nav.Key
    , route : Route
    }
module Main exposing (main)
-- ...
import Model exposing (Model)
-- ...
init : Json.Decode.Value -> Url -> Nav.Key -> ( Model, Cmd Msg )
init flags url key =
    ( Model.init key url, Cmd.none )

Now we're parsing the url to set the route in the model. Next, we'll make the view different based on the route:

module Layout exposing (view)
-- ...
import Model exposing (Model)
import Route
-- ...

view : Model -> Browser.Document msg
view model =
    case model.route of
        Route.Categories ->
            categoriesView

        Route.Category id ->
            categoryView

        Route.FourOhFour ->
            fourOhFourView


categoriesView =
    { title = "Forums"
    , body =
        [ Element.layout
            [ inFront <| appBar ]
          <|
            column
                [ width fill
                , height fill
                ]
                [ appBody categoriesList ]
        ]
    }


categoryView =
    { title = "Forums"
    , body =
        [ Element.layout
            [ inFront <| appBar ]
          <|
            column
                [ width fill
                , height fill
                ]
                [ appBody categoryShow ]
        ]
    }


categoryShow =
    text "Some category"


fourOhFourView =
    { title = "404"
    , body =
        [ Element.layout
            [ inFront <| appBar ]
          <|
            column
                [ width fill
                , height fill
                ]
                [ appBody <| text "404" ]
        ]
    }


appBody body =
    row
        [ -- ...
        ]
    <|
        [ column
            [ -- ...
            ]
            [ body ]
        ]
-- ...

Now we render a different browser document for each route. It sure would be nice if we could actually navigate to a different route, so we could see them. Let's make clicking a category navigate to it. We'll introduce a RoutePushed Msg. First, let's make clicking emit the message:

module Layout exposing (view)
-- ...
import Element.Events as Events
-- ...
import Msg exposing (Msg(..))
-- ...
view : Model -> Browser.Document Msg
-- ...
categoriesList : Element Msg
-- ...
categoryListItem : Category -> Element Msg
categoryListItem category =
    row
        [ width fill
        , Brand.defaultPadding
        ]
        [ el
            [ Element.pointer
            , Events.onClick <| RoutePushed (Route.Category "some-category-id")
            ]
            (text category.title)
        ]
-- ...
appBar : Element Msg
-- ...

We've imported a nonexistent Msg module because we need to split it out in order to reference it both from Main and Layout, since we can't import Main into Layout as it imports Layout itself (circular references are bad mnkay?). Let's create the Msg module:

module Msg exposing (Msg(..))

import Route exposing (Route)


type Msg
    = NoOp
    -- We push a route
    | RoutePushed Route
    -- Then we react to the resulting url change
    | UrlChanged Url.Url

Now we'll update Main to handle this Msg in the update function:

module Main exposing (main)
-- ...
import Msg exposing (Msg(..))
import Route
-- ...
update msg model =
    case msg of
        NoOp ->
            ( model, Cmd.none )

        RoutePushed route ->
            ( model, Route.pushUrl model.key route )

        UrlChanged url ->
            let
                route =
                    Route.fromUrl url
                        |> Maybe.withDefault Route.FourOhFour

                nextModel =
                    Model.handleNewRoute route model
            in
            ( nextModel, Cmd.none )
-- ...

I've also added a Model.handleNewRoute function, to avoid Main knowing anything about how Model works. Let's add that:


module Model exposing
    ( -- ...
    , handleNewRoute
    -- ...
    )
-- ...
handleNewRoute : Route -> Model -> Model
handleNewRoute route model =
    { model | route = route }

This seems silly now, but more logic will accrue to this function and it's nice to keep the logic in this module.

Now, if we click a category, we navigate to it. Neat!

Listing a category's threads

When viewing a category, we should see a list of threads. Let's add that to the Category type first:

module Types exposing (Category, Thread)


type alias Category =
    { title : String
    , threads : List Thread
    }


type alias Thread =
    { title : String }

Now we'll show a mock category with some threads when on the Category route:

module Layout exposing (view)
-- ...
categoryView =
    { title = "Forums"
    , body =
        [ Element.layout
            [ inFront <| appBar ]
          <|
            column
                [ -- ...
                ]
                [ appBody categoryShow ]
        ]
    }


categoryShow =
    column
        [ height fill
        , width fill
        , Element.scrollbarY
        ]
    <|
        List.map threadListItem mockCategory.threads


threadListItem : Thread -> Element Msg
threadListItem thread =
    row
        [ width fill
        , Brand.defaultPadding
        ]
        [ el
            [ Element.pointer
            ]
            (text thread.title)
        ]
-- ...
mockCategory : Category
mockCategory =
    { title = "Some category"
    , threads =
        [ { title = "First thread" }
        , { title = "Second thread" }
        , { title = "Third thread" }
        , { title = "Fourth thread" }
        ]
    }
-- ...

Now we can see a list of threads when viewing a category.

Viewing a thread and its posts

Now we'll add a route for viewing a thread, and in the view we'll see a list of its posts.

module Route exposing (Route(..), fromUrl, parser, pushUrl, replaceUrl)
-- ...
type Route
    = -- ...
    -- The route for a thread includes both its categoryId and the threadId
    | Thread String String


parser : Parser (Route -> a) a
parser =
    oneOf
        [ -- ...
        , map Thread (s "categories" </> string </> s "threads" </> string)
        ]
-- ...
toString : Route -> String
toString page =
    let
        pieces =
            case page of
                -- ...
                Thread categoryId threadId ->
                    [ "categories", categoryId, "threads", threadId ]
                -- ...
    in
    "#/" ++ String.join "/" pieces

We'll link the thread list to the new route and show a placeholder view:

module Layout exposing (view)
-- ...
view : Model -> Browser.Document Msg
view model =
    case model.route of
        -- ...
        Route.Thread categoryId threadId ->
            threadView
        -- ...
-- ...
threadView =
    { title = "Forums"
    , body =
        [ Element.layout
            [ inFront <| appBar ]
          <|
            column
                [ width fill
                , height fill
                ]
                [ appBody threadShow ]
        ]
    }


threadShow =
    text "some thread"
-- ...
threadListItem : Thread -> Element Msg
threadListItem thread =
    row
        [ width fill
        , Brand.defaultPadding
        ]
        [ el
            [ Element.pointer
            , Events.onClick <| RoutePushed (Route.Thread "some-category-id" "some-thread-id")
            ]
            (text thread.title)
        ]
-- ...

Now we can view a thread. We should probably list its posts and make them look nice. First, we'll update our Types:

module Types exposing (Category, Post, Thread)
-- ...
type alias Thread =
    { title : String
    , posts : List Post
    }


type alias Post =
    { body : String }

Then we'll make a rough view listing the posts:

module Layout exposing (view)
-- ...
mockThread : Thread
mockThread =
    { title = "Some thread"
    , posts =
        [ { body = "First post" }
        , { body = "Second post" }
        , { body = "Third post" }
        , { body = "Fourth post" }
        ]
    }


threadShow =
    column
        [ width fill
        , Brand.defaultBodyPadding
        ]
    <|
        List.map postListItem mockThread.posts


postListItem : Post -> Element Msg
postListItem post =
    row
        [ width fill
        ]
        [ el
            []
            (text post.body)
        ]
-- ...

This is…ugly. But it's a start. Let's spruce it up a bit:


module Layout exposing (view)
-- ...
postListItem : Post -> Element Msg
postListItem post =
    -- We'll create a row that consists of the user's avatar and a card containing the user's name, the date of the post, and the body of the post
    row
        [ Element.spacing 10
        , Element.paddingXY 0 10
        , width fill
        ]
        -- `Element.image` can be used to show an image.
        [ Element.image
            -- We'll specify the width of the element; the height will adjust accordingly.
            [ width (Element.px 40)
            -- Since it's 40px wide, a border of 20px makes it a circle
            , Border.rounded 20
            -- We have to clip in order to avoid showing the bits of the square image that overflow
            , Element.clip
            -- We want this to be at the top of the row, not centered
            , Element.alignTop
            -- but it feels silly all the way at the top, so we move it down 10px
            , Element.moveDown 10
            ]
            { src = "http://placekitten.com/100/100"
            , description = "Avatar"
            }
        -- The card consists of a column, since it will show metadata at the top row and the content below.
        , Element.column
            [ width fill
            , Brand.defaultPadding
            , Background.color Brand.cardColor
            , Border.rounded 10
            , Border.shadow
                { offset = ( 1, 1 )
                , size = 4
                , blur = 10
                , color = Brand.shadowColor
                }
            ]
            -- The first element in the column is itself a row, showing the user name and the post date
            [ Element.row [ width fill ]
                [ el
                    [ Element.alignTop
                    , Font.bold
                    ]
                  <|
                    text "user name"
                , el
                    [ Element.alignRight
                    , Font.color Brand.subtleTextColor
                    ]
                  <|
                    text "2018-12-01"
                ]
            -- beneath the metadata, we show the post body
            , Element.paragraph
                []
              <|
                [ text post.body ]
            ]
        ]
-- ...

I think this looks pretty nice.

Introducing markdown

Our posts use markdown, and we expect the client to render them nicely. We'll install the markdown package:

elm install elm-explorations/markdown
module Layout exposing (view)
-- ...
import Markdown
-- ...
mockThread : Thread
mockThread =
    { title = "Some thread"
    , posts =
        [ { body = "**First** post" }
        , { body = "## Second post" }
        , { body = "[Third post](https://www.smoothterminal.com)" }
        , { body = "Fourth post" }
        ]
    }
-- ...
postListItem : Post -> Element Msg
postListItem post =
    row
        [ -- ...
        ]
        [ -- ...
        , Element.column
            [ -- ...
            ]
            [ -- ...
            , Element.paragraph
                []
              <|
                [ Element.html <|
                    Markdown.toHtml [] post.body
                ]
            ]
        ]
-- ...

It's nice that markdown's so easy, right?

Types for our layout

The Layout module is a bit busy. We'll extract each page's view to its own Page module. Before we do that, we'll introduce some types to reduce boilerplate and ensure consistency.

I've been using Flutter for mobile development recently, and find its API very nice for describing screens, so I've been modeling the views on it broadly. Flutter's material design API calls the app layout type Scaffold, so we're going to follow that nomenclature.

The type will account for the possibility that we might have a floating action button, we might not want to show an appbar, and the appbar might want to link back to the previous page or take some additional actions.

module Layout exposing (view)
-- ...
type alias ScaffoldConfig =
    { appBar : Maybe (AppBarConfig Msg)
    , body : Element Msg
    , floatingActionButton : Maybe (Element Msg)
    }


type alias AppBarConfig msg =
    { title : Maybe String
    , actions : Maybe (List (Element msg))
    , backRoute : Maybe Route.Route
    }


scaffold : ScaffoldConfig -> Html Msg
scaffold config =
    let
        body =
            appBody config.body

        floatingActionButtonOptions =
            case config.floatingActionButton of
                Nothing ->
                    []

                Just floatingActionButton ->
                    [ Element.inFront
                        (el
                            [ Element.alignRight
                            , Element.alignBottom
                            , Element.moveUp 40
                            , Element.moveLeft 40
                            ]
                            floatingActionButton
                        )
                    ]

        appBarOptions =
            case config.appBar of
                Nothing ->
                    []

                Just appBarConfig ->
                    [ Element.inFront (appBar appBarConfig) ]

        layoutOptions =
            floatingActionButtonOptions ++ appBarOptions
    in
    Element.layout
        layoutOptions
      <|
        column
            [ -- ...
            ]
        <|
            [ body ]


categoriesView =
    { title = "Forums"
    , body =
        [ scaffold
            { appBar =
                Just
                    { title = Just "Categories"
                    , backRoute = Nothing
                    , actions = Nothing
                    }
            , floatingActionButton = Nothing
            , body = categoriesList
            }
        ]
    }


threadView =
    { title = "Forums"
    , body =
        [ scaffold
            { appBar =
                Just
                    { title = Just "Thread"
                    , backRoute = Nothing
                    , actions = Nothing
                    }
            , floatingActionButton = Nothing
            , body = threadShow
            }
        ]
    }
-- ...
categoryView =
    { title = "Forums"
    , body =
        [ scaffold
            { appBar =
                Just
                    { title = Just "Category"
                    , backRoute = Nothing
                    , actions = Nothing
                    }
            , floatingActionButton = Nothing
            , body = categoryShow
            }
        ]
    }
-- ...
fourOhFourView =
    { title = "404"
    , body =
        [ scaffold
            { appBar = Nothing
            , floatingActionButton = Nothing
            , body = text "404"
            }
        ]
    }
-- ...
appBar : AppBarConfig Msg -> Element Msg
appBar config =
    let
        title =
            case config.title of
                Nothing ->
                    Element.none

                Just t ->
                    text t
    in
    row
        [ -- ...
        ]
        [ title ]

The only relevant part of the view that we haven't yet covered in a type is the browser title. Let's introduce a LayoutConfig that couples the title with a ScaffoldConfig to fully describe the browser document. Then we'll provide a mapping from the model to a LayoutConfig to wire it into our view function:

module Layout exposing (view)
-- ...
view : Model -> Browser.Document Msg
view model =
    model
        |> layoutConfig
        |> viewLayout


layoutConfig : Model -> LayoutConfig
layoutConfig model =
    case model.route of
        Route.Categories ->
            categoriesView

        Route.Category id ->
            categoryView

        Route.Thread categoryId threadId ->
            threadView

        Route.FourOhFour ->
            fourOhFourView


viewLayout : LayoutConfig -> Browser.Document Msg
viewLayout { title, scaffoldConfig } =
    { title = title
    , body =
        [ scaffold scaffoldConfig ]
    }


type alias LayoutConfig =
    { title : String
    , scaffoldConfig : ScaffoldConfig
    }
-- ...
categoriesView : LayoutConfig
categoriesView =
    { title = "Forums"
    , scaffoldConfig =
        { appBar =
            Just
                { title = Just "Categories"
                , backRoute = Nothing
                , actions = Nothing
                }
        , floatingActionButton = Nothing
        , body = categoriesList
        }
    }


threadView =
    { title = "Forums"
    , scaffoldConfig =
        { appBar =
            Just
                { title = Just "Thread"
                , backRoute = Nothing
                , actions = Nothing
                }
        , floatingActionButton = Nothing
        , body = threadShow
        }
    }
-- ...
categoryView =
    { title = "Forums"
    , scaffoldConfig =
        { appBar =
            Just
                { title = Just "Category"
                , backRoute = Nothing
                , actions = Nothing
                }
        , floatingActionButton = Nothing
        , body = categoryShow
        }
    }
-- ...
fourOhFourView =
    { title = "404"
    , scaffoldConfig =
        { appBar = Nothing
        , floatingActionButton = Nothing
        , body = text "404"
        }
    }
-- ...

Now we've defined what pages can look like. Let's extract the views to their own modules.

Extracting Pages

We'll make a directory to hold our pages:

mkdir src/Pages

We'll start by extracting the Categories page:

module Pages.Categories exposing (layoutConfig)

import Brand
import Element
    exposing
        ( Element
        , column
        , el
        , fill
        , height
        , row
        , text
        , width
        )
import Element.Events as Events
import Msg exposing (Msg(..))
import Route exposing (Route)
import Types exposing (Category)


layoutConfig model =
    { title = "Forums"
    , scaffoldConfig =
        { appBar =
            Just
                { title = Just "Categories"
                , backRoute = Nothing
                , actions = Nothing
                }
        , floatingActionButton = Nothing
        , body = categoriesList
        }
    }


categoriesList : Element Msg
categoriesList =
    column
        [ height fill
        , width fill
        , Element.scrollbarY
        ]
    <|
        List.map categoryListItem mockCategories


categoryListItem : Category -> Element Msg
categoryListItem category =
    row
        [ width fill
        , Brand.defaultPadding
        ]
        [ el
            [ Element.pointer
            , Events.onClick <| RoutePushed (Route.Category "some-category-id")
            ]
            (text category.title)
        ]


mockCategories : List Category
mockCategories =
    [ { title = "First category", threads = [] }
    , { title = "Second category", threads = [] }
    , { title = "Third category", threads = [] }
    , { title = "Fourth category", threads = [] }
    ]
module Layout exposing (view)
-- ...
import Pages.Categories
-- ...
layoutConfig : Model -> LayoutConfig
layoutConfig model =
    case model.route of
        Route.Categories ->
            Pages.Categories.layoutConfig model
        -- ...
-- ...

We've started whittling away at the Layout module. Let's keep going, with a category page:

module Pages.Category exposing (layoutConfig)

import Brand
import Element
    exposing
        ( Element
        , column
        , el
        , fill
        , height
        , row
        , text
        , width
        )
import Element.Events as Events
import Msg exposing (Msg(..))
import Route exposing (Route)
import Types exposing (Category, Thread)


layoutConfig model =
    { title = "Forums"
    , scaffoldConfig =
        { appBar =
            Just
                { title = Just "Category"
                , backRoute = Nothing
                , actions = Nothing
                }
        , floatingActionButton = Nothing
        , body = categoryShow
        }
    }


categoryShow =
    column
        [ height fill
        , width fill
        , Element.scrollbarY
        ]
    <|
        List.map threadListItem mockCategory.threads


threadListItem : Thread -> Element Msg
threadListItem thread =
    row
        [ width fill
        , Brand.defaultPadding
        ]
        [ el
            [ Element.pointer
            , Events.onClick <| RoutePushed (Route.Thread "some-category-id" "some-thread-id")
            ]
            (text thread.title)
        ]


mockCategory : Category
mockCategory =
    { title = "Some category"
    , threads =
        [ { title = "First thread", posts = [] }
        , { title = "Second thread", posts = [] }
        , { title = "Third thread", posts = [] }
        , { title = "Fourth thread", posts = [] }
        ]
    }
module Layout exposing (view)
-- ...
import Pages.Category
-- ...
layoutConfig : Model -> LayoutConfig
layoutConfig model =
    case model.route of
        -- ...
        Route.Category id ->
            Pages.Category.layoutConfig model
        -- ...
-- ...

Now we'll extract the Thread page:

module Pages.Thread exposing (layoutConfig)

import Brand
import Element
    exposing
        ( Element
        , column
        , el
        , fill
        , height
        , row
        , text
        , width
        )
import Element.Background as Background
import Element.Border as Border
import Element.Font as Font
import Markdown
import Msg exposing (Msg(..))
import Types exposing (Post, Thread)


layoutConfig model =
    { title = "Forums"
    , scaffoldConfig =
        { appBar =
            Just
                { title = Just "Thread"
                , backRoute = Nothing
                , actions = Nothing
                }
        , floatingActionButton = Nothing
        , body = threadShow
        }
    }


mockThread : Thread
mockThread =
    { title = "Some thread"
    , posts =
        [ { body = "**First** post" }
        , { body = "## Second post" }
        , { body = "[Third post](https://www.smoothterminal.com)" }
        , { body = "Fourth post" }
        ]
    }


threadShow =
    column
        [ width fill
        ]
    <|
        List.map postListItem mockThread.posts


postListItem : Post -> Element Msg
postListItem post =
    row
        [ Element.spacing 10
        , Element.paddingXY 0 10
        , width fill
        ]
        [ Element.image
            [ width (Element.px 40)
            , Border.rounded 20
            , Element.clip
            , Element.alignTop
            , Element.moveDown 10
            ]
            { src = "http://placekitten.com/100/100"
            , description = "Avatar"
            }
        , Element.column
            [ width fill
            , Brand.defaultPadding
            , Background.color Brand.cardColor
            , Border.rounded 10
            , Border.shadow
                { offset = ( 1, 1 )
                , size = 4
                , blur = 10
                , color = Brand.shadowColor
                }
            ]
            [ Element.row [ width fill ]
                [ el
                    [ Element.alignTop
                    , Font.bold
                    ]
                  <|
                    text "user name"
                , el
                    [ Element.alignRight
                    , Font.color Brand.subtleTextColor
                    ]
                  <|
                    text "2018-12-01"
                ]
            , Element.paragraph
                []
              <|
                [ Element.html <|
                    Markdown.toHtml [] post.body
                ]
            ]
        ]
module Layout exposing (view)
-- ...
import Pages.Thread
-- ...
layoutConfig : Model -> LayoutConfig
layoutConfig model =
    case model.route of
        -- ...
        Route.Thread categoryId threadId ->
            Pages.Thread.layoutConfig model
        -- ...
-- ...

The only page left to extract is the FourOhFour page:

module Pages.FourOhFour exposing (layoutConfig)

import Element exposing (text)


layoutConfig model =
    { title = "404"
    , scaffoldConfig =
        { appBar = Nothing
        , floatingActionButton = Nothing
        , body = text "404"
        }
    }
module Layout exposing (view)
-- ...
import Pages.FourOhFour
-- ...
layoutConfig : Model -> LayoutConfig
layoutConfig model =
    case model.route of
        -- ...
        Route.FourOhFour ->
            Pages.FourOhFour.layoutConfig model
-- ...

Navigating back

AppBarConfig allows for the possibility of a backRoute but we haven't used it yet. Let's introduce it.

We'll start by linking back to the Categories route from the Category page:

module Pages.Category exposing (layoutConfig)
-- ...
layoutConfig model =
    { title = "Forums"
    , scaffoldConfig =
        { appBar =
            Just
                { -- ...
                , backRoute = Just Route.Categories
                -- ...
                }
        -- ...
        }
    }
-- ...

We'll update the Layout to account for the back link in the appBar. First, we need to bring in a package that provides the material iconset:

elm install danmarcab/material-icons

Then we'll use the arrow_back icon from Material.Icons.Navigation:

module Layout exposing (view)
-- ...
import Material.Icons.Navigation
-- ...
appBar : AppBarConfig Msg -> Element Msg
appBar config =
    let
        -- ...
        backEl =
            config.backRoute
                |> Maybe.map backLink
                |> Maybe.withDefault Element.none
    in
    row
        [ -- ...
        ]
        [ backEl, title ]


backLink route =
    el
        [ Events.onClick <| RoutePushed route
        , Element.pointer
        ]
        (Element.html <|
            Material.Icons.Navigation.arrow_back (Color.rgb255 255 255 255) 25
        )

Now, if our LayoutConfig has a backRoute, there's a link to click to take you back to it.

Let's add a backRoute to the Thread page. In order to know where to navigate back to, we need to know the categoryId for the thread, so we'll pass it through to that layoutConfig function:

module Pages.Thread exposing (layoutConfig)
-- ...
import Route
-- ...
layoutConfig model categoryId =
    { title = "Forums"
    , scaffoldConfig =
        { appBar =
            Just
                { -- ...
                , backRoute = Just (Route.Category categoryId)
                -- ...
                }
        -- ...
        }
    }
-- ...
module Layout exposing (view)
-- ...
layoutConfig : Model -> LayoutConfig
layoutConfig model =
    case model.route of
        -- ...
        Route.Thread categoryId threadId ->
            Pages.Thread.layoutConfig model categoryId
        -- ...
-- ...

Introducing elm-graphql

Now that we have a moderately-decent-looking application, let's start wiring it up to the GraphQL backend. You'll need to run the backend - I'll be running the elixir backend, though any compliant backend should work.

To interace with the GraphQL server, we're going to use elm-graphql. It autogenerates type-safe GraphQL queries.

It consists of both an Elm package and an npm package (used for generating the bindings for the GraphQL server). Let's install both:

elm install dillonkearns/elm-graphql

We can generate the bindings with the npm package, but I like to generate a script in package.json so I don't need to remember how to use it.

npm init
npm install --save-dev @dillonkearns/elm-graphql
{
  // comments aren't valid in json but I wanted to focus on the important bit
  // ...
  "scripts": {
    "api": "elm-graphql http://localhost:4000/graphql --base Firestorm --output src/"
  },
  // ...
}

Now, we can run the script against the backend. I'll start the elixir backend:

mix phx.server

Then run the script:

npm run api

You can look in the src/Firestorm directory to see the modules that elm-graphql generated.

Each page is responsible for specifying the data that it needs. We'll introduce a fetchDataFor function that maps the model to a command to send for the corresponding route.

module Main exposing (main)
-- ...
update msg model =
    case msg of
        -- ...
        UrlChanged url ->
            let
                -- ...
            in
            ( nextModel
            , fetchDataFor nextModel
            )


init : Json.Decode.Value -> Url -> Nav.Key -> ( Model, Cmd Msg )
init flags url key =
    let
        model =
            Model.init key url
    in
    ( model
    , fetchDataFor model
    )


fetchDataFor : Model -> Cmd Msg
fetchDataFor { endpoint, route } =
    case route of
        Route.Categories ->
            Pages.Categories.fetchDataFor endpoint

        _ ->
            Cmd.none
module Pages.Categories exposing (fetchDataFor, layoutConfig)

import Api
-- ...
fetchDataFor : String -> Cmd Msg
fetchDataFor endpoint =
    Api.getCategories endpoint 1
-- ...

We'll introduce an Api module that handles all of our API calls:

module Api exposing (getCategories)

import Graphql.Http
import Msg exposing (Msg(..))
import Queries


getCategories : String -> Int -> Cmd Msg
getCategories endpoint page =
    Queries.getCategoriesQuery page
        |> Graphql.Http.queryRequest endpoint
        -- We have to use `withCredentials` to support a CORS endpoint that allows a wildcard origin
        |≻ Graphql.Http.withCredentials
        |> Graphql.Http.send GotCategories

We also introduce a GotCategories Msg to route the results into our Model, which will need to store them. We'll get to that in a bit.

The Queries module contains all of our queries:

module Queries exposing (getCategoriesQuery)

import Firestorm.Object
import Firestorm.Object.Category
import Firestorm.Object.PaginatedCategories
import Firestorm.Query as Query
import Graphql.Field as Field
import Graphql.Operation exposing (RootQuery)
import Graphql.OptionalArgument as OptionalArgument exposing (OptionalArgument(..))
import Graphql.SelectionSet exposing (SelectionSet, hardcoded, with)
import Types exposing (..)


getCategoriesQuery : Int -> SelectionSet (PaginatedResult Category) RootQuery
getCategoriesQuery page =
    Query.selection identity
        |> with
            (Query.categories
                (\optionals ->
                    { optionals
                        | pagination =
                            Present
                                { page = page
                                , perPage = 20
                                }
                    }
                )
                paginatedCategoriesSelection
            )


paginatedCategoriesSelection =
    Firestorm.Object.PaginatedCategories.selection PaginatedResult
        |> with Firestorm.Object.PaginatedCategories.perPage
        |> with Firestorm.Object.PaginatedCategories.page
        |> with Firestorm.Object.PaginatedCategories.totalPages
        |> with Firestorm.Object.PaginatedCategories.totalEntries
        |> with (Firestorm.Object.PaginatedCategories.entries categoryWithoutThreadsSelection)


baseCategorySelection =
    Firestorm.Object.Category.selection Category
        |> with Firestorm.Object.Category.id
        |> with Firestorm.Object.Category.title


categoryWithoutThreadsSelection =
    baseCategorySelection
        |> hardcoded []

And we introduce a PaginatedResult type to map the paginated categories query's result to:

module Types exposing (Category, PaginatedResult, Post, Thread)


type alias Category =
    { title : String
    , threads : List Thread
    }
-- ...
type alias PaginatedResult wrapped =
    { perPage : Int
    , page : Int
    , totalPages : Int
    , totalEntries : Int
    , entries : List wrapped
    }

Let's add a categories field to our Model to store the categories the API sends us:

module Model exposing
    ( Model
    , handleNewRoute
    , init
    )
-- ...
init key url =
    let
        -- ...
    in
    { -- ...
    , endpoint = "http://localhost:4000/graphql"
    , categories = []
    }


type alias Model =
    { -- ...
    , categories : List Category
    }
-- ...
gotCategories : PaginatedResult Category -> Model -> Model
gotCategories paginatedResult model =
    { model | categories = paginatedResult.entries }

We also store the graphql endpoint in the model. This way we can pass it in from the JavaScript that mounts the app, eventually. Let's introduce the Msg:

module Msg exposing (Msg(..))

import Graphql.Http
-- ...
type Msg
    = -- ...
    | GotCategories (Result (Graphql.Http.Error (PaginatedResult Category)) (PaginatedResult Category))

Then we'll handle the new Msg in our update function:

module Main exposing (main)
-- ...
update msg model =
    case msg of
        -- ...
        GotCategories result ->
            case result of
                Err e ->
                    ( model, Cmd.none )

                Ok paginatedResult ->
                    ( Model.gotCategories paginatedResult model, Cmd.none )
-- ...

Everything should be compiling now. Let's update the categories page to use the model's categories:

module Pages.Categories exposing (fetchDataFor, layoutConfig)
-- ...
layoutConfig model =
    { title = "Forums"
    , scaffoldConfig =
        { -- ...
        , body = categoriesList model.categories
        }
    }
-- ...
categoriesList : List Category -> Element Msg
categoriesList categories =
    column
        [ -- ...
        ]
    <|
        List.map categoryListItem categories
-- ...

Now if we refresh the homepage, we can see the categories from the backend.

Adding IDs

We've waited to add IDs until now. The GraphQL API has a Scalar ID type. We'll use that for the id field in the Category type to start:

module Types exposing (Category, PaginatedResult, Post, Thread)

import Firestorm.Scalar


type alias Category =
    { id : Firestorm.Scalar.Id
    -- ...
    }
-- ...

We also need to decode it when we get a category from the backend:

module Queries exposing (getCategoriesQuery)
-- ...
baseCategorySelection =
    Firestorm.Object.Category.selection Category
        |> with Firestorm.Object.Category.id
        |> with Firestorm.Object.Category.title
-- ...

We'll use that ID when we visit a category:

module Pages.Categories exposing (fetchDataFor, layoutConfig)
-- ...
import Firestorm.Scalar
-- ...
categoryListItem : Category -> Element Msg
categoryListItem category =
    case category.id of
        Firestorm.Scalar.Id categoryIdString ->
            row
                [ -- ...
                ]
                [ el
                    [ Element.pointer
                    , Events.onClick <| RoutePushed (Route.Category categoryIdString)
                    ]
                    (text category.title)
                ]

This isn't the prettiest thing. Let's add a Helpers module that can convert a Firestorm.Scalar.Id to a string so we don't litter the code with case statements just to destructure out the string:

-- src/Helpers.elm
module Helpers exposing (idToString, stringToId)

import Firestorm.Scalar


idToString : Firestorm.Scalar.Id -> String
idToString id =
    case id of
        Firestorm.Scalar.Id idString ->
            idString


stringToId : String -> Firestorm.Scalar.Id
stringToId idString =
    Firestorm.Scalar.Id idString
module Pages.Categories exposing (fetchDataFor, layoutConfig)
-- ...
import Helpers exposing (idToString)
-- ...
categoryListItem : Category -> Element Msg
categoryListItem category =
    row
        [ -- ...
        ]
        [ el
            [ Element.pointer
            , Events.onClick <| RoutePushed (Route.Category (idToString category.id))
            ]
            (text category.title)
        ]

Now we can generate the appropriate route for a category.

Fetching a category and its threads

Next, we'll introduce the query to fetch a category and its threads. First, we should introduce a function to fetch data for the category page:

module Main exposing (main)
-- ...
import Helpers exposing (stringToId)
-- ...
import Pages.Category
-- ...
fetchDataFor : Model -> Cmd Msg
fetchDataFor { endpoint, route } =
    case route of
        -- ...
        Route.Category categoryId ->
            Pages.Category.fetchDataFor endpoint (stringToId categoryId)
        -- ...
module Pages.Category exposing (fetchDataFor, layoutConfig)

import Api
-- ...
import Firestorm.Scalar
-- ...
fetchDataFor : String -> Firestorm.Scalar.Id -> Cmd Msg
fetchDataFor endpoint categoryId =
    Api.getCategory endpoint categoryId
-- ...
module Api exposing (getCategories, getCategory)

import Firestorm.Scalar
-- ...
getCategory : String -> Firestorm.Scalar.Id -> Cmd Msg
getCategory endpoint categoryId =
    Queries.getCategoryQuery categoryId
        |> Graphql.Http.queryRequest endpoint
        |> Graphql.Http.withCredentials
        |> Graphql.Http.send GotCategory
module Queries exposing (getCategoriesQuery, getCategoryQuery)
-- ...
import Firestorm.Object.Thread
-- ...
import Firestorm.Scalar
-- ...
getCategoryQuery : Firestorm.Scalar.Id -> SelectionSet Category RootQuery
getCategoryQuery categoryId =
    Query.selection identity
        |> with
            (Query.category
                { id = categoryId }
                categorySelection
            )
-- ...
categorySelection =
    baseCategorySelection
        |> with
            (Firestorm.Object.Category.threads
                threadWithoutPostsSelection
            )


threadWithoutPostsSelection =
    baseThreadSelection
        |> hardcoded []


baseThreadSelection =
    Firestorm.Object.Thread.selection Thread
        |> with Firestorm.Object.Thread.id
        |> with Firestorm.Object.Thread.title

We already know we want to decode the thread's ID as well, so let's add that to the type:

module Types exposing (Category, PaginatedResult, Post, Thread)
-- ...
type alias Thread =
    { id : Firestorm.Scalar.Id
    -- ...
    }
-- ...

When we get a category, we send a GotCategory Msg, which should store the category in our model. We'll add it to our model, add the message, and handle it in the update:

module Msg exposing (Msg(..))
-- ...
type Msg =
    -- ...
    | GotCategory (Result (Graphql.Http.Error Category) Category)
module Model exposing
    ( Model
    , gotCategories
    , gotCategory
    , handleNewRoute
    , init
    )
-- ...

init key url =
    let
        -- ...
    in
    { -- ...
    , category = Nothing
    }


type alias Model =
    { -- ...
    , category : Maybe Category
    }
-- ...
gotCategory : Category -> Model -> Model
gotCategory category model =
    { model | category = Just category }
module Main exposing (main)
-- ...
update msg model =
    case msg of
        -- ...
        GotCategory result ->
            case result of
                Err e ->
                    ( model, Cmd.none )

                Ok category ->
                    ( Model.gotCategory category model, Cmd.none )
-- ...

We should show this category on the category page, rather than our mock category:

module Pages.Category exposing (fetchDataFor, layoutConfig)
-- ...
import Helpers exposing (idToString)
-- ...
layoutConfig model =
    { title = "Forums"
    , scaffoldConfig =
        { appBar =
            -- ...
        , floatingActionButton = Nothing
        , body =
            model.category
                |> Maybe.map categoryShow
                |> Maybe.withDefault (text "Loading...")
        }
    }
-- ...
categoryShow category =
    column
        [ -- ...
        ]
    <|
        List.map (threadListItem category.iⓓcategory.threads


threadListItem : Firestorm.Scalar.Id -> Thread -> Element Msg
threadListItem categoryId thread =
    row
        [ -- ...
        ]
        [ el
            [ Element.pointer
            , Events.onClick <| RoutePushed (Route.Thread (idToString categoryId) (idToString thread.id))
            ]
            (text thread.title)
        ]
-- ...
-- remove mockCategory

Now we can see a category and its threads, as well as route to each thread.

Fetching a given thread and its posts

To fetch a thread when we land on the Thread route, we just use our fetchDataFor pattern:

module Main exposing (main)
-- ...
import Pages.Thread
-- ...
fetchDataFor : Model -> Cmd Msg
fetchDataFor { endpoint, route } =
    case route of
        -- ...
        Route.Thread categoryId threadId ->
            Pages.Thread.fetchDataFor endpoint (stringToId threadId)
        -- ...
module Pages.Thread exposing (fetchDataFor, layoutConfig)

import Api
-- ...
import Firestorm.Scalar
-- ...
fetchDataFor : String -> Firestorm.Scalar.Id -> Cmd Msg
fetchDataFor endpoint threadId =
    Api.getThread endpoint threadId
-- ...
module Api exposing (getCategories, getCategory, getThread)
-- ...
getThread : String -> Firestorm.Scalar.Id -> Cmd Msg
getThread endpoint threadId =
    Queries.getThreadQuery threadId
        |> Graphql.Http.queryRequest endpoint
        |> Graphql.Http.withCredentials
        |> Graphql.Http.send GotThread
module Queries exposing (getCategoriesQuery, getCategoryQuery, getThreadQuery)
-- ...
import Firestorm.Object.Thread
-- ...
getThreadQuery : Firestorm.Scalar.Id -> SelectionSet Thread RootQuery
getThreadQuery threadId =
    Query.selection identity
        |> with (Query.thread { id = threadId } threadSelection)
-- ...
threadSelection =
    baseThreadSelection
        |> with (Firestorm.Object.Thread.posts postSelection)


postSelection =
    Firestorm.Object.Post.selection Post
        |> with Firestorm.Object.Post.id
        |> with Firestorm.Object.Post.body

We need to add an id field to our Post type:

module Types exposing (Category, PaginatedResult, Post, Thread)
-- ...
type alias Post =
    { id : Firestorm.Scalar.Id
    , body : String
    }
-- ...

We'll add the GotThread Msg:

module Msg exposing (Msg(..))
-- ...
type Msg =
    -- ...
    | GotThread (Result (Graphql.Http.Error Thread) Thread)

Handle it in the update:

module Main exposing (main)

import Browser
import Browser.Navigation as Nav
import Helpers exposing (stringToId)
import Json.Decode
import Layout
import Model exposing (Model)
import Msg exposing (Msg(..))
import Pages.Categories
import Pages.Category
import Pages.Thread
import Route
import Url exposing (Url)


main =
    Browser.application
        { init = init
        , view = view
        , update = update
        , subscriptions = subscriptions
        , onUrlRequest = onUrlRequest
        , onUrlChange = onUrlChange
        }


subscriptions =
    always Sub.none


onUrlRequest =
    always NoOp


onUrlChange =
    UrlChanged


view : Model -> Browser.Document Msg
view model =
    Layout.view model


update msg model =
    case msg of
        NoOp ->
            ( model, Cmd.none )

        RoutePushed route ->
            ( model, Route.pushUrl model.key route )

        UrlChanged url ->
            let
                route =
                    Route.fromUrl url
                        |> Maybe.withDefault Route.FourOhFour

                nextModel =
                    Model.handleNewRoute route model
            in
            ( nextModel
            , fetchDataFor nextModel
            )

        GotCategories result ->
            case result of
                Err e ->
                    ( model, Cmd.none )

                Ok paginatedResult ->
                    ( Model.gotCategories paginatedResult model, Cmd.none )

        GotCategory result ->
            case result of
                Err e ->
                    ( model, Cmd.none )

                Ok category ->
                    ( Model.gotCategory category model, Cmd.none )

        GotThread result ->
            case result of
                Err e ->
                    ( model, Cmd.none )

                Ok thread ->
                    ( Model.gotThread thread model, Cmd.none )
-- ...
module Model exposing
    ( Model
    , gotCategories
    , gotCategory
    , gotThread
    , handleNewRoute
    , init
    )
-- ...
init key url =
    let
        -- ...
    in
    { key = key
    -- ...
    , thread = Nothing
    }


type alias Model =
    { key : Nav.Key
    -- ...
    , thread : Maybe Thread
    }
-- ...
gotThread : Thread -> Model -> Model
gotThread thread model =
    { model | thread = Just thread }

Now we simply need to use the model's thread when we're on a thread route:

module Pages.Thread exposing (fetchDataFor, layoutConfig)

import Api
import Brand
import Element
    exposing
        ( Element
        , column
        , el
        , fill
        , height
        , row
        , text
        , width
        )
import Element.Background as Background
import Element.Border as Border
import Element.Font as Font
import Firestorm.Scalar
import Markdown
import Msg exposing (Msg(..))
import Route
import Types exposing (Post, Thread)


layoutConfig model categoryId =
    { title = "Forums"
    , scaffoldConfig =
        { appBar =
            Just
                { title = Just "Thread"
                , backRoute = Just (Route.Category categoryId)
                , actions = Nothing
                }
        , floatingActionButton = Nothing
        , body =
            model.thread
                |> Maybe.map threadShow
                |> Maybe.withDefault (text "Loading...")
        }
    }


fetchDataFor : String -> Firestorm.Scalar.Id -> Cmd Msg
fetchDataFor endpoint threadId =
    Api.getThread endpoint threadId


threadShow thread =
    column
        [ -- ...
        ]
    <|
        List.map postListItem thread.posts
-- ...

Now we can list a threads posts.

Fetching a post's user

Right now we have mock user data on each post. Let's add a type and fetch it from the backend instead:

module Types exposing (Category, PaginatedResult, Post, Thread, User)
-- ...
type alias Post =
    { id : Firestorm.Scalar.Id
    , body : String
    , user : User
    }
-- ...
type alias User =
    { id : Firestorm.Scalar.Id
    , name : String
    , avatarUrl : String
    }
module Queries exposing (getCategoriesQuery, getCategoryQuery, getThreadQuery)
-- ...
import Firestorm.Object.User
-- ...
postSelection =
    Firestorm.Object.Post.selection Post
        |> with Firestorm.Object.Post.id
        |> with Firestorm.Object.Post.body
        |> with (Firestorm.Object.Post.user userSelection)


userSelection =
    Firestorm.Object.User.selection User
        |> with Firestorm.Object.User.id
        |> with Firestorm.Object.User.username
        |> with Firestorm.Object.User.avatarUrl

We can now use the actual user name and avatar when viewing a post:

module Pages.Thread exposing (fetchDataFor, layoutConfig)
-- ...
postListItem : Post -> Element Msg
postListItem post =
    row
        [ -- ...
        ]
        [ Element.image
            [ -- ...
            ]
            { src = post.user.avatarUrl
            , description = "Avatar"
            }
        , Element.column
            [ -- ...
            ]
            [ Element.row [ width fill ]
                [ el
                    [ -- ...
                    ]
                  <|
                    text post.user.name
                , -- ...
                ]
            , -- ...
            ]
        ]

I really enjoy that I can add a typed association and wire it in that quickly, knowing I actually don't have to deal with unexpected null values.

Dealing with time

Which brings us to Time. Normally dealing with time is pretty dreadful, but the Elm time API is extremely well thought out.

# elm/time gives us the basic Elm time API
elm install elm/time
# since we encode times as ISO8601 in the API, we want a parser that turns them into elm's Time type
elm install rtfeldman/elm-iso8601-date-strings

Let's track when a post was created. We'll add an insertedAt field of type Time.Posix, which tracks milliseconds since the unix epoch.

module Types exposing (Category, PaginatedResult, Post, Thread, User)
-- ...
import Time
-- ...
type alias Post =
    { -- ...
    , insertedAt : Time.Posix
    }
-- ...
module Queries exposing (getCategoriesQuery, getCategoryQuery, getThreadQuery)
-- ...
import Iso8601
import Time
-- ...
postSelection =
    Firestorm.Object.Post.selection Post
        |> with Firestorm.Object.Post.id
        |> with Firestorm.Object.Post.body
        |> with (Firestorm.Object.Post.user userSelection)
        |> with (Firestorm.Object.Post.insertedAt |> Field.map dateTimeToPosixTime)


dateTimeToPosixTime : Firestorm.Scalar.DateTime -> Time.Posix
dateTimeToPosixTime (Firestorm.Scalar.DateTime dateTimeString) =
    dateTimeString
        |> Iso8601.toTime
        |> Result.withDefault (Time.millisToPosix 0)
-- ...

Now we parse the time each post was inserted. Let's show it. We'll introduce a helper function to turn a Time.Posix into a human readable string:

module Helpers exposing (basicDateFormat, idToString, stringToId)
-- ...
import Time
-- ...
basicDateFormat : Time.Zone -> Time.Posix -> String
basicDateFormat zone time =
    let
        year =
            Time.toYear zone time

        month =
            Time.toMonth zone time

        day =
            Time.toDay zone time

        hour =
            Time.toHour zone time

        minute =
            Time.toMinute zone time

        second =
            Time.toSecond zone time
    in
    [ String.fromInt year
    , "-"
    , String.fromInt (monthToInt month) |> String.padLeft 2 '0'
    , "-"
    , String.fromInt day |> String.padLeft 2 '0'
    , " "
    , String.fromInt hour |> String.padLeft 2 '0'
    , ":"
    , String.fromInt minute |> String.padLeft 2 '0'
    , ":"
    , String.fromInt second |> String.padLeft 2 '0'
    ]
        |> String.concat


monthToInt : Time.Month -> Int
monthToInt month =
    case month of
        Time.Jan ->
            1

        Time.Feb ->
            2

        Time.Mar ->
            3

        Time.Apr ->
            4

        Time.May ->
            5

        Time.Jun ->
            6

        Time.Jul ->
            7

        Time.Aug ->
            8

        Time.Sep ->
            9

        Time.Oct ->
            10

        Time.Nov ->
            11

        Time.Dec ->
            12
module Pages.Thread exposing (fetchDataFor, layoutConfig)
-- ...
import Helpers exposing (basicDateFormat)
-- ...
import Time
-- ...
postListItem : Post -> Element Msg
postListItem post =
    row
        [ -- ...
        ]
        [ -- ...
        , Element.column
            [ -- ...
            ]
            [ Element.row [ width fill ]
                [ -- ...
                , el
                    [ -- ...
                    ]
                  <|
                    text (basicDateFormat Time.utc post.insertedAt)
                ]
            , -- ...
            ]
        ]

Now we're rendering the date format for each post in the UTC time zone. If we track the user's time zone we can pass it through here to take it into account. We won't spend time on that now.

Logging in

We want to track the login state on the application. I suspect later we'll also track details on the logged in user, but that's not supported by the API yet.

To accomplish this, we'll start with an Authentication type:

module Types exposing (Authentication(..), Category, PaginatedResult, Post, Thread, User)
-- ...
type Authentication
    = Unauthenticated
    | Authenticated String

We're either unauthenticated, or we're authenticated and we have a token for the API.

We'll track the authentication state in the Model:

module Model exposing
    ( Model
    , gotCategories
    , gotCategory
    , gotThread
    , handleNewRoute
    , init
    )
-- ...
init key url =
    let
        -- ...
    in
    { -- ...
    , authentication = Unauthenticated
    , -- ...
    }


type alias Model =
    { -- ...
    , authentication : Authentication
    , -- ...
    }
-- ...

Let's add a login route so the user can authenticate with the backend:

module Route exposing (Route(..), fromUrl, parser, pushUrl, replaceUrl)
-- ...
type Route
    = -- ...
    | Login
    | -- ...


parser : Parser (Route -> a) a
parser =
    oneOf
        [ -- ...
        , map Login (s "login")
        ]
-- ...
toString : Route -> String
toString page =
    let
        pieces =
            case page of
                -- ...

                Login ->
                    [ "login" ]

                -- ...
    in
    "#/" ++ String.join "/" pieces
module Layout exposing (view)
-- ...
import Pages.Login
-- ...
layoutConfig : Model -> LayoutConfig
layoutConfig model =
    case model.route of
        -- ...
        Route.Login ->
            Pages.Login.layoutConfig model
        -- ...
-- ...
module Pages.Login exposing (layoutConfig)

import Brand
import Element
    exposing
        ( Element
        , fill
        , spacing
        , text
        , width
        )
import Element.Background as Background
import Element.Border as Border
import Element.Events as Events
import Element.Font as Font
import Element.Input
import Html.Events
import Model exposing (Model)
import Msg exposing (Msg(..))


layoutConfig model =
    let
        appBarConfig =
            { title = Just "Login"
            , actions = Nothing
            , backRoute = Nothing
            }

        scaffoldConfig =
            { appBar = Just appBarConfig
            , body = loginView model
            , floatingActionButton = Nothing
            }
    in
    { title = "Login"
    , scaffoldConfig = scaffoldConfig
    }


loginView : Model -> Element Msg
loginView model =
    Element.column
        [ width fill
        , spacing <| 2 * Brand.defaultPaddingAmount
        , Brand.defaultBodyPadding
        ]
        [ Element.Input.text []
            { text = ""
            , onChange = always NoOp
            , placeholder = Nothing
            , label = Element.Input.labelAbove [] <| Element.text "Email"
            }
        , Element.Input.currentPassword []
            { text = ""
            , onChange = always NoOp
            , placeholder = Nothing
            , show = False
            , label = Element.Input.labelAbove [] <| Element.text "Password"
            }
        , Element.Input.button
            [ Element.alignRight
            , Brand.defaultPadding
            , Background.color Brand.primaryColor
            , Font.color Brand.primaryTextColor
            ]
            { onPress = Nothing
            , label = text "Submit"
            }
        ]

We can visit the form direectly for now, by visiting the "/login" route. This is a nice little login form, Ι think, with very little effort.

It would probably be nice to be able to visit this page. We'll add a link to it from the Categories page.

module Pages.Categories exposing (fetchDataFor, layoutConfig)
-- ...
import Color
-- ...
import Element.Background as Background
-- ...
import Element.Font as Font
-- ...
import Material.Icons.Social
-- ...
layoutConfig model =
    { title = "Forums"
    , scaffoldConfig =
        { appBar =
            Just
                { -- ...
                , actions = Just [ loginLink ]
                }
        , -- ...
        }
    }
-- ...
loginLink =
    el
        [ Element.padding 5
        , Element.pointer
        , Element.mouseOver
            [ Background.color (Element.rgba 0 0 0 0.2)
            , Font.color Brand.primaryColor
            ]
        , Events.onClick <| RoutePushed Route.Login
        ]
    <|
        Element.html <|
            Material.Icons.Social.person (Color.rgb255 255 255 255) 25

It's obviously not yet wired in. In order to authenticate, we'll need to track the email and password. Let's add a couple of Msg and track the fields in the model. We'll also add a Msg to attempt to authenticate with the backend.

We haven't actually wired up our actions in the layout yet. Let's do that.

module Layout exposing (view)
-- ...
appBar : AppBarConfig Msg -> Element Msg
appBar config =
    let
        -- ...
        actionsEl =
            config.actions
                |> Maybe.withDefault []
                |> column [ Element.alignRight ]
    in
    row
        [ -- ...
        ]
        [ backEl, title, actionsEl ]
-- ...

Now we can navigate to the login route from the categories route.

module Model exposing
    ( Model
    , gotCategories
    , gotCategory
    , gotThread
    , handleNewRoute
    , init
    , setEmail
    , setPassword
    )
-- ...
init key url =
    let
        -- ...
    in
    { -- ...
    , email = ""
    , password = ""
    }


type alias Model =
    { -- ...
    , email : String
    , password : String
    }
-- ...
setEmail : String -> Model -> Model
setEmail email model =
    { model | email = email }


setPassword : String -> Model -> Model
setPassword password model =
    { model | password = password }
module Msg exposing (Msg(..))
-- ...
type Msg
    = -- ...
    | SetEmail String
    | SetPassword String
    | Authenticate
module Main exposing (main)
-- ...
update msg model =
    case msg of
        -- ...
        SetUsername username ->
            ( Model.setUsername username model, Cmd.none )

        SetPassword password ->
            ( Model.setPassword password model, Cmd.none )

        Authenticate ->
            ( model, Cmd.none )
-- ...

Now we can track the username and password. Let's wire up these messages in the view:

module Pages.Login exposing (layoutConfig)

import Brand
import Element
    exposing
        ( Element
        , fill
        , spacing
        , text
        , width
        )
import Element.Background as Background
import Element.Border as Border
import Element.Events as Events
import Element.Font as Font
import Element.Input
import Html.Events
import Model exposing (Model)
import Msg exposing (Msg(..))


layoutConfig model =
    let
        appBarConfig =
            { title = Just "Login"
            , actions = Nothing
            , backRoute = Nothing
            }

        scaffoldConfig =
            { appBar = Just appBarConfig
            , body = loginView model
            , floatingActionButton = Nothing
            }
    in
    { title = "Login"
    , scaffoldConfig = scaffoldConfig
    }


loginView : Model -> Element Msg
loginView model =
    Element.column
        [ -- ...
        ]
        [ Element.Input.text []
            { text = model.username
            , onChange = SetUsername
            -- ...
            }
        , Element.Input.currentPassword []
            { text = model.password
            , onChange = SetPassword
            -- ...
            }
        , Element.Input.button
            [ -- ...
            ]
            { onPress = Just Authenticate
            , -- ...
            }
        ]

When we authenticate, we'll send our first mutation - aptly named authenticate.

module Main exposing (main)
-- ...
import Api
-- ...
update msg model =
    case msg of
        -- ...
        Authenticate ->
            ( model
            , Api.authenticate
                model.endpoint
                model.email
                model.password
            )
-- ...
module Api exposing (authenticate, getCategories, getCategory, getThread)
-- ...
authenticate : String -> String -> String -> Cmd Msg
authenticate endpoint email password =
    Queries.authenticateMutation email password
        |> Graphql.Http.mutationRequest endpoint
        |> Graphql.Http.withCredentials
        |> Graphql.Http.send AuthenticateResponse
module Queries exposing (authenticateMutation, getCategoriesQuery, getCategoryQuery, getThreadQuery)

import Firestorm.Mutation as Mutation
-- ...
import Graphql.Operation exposing (RootMutation, RootQuery)
-- ...
authenticateMutation : String -> String -> SelectionSet String RootMutation
authenticateMutation email password =
    Mutation.selection identity
        |> with
            (Mutation.authenticate { email = email, password = password })
module Msg exposing (Msg(..))
-- ...
type Msg
    = -- ...
    | AuthenticateResponse (Result (Graphql.Http.Error String) String)
module Main exposing (main)
-- ...
update msg model =
    case msg of
        -- ...
        AuthenticateResponse result ->
            case result of
                Err r ->
                    ( model, Cmd.none )

                Ok token ->
                    ( Model.gotToken token model, Cmd.none )
-- ...
module Model exposing
    ( Model
    , gotCategories
    , gotCategory
    , gotThread
    , gotToken
    , handleNewRoute
    , init
    , setEmail
    , setPassword
    )
-- ...
gotToken : String -> Model -> Model
gotToken token model =
    { model | authentication = Authenticated token }

Now if we type in a valid username and password, we'll be authenticated and the model will store the token we need to send in a header to make authenticated requests to the backend.

Creating a thread

Let's use our newfound authentication powers to create a thread.

Creating a thread requires sending a title and the body of the first post. It would also be nice to preview the markdown in that post prior to creating it. Let's add a route and a page:

module Route exposing (Route(..), fromUrl, parser, pushUrl, replaceUrl)
-- ...
type Route
    = -- ...
    | NewThread String
    | -- ...


parser : Parser (Route -> a) a
parser =
    oneOf
        [ -- ...
        , map NewThread (s "categories" </> string </> s "threads" </> s "new")
        -- The NewThread route has to be parsed before the Thread route, otherwise it would be parsed as a thread with id "new"
        , map Thread (s "categories" </> string </> s "threads" </> string)
        ]
-- ...
toString : Route -> String
toString page =
    let
        pieces =
            case page of
                -- ...
                NewThread categoryId ->
                    [ "categories", categoryId, "threads", "new" ]
                -- ...
    in
    "#/" ++ String.join "/" pieces
module Layout exposing (view)
-- ...
import Pages.NewThread
-- ...
layoutConfig : Model -> LayoutConfig
layoutConfig model =
    case model.route of
        -- ...
        Route.NewThread categoryId ->
            Pages.NewThread.layoutConfig model categoryId
        -- ...
-- ...
module Pages.NewThread exposing (layoutConfig)

import Brand
import Element
    exposing
        ( Element
        , fill
        , height
        , spacing
        , text
        , width
        )
import Element.Background as Background
import Element.Font as Font
import Element.Input as Input
import Firestorm.Scalar
import Helpers
import Model exposing (Model)
import Msg exposing (..)
import Route


layoutConfig model categoryId =
    let
        appBarConfig =
            { title = Just "New Thread"
            , actions = Nothing
            , backRoute = Just (Route.Category categoryId)
            }

        scaffoldConfig =
            { appBar = Just appBarConfig
            , body = newThreadView model (Helpers.stringToId categoryId)
            , floatingActionButton = Nothing
            }
    in
    { title = "New Thread"
    , scaffoldConfig = scaffoldConfig
    }


newThreadView : Model -> Firestorm.Scalar.Id -> Element Msg
newThreadView model categoryId =
    Element.column
        [ width fill
        , spacing 40
        , Brand.defaultBodyPadding
        ]
        [ Input.text []
            { onChange = always NoOp
            , text = ""
            , placeholder = Nothing
            , label = Input.labelAbove [] <| Element.text "Title"
            }
        , Input.multiline
            [ height (Element.px 300) ]
            { onChange = always NoOp
            , text = ""
            , placeholder = Nothing
            , label = Input.labelAbove [] <| Element.text "First Post"
            , spellcheck = True
            }
        , Input.button
            [ Element.alignRight
            , Brand.defaultPadding
            , Background.color Brand.primaryColor
            , Font.color Brand.primaryTextColor
            ]
            { onPress = Nothing
            , label = text "Submit"
            }
        ]

Let's add a floating action button the category page that links to this route:

module Pages.Category exposing (fetchDataFor, layoutConfig)
-- ...
import Element.Background as Background
-- ...
import Element.Font as Font
import Element.Input as Input
-- ...
layoutConfig model categoryId =
    { title = "Forums"
    , scaffoldConfig =
        { -- ...
        , floatingActionButton =
            Just
                (Input.button
                    [ Brand.defaultPadding
                    , Background.color Brand.primaryColor
                    , Font.color Brand.primaryTextColor
                    ]
                    { onPress =
                        Just <|
                            RoutePushed (Route.NewThread categoryId)
                    , label = text "New Thread"
                    }
                )
        , -- ...
        }
    }
-- ...

We need to pass the categoryId into this page's layoutConfig function now.

module Layout exposing (view)
-- ...
layoutConfig : Model -> LayoutConfig
layoutConfig model =
    case model.route of
        -- ...
        Route.Category categoryId ->
            Pages.Category.layoutConfig model categoryId
        -- ...
-- ...

Now we can visit the new thread page. It's not quite up to snuff yet; we'll handle that later.

We should track the new thread's title and the post body.

module Model exposing
    ( Model
    , gotCategories
    , gotCategory
    , gotThread
    , gotToken
    , handleNewRoute
    , init
    , setEmail
    , setPassword
    , setThreadBody
    , setThreadTitle
    )
-- ...
init key url =
    let
        -- ...
    in
    { -- ...
    , threadTitle = ""
    , threadBody = ""
    }


type alias Model =
    { -- ...
    , threadTitle : String
    , threadBody : String
    }
-- ...
setThreadTitle : String -> Model -> Model
setThreadTitle threadTitle model =
    { model | threadTitle = threadTitle }


setThreadBody : String -> Model -> Model
setThreadBody threadBody model =
    { model | threadBody = threadBody }
module Msg exposing (Msg(..))
-- ...
import Firestorm.Scalar
-- ...
type Msg
    = -- ...
    | SetThreadTitle String
    | SetThreadBody String
    | CreateThread Firestorm.Scalar.Id
    | CreateThreadResponse Firestorm.Scalar.Id (Result (Graphql.Http.Error Thread) Thread)
module Main exposing (main)
-- ...
import Helpers exposing (idToString, stringToId)
-- ...
import Types exposing (..)
-- ...
update msg model =
    case msg of
        -- ...
        SetThreadTitle threadTitle ->
            ( Model.setThreadTitle threadTitle model, Cmd.none )

        SetThreadBody threadBody ->
            ( Model.setThreadBody threadBody model, Cmd.none )

        CreateThread categoryId ->
            case model.authentication of
                Unauthenticated ->
                    ( model, Cmd.none )

                Authenticated token ->
                    ( model
                    , Api.createThread
                        model.endpoint
                        token
                        categoryId
                        model.threadTitle
                        model.threadBody
                    )

        CreateThreadResponse categoryId result ->
            case result of
                Err r ->
                    ( model, Cmd.none )

                Ok thread ->
                    ( Model.clearThreadForm model, Route.replaceUrl model.key (Route.Thread (idToString categoryId) (idToString thread.id)) )
-- ...
module Model exposing
    ( Model
    , clearThreadForm
    , gotCategories
    , gotCategory
    , gotThread
    , gotToken
    , handleNewRoute
    , init
    , setEmail
    , setPassword
    , setThreadBody
    , setThreadTitle
    )
-- ...
clearThreadForm : Model -> Model
clearThreadForm model =
    model
        |> setThreadBody ""
        |> setThreadTitle ""
module Pages.NewThread exposing (layoutConfig)
-- ...
newThreadView : Model -> Firestorm.Scalar.Id -> Element Msg
newThreadView model categoryId =
    Element.column
        [ -- ...
        ]
        [ Input.text []
            { onChange = SetThreadTitle
            , text = model.threadTitle
            , -- ...
            }
        , Input.multiline
            [ height (Element.px 300) ]
            { onChange = SetThreadBody
            , text = model.threadBody
            , -- ...
            }
        , Input.button
            [ -- ...
            ]
            { onPress = Just (CreateThread categoryId)
            , label = text "Submit"
            }
        ]

Now we should wire up CreateThread to issue a mutation:

module Api exposing (authenticate, createThread, getCategories, getCategory, getThread)
-- ...
createThread : String -> String -> Firestorm.Scalar.Id -> String -> String -> Cmd Msg
createThread endpoint token categoryId title body =
    Queries.createThreadMutation categoryId title body
        |> Graphql.Http.mutationRequest endpoint
        |> Graphql.Http.withCredentials
        |> withAuthorization token
        |> Graphql.Http.send (CreateThreadResponse categoryId)


withAuthorization token request =
    request
        |> Graphql.Http.withHeader "authorization" ("Bearer " ++ token)
module Queries exposing (authenticateMutation, createThreadMutation, getCategoriesQuery, getCategoryQuery, getThreadQuery)
-- ...
createThreadMutation : Firestorm.Scalar.Id -> String -> String -> SelectionSet Thread RootMutation
createThreadMutation categoryId title body =
    Mutation.selection identity
        |> with
            (Mutation.createThread { categoryId = categoryId, title = title, body = body } threadSelection)

Now we can create a new thread, and it will clear out the form on success.

Creating a post

Let's add a form to create a new post. We'll start with the route:

module Route exposing (Route(..), fromUrl, parser, pushUrl, replaceUrl)
-- ...
type Route
    = -- ...
    | NewPost String String
    | -- ...


parser : Parser (Route -> a) a
parser =
    oneOf
        [ -- ...
        , map NewPost (s "categories" </> string </> s "threads" </> string </> s "posts" </> s "new")
        , -- ...
        ]
-- ...
toString : Route -> String
toString page =
    let
        pieces =
            case page of
                -- ...
                NewPost categoryId threadId ->
                    [ "categories", categoryId, "threads", threadId, "posts", "new" ]
                -- ...
    in
    "#/" ++ String.join "/" pieces

Then we'll add a floating action button on the thread page to visit this form:

module Pages.Thread exposing (fetchDataFor, layoutConfig)
-- ...
import Element.Input as Input
-- ...
import Helpers exposing (basicDateFormat, idToString)
-- ...
layoutConfig model categoryId =
    { title = "Forums"
    , scaffoldConfig =
        { -- ...
        , floatingActionButton =
            case model.thread of
                Nothing ->
                    Nothing

                Just thread ->
                    Just
                        (Input.button
                            [ Brand.defaultPadding
                            , Background.color Brand.primaryColor
                            , Font.color Brand.primaryTextColor
                            ]
                            { onPress = Just (RoutePushed (Route.NewPost categoryId (idToString thread.id))), label = text "New Post" }
                        )
        , -- ...
        }
    }
-- ...
module Layout exposing (view)
-- ...
import Pages.NewThread
-- ...
layoutConfig : Model -> LayoutConfig
layoutConfig model =
    case model.route of
        -- ...
        Route.NewPost categoryId threadId ->
            Pages.NewPost.layoutConfig model categoryId threadId
        -- ...
-- ...
module Pages.NewPost exposing (layoutConfig)

import Brand
import Element exposing (Element, alignRight, centerY, column, el, fill, height, padding, rgb255, row, spacing, text, width)
import Element.Background as Background
import Element.Border as Border
import Element.Events as Events
import Element.Font as Font
import Element.Input
import Firestorm.Scalar
import Html.Events
import Markdown
import Model exposing (Model)
import Msg exposing (Msg(..))
import Route exposing (Route(..))
import Types exposing (NewPostTab(..))


layoutConfig model categoryId threadId =
    let
        submitButton =
            Element.Input.button
                [ Element.alignRight
                , Brand.defaultPadding
                , Background.color Brand.primaryColor
                , Font.color Brand.primaryTextColor
                ]
                { onPress = Just (CreatePost (Firestorm.Scalar.Id categoryId) (Firestorm.Scalar.Id threadId))
                , label = text "Submit"
                }

        appBarConfig =
            { title = Just "New Post", actions = Nothing, backRoute = Just (Route.Thread categoryId threadId) }

        scaffoldConfig =
            { appBar = Just appBarConfig
            , body = newPostView model (Firestorm.Scalar.Id categoryId) (Firestorm.Scalar.Id threadId)
            , floatingActionButton = Just submitButton
            }
    in
    { title = "New Post"
    , scaffoldConfig = scaffoldConfig
    }


newPostView : Model -> Firestorm.Scalar.Id -> Firestorm.Scalar.Id -> Element Msg
newPostView model categoryId threadId =
    let
        displayedView =
            case model.newPostTab of
                Editor ->
                    newPostFormView model.postBody

                Preview ->
                    preview model.postBody
    in
    Element.column
        [ width fill
        , height fill
        , Brand.tabbedBodyPadding
        ]
        [ newPostTabs model.newPostTab
        , displayedView
        ]


newPostTabs : NewPostTab -> Element Msg
newPostTabs newPostTab =
    row [ width fill ]
        [ tab "Editor" (newPostTab == Editor) (SetNewPostTab Editor)
        , tab "Preview" (newPostTab == Preview) (SetNewPostTab Preview)
        ]


tab : String -> Bool -> Msg -> Element Msg
tab label isActive msg =
    let
        backgroundColor =
            case isActive of
                True ->
                    Brand.primaryColorBolder

                False ->
                    Brand.primaryColor
    in
    Element.el
        [ width fill
        , Element.padding 20
        , Background.color backgroundColor
        , Font.color Brand.primaryTextColor
        , Events.onClick msg
        , Element.pointer
        ]
    <|
        text label


newPostFormView : String -> Element Msg
newPostFormView value =
    Element.Input.multiline
        [ height fill ]
        { onChange = SetPostBody
        , text = value
        , placeholder = Nothing
        , label = Element.Input.labelHidden "Post"
        , spellcheck = True
        }


preview : String -> Element Msg
preview body =
    Element.el
        [ Element.paddingXY Brand.defaultPaddingAmount 0
        , Background.color Brand.cardColor
        , width fill
        , height fill
        ]
    <|
        Element.html <|
            Markdown.toHtml [] body
module Brand exposing (appBarHeight, canvasColor, cardColor, defaultBodyPadding, defaultPadding, defaultPaddingAmount, primaryColor, primaryColorBolder, primaryTextColor, shadowColor, subtleTextColor, tabbedBodyPadding, toElmColor)
-- ...
tabbedBodyPadding =
    Element.paddingEach
        { top = appBarHeight
        , left = 0
        , right = 0
        , bottom = 0
        }
module Types exposing (Authentication(..), Category, PaginatedResult, Post, Thread, User)
-- ...
type NewPostTab
    = Editor
    | Preview
module Model exposing
    ( Model
    , clearPostForm
    , clearThreadForm
    , gotCategories
    , gotCategory
    , gotThread
    , gotToken
    , handleNewRoute
    , init
    , setEmail
    , setNewPostTab
    , setPassword
    , setPostBody
    , setThreadBody
    , setThreadTitle
    )
-- ...
init key url =
    let
        -- ...
    in
    { -- ...
    , newPostTab = Editor
    , postBody = ""
    }


type alias Model =
    { -- ...
    , newPostTab : NewPostTab
    , postBody : String
    }
-- ...
setPostBody : String -> Model -> Model
setPostBody postBody model =
    { model | postBody = postBody }


setNewPostTab : NewPostTab -> Model -> Model
setNewPostTab newPostTab model =
    { model | newPostTab = newPostTab }


clearPostForm : Model -> Model
clearPostForm model =
    model
        |> setNewPostTab Editor
        |> setPostBody ""
module Msg exposing (Msg(..))
-- ...
type Msg
    = -- ...
    | SetPostBody String
    | SetNewPostTab NewPostTab
    | CreatePost Firestorm.Scalar.Id Firestorm.Scalar.Id
module Main exposing (main)
-- ...
update msg model =
    case msg of
        -- ...
        SetPostBody postBody ->
            ( Model.setPostBody postBody model, Cmd.none )

        SetNewPostTab newPostTab ->
            ( Model.setNewPostTab newPostTab model, Cmd.none )

        CreatePost categoryId threadId ->
            ( model, Cmd.none )
-- ...

Here's our post editor - it renders a markdown preview for us. We should send a mutation to create it and redirect back to the thread after creating a post:

module Main exposing (main)
-- ...
update msg model =
    case msg of
        -- ...
        CreatePost categoryId threadId ->
            case model.authentication of
                Unauthenticated ->
                    ( model, Cmd.none )

                Authenticated token ->
                    ( model
                    , Api.createPost
                        model.endpoint
                        token
                        categoryId
                        threadId
                        model.postBody
                    )

        CreatePostResponse categoryId threadId result ->
            case result of
                Err r ->
                    ( model, Cmd.none )

                Ok thread ->
                    ( Model.clearPostForm model
                    , Route.replaceUrl model.key (Route.Thread (idToString categoryId) (idToString threadId))
                    )
-- ...
module Msg exposing (Msg(..))
-- ...
type Msg
    = -- ...
    | CreatePostResponse Firestorm.Scalar.Id Firestorm.Scalar.Id (Result (Graphql.Http.Error Post) Post)
module Api exposing (authenticate, createPost, createThread, getCategories, getCategory, getThread)
-- ...
createPost : String -> String -> Firestorm.Scalar.Id -> Firestorm.Scalar.Id -> String -> Cmd Msg
createPost endpoint token categoryId threadId body =
    Queries.createPostMutation categoryId threadId body
        |> Graphql.Http.mutationRequest endpoint
        |> Graphql.Http.withCredentials
        |> withAuthorization token
        |> Graphql.Http.send (CreatePostResponse categoryId threadId)
-- ...
module Queries exposing (authenticateMutation, createPostMutation, createThreadMutation, getCategoriesQuery, getCategoryQuery, getThreadQuery)
-- ...
createPostMutation : Firestorm.Scalar.Id -> String -> SelectionSet Post RootMutation
createPostMutation threadId body =
    Mutation.selection identity
        |> with
            (Mutation.createPost { threadId = threadId, body = body } postSelection)

Now we can create new posts.

Setting up parcel to serve the app

We're going to be bringing in a JavaScript dependency, which means we can't run the app in the reactor anymore.

We'll create an HTML file and a JavaScript file to run the app:

<!-- src/index.html -->
<html>

<head>
    <title>Forums</title>
    <script src="./index.js"></script>
</head>

<body>
    <main></main>
</body>

</html>
// src/index.js
import('./Main.elm')
    .then(({ Elm }) => {
        let node = document.querySelector('main');

        const app = Elm.Main.init({ node: node });
    });

Now we'll use parcel to bundle the app and give us a nice development experience.

npm install --save-dev parcel-bundler
# and we can run it
npm run parcel src/index.html
./node_modules/.bin/parcel src/index.html

We should probably make a script as this will likely be something we run a lot:

{
  // ...
  "scripts": {
    // ...
    "dev": "parcel src/index.html"
  },
  // ...
}
npm run dev

Now we can visit the app at http://localhost:1234.

Using absinthe subscriptions to see new data in realtime

We have a broadly usable forum client, but we could take advantage of GraphQL Subscriptions to make it show new data in realtime. It seems criminal not to do that.

We'll begin by finding out when new categories are created and showing them, when we're on that screen.

There's no Elm package for interacting with absinthe sockets yet. Luckily there's a nice npm package for it, so we can just wire it in with a port.

We'll start by installing the package:

npm install --save @absinthe/socket

Let's update the index.js file to load this package, connect to the backend, and observe the categoryAdded subscription:

import * as AbsintheSocket from "@absinthe/socket";
import { Socket as PhoenixSocket } from "phoenix";

const absintheSocket = AbsintheSocket.create(
    new PhoenixSocket("ws://localhost:4000/socket")
)

function onStart(data) {
    console.log(">>> Start", JSON.stringify(data))
}

function onAbort(data) {
    console.log(">>> Abort", JSON.stringify(data))
}

function onCancel(data) {
    console.log(">>> Cancel", JSON.stringify(data))
}

function onError(data) {
    console.log(">>> Error", JSON.stringify(data))
}

function onResult(res) {
    console.log(">>> Result", JSON.stringify(res))
}

import('./Main.elm')
    .then(({ Elm }) => {
        let node = document.querySelector('main');
        const app = Elm.Main.init({ node: node });

        const categoryAddedSubscription = "subscription { categoryAdded { id } }"
        const notifier = AbsintheSocket.send(absintheSocket, {
            operation: categoryAddedSubscription
        });

        AbsintheSocket.observe(absintheSocket, notifier, {
            onAbort,
            onError,
            onCancel,
            onStart,
            onResult
        })

    });

The app will automatically reload, thanks to parcel. We should see the websocket connected. We can create a category using GraphQL Playground:

mutation createCategory {
  createCategory(title:"New Category"){
    id
  }
}

We see the new category logged in the console. Let's use ports to provide the Elm application control over the subscriptions.

We'll add a port named `createSubscriptions`. When we send a list of subscriptions out the port, the JavaScript will cancel all existing subscriptions and subscribe to the ones we specify.

First, let's wire it up on the JavaScript side:

// ...
import notifierFind from "@absinthe/socket/dist/notifier/find";
// ...

let absintheSocket = AbsintheSocket.create(
    new PhoenixSocket("ws://localhost:4000/socket")
)

let notifiers = []

function onStart(data) {
    console.log(">>> Start", JSON.stringify(data))
}

function onAbort(data) {
    console.log(">>> Abort", JSON.stringify(data))
}

function onCancel(data) {
    console.log(">>> Cancel", JSON.stringify(data))
}

function onError(data) {
    console.log(">>> Error", JSON.stringify(data))
}

function onResult(res) {
    console.log(">>> Result", JSON.stringify(res))
}


import('./Main.elm')
    .then(({ Elm }) => {
        var node = document.querySelector('main');
        const app = Elm.Main.init({ node: node });
        app.ports.createSubscriptions.subscribe(function (operations) {
            console.log("createSubscriptions called with", operations)
            absintheSocket = notifiers.reduce(
                (socket, notifier) => {
                    const disposableNotifier =
                        notifierFind(
                            socket.notifiers,
                            "request",
                            notifier.request
                        )
                    if (disposableNotifier) {
                        return AbsintheSocket.cancel(
                            socket,
                            disposableNotifier
                        )
                    } else {
                        return socket
                    }
                },
                absintheSocket
            )

            notifiers = operations.map(operation => AbsintheSocket.send(absintheSocket, {
                operation,
                variables: {}
            }))

            absintheSocket = notifiers.reduce((socket, notifier) =>
                AbsintheSocket.observe(socket, notifier, {
                    onAbort,
                    onError,
                    onCancel,
                    onStart,
                    onResult
                }), absintheSocket)
        });
    });

Let's set up the port from the Elm side:

port module Main exposing (main)
-- ...
import Graphql.Document
-- ...
import Json.Decode
-- ...
import Json.Encode
-- ...
import Subscriptions
-- ...
update msg model =
    case msg of
        -- ...
        UrlChanged url ->
            let
                route =
                    Route.fromUrl url
                        |> Maybe.withDefault Route.FourOhFour

                nextModel =
                    Model.handleNewRoute route model
            in
            ( nextModel
            , Cmd.batch
                [ fetchDataFor nextModel
                , nextModel
                    |> graphqlSubscriptions
                    |> createSubscriptions
                ]
            )
        -- ...


init : Json.Decode.Value -> Url -> Nav.Key -> ( Model, Cmd Msg )
init flags url key =
    let
        model =
            Model.init key url
    in
    ( model
    , Cmd.batch
        [ fetchDataFor model
        , model
            |> graphqlSubscriptions
            |> createSubscriptions
        ]
    )
-- ...
port createSubscriptions : Json.Encode.Value -> Cmd msg


graphqlSubscriptions : Model -> Json.Encode.Value
graphqlSubscriptions model =
    Json.Encode.list Json.Encode.string <|
        case model.route of
            Route.Categories ->
                [ Subscriptions.categoryAdded
                    |> Graphql.Document.serializeSubscription
                ]

            _ ->
                []
-- src/Subscriptions.elm
module Subscriptions exposing (categoryAdded)

import Firestorm.Scalar
import Firestorm.Subscription as Subscription
import Graphql.Operation exposing (RootSubscription)
import Graphql.SelectionSet exposing (SelectionSet, hardcoded, with)
import Queries exposing (categorySelection)
import Types exposing (..)


categoryAdded : SelectionSet Category RootSubscription
categoryAdded =
    Subscription.selection identity
        |> with (Subscription.categoryAdded categorySelection)
module Queries exposing (authenticateMutation, categorySelection, createPostMutation, createThreadMutation, getCategoriesQuery, getCategoryQuery, getThreadQuery)
-- ...

Now we should be sending a list containing only the categoryAdded subscription when we visit the Categories page. Let's reload the app and ensure this works by sending a category when on that page and ensure we see the data come in. Then we'll do the same on another page and ensure that we don't see any data come in.

When we find out about a new category, let's put it on the front of the list. We'll use an incoming port for that:

port module Main exposing (main)
-- ...
import Queries
-- ...
import Graphql.SelectionSet exposing (with)
-- ...
type SubscriptionData
    = CategoryAddedSubscription Category


subscriptions model =
    gotSubscriptionData GotSubscriptionData
-- ...
update msg model =
    case msg of
        -- ...
        GotSubscriptionData subscriptionData ->
            let
                categoryAddedDecoder =
                    Graphql.Document.decoder
                        (Subscription.selection identity
                            |> with (Subscription.categoryAdded Queries.categoryWithoutThreadsSelection)
                        )

                subscriptionDataDecoder =
                    Json.Decode.oneOf
                        [ categoryAddedDecoder |> Json.Decode.map CategoryAddedSubscription
                        ]

                data =
                    subscriptionData
                        |> Json.Decode.decodeValue subscriptionDataDecoder
            in
            case data of
                Ok decoded ->
                    case decoded of
                        CategoryAddedSubscription category ->
                            ( Model.categoryAdded model category, Cmd.none )

                Err e ->
                    ( model, Cmd.none )
-- ...
port gotSubscriptionData : (Json.Encode.Value -> msg) -> Sub msg
module Msg exposing (Msg(..))
-- ...
import Json.Decode
-- ...
type Msg
    = -- ...
    | GotSubscriptionData Json.Decode.Value
module Model exposing
    ( -- ...
    , categoryAdded
    , -- ...
    )
-- ...
categoryAdded : Category -> Model -> Model
categoryAdded category model =
    { model | categories = [ category ] ++ model.categories }
module Queries exposing
    ( -- ...
    , categoryWithoutThreadsSelection
    , -- ...
    )
-- ...
// ...
function onResult(app) {
    return res => {
        console.log(">>> Result", JSON.stringify(res))
        app.ports.gotSubscriptionData.send(res)
    }
}

import('./Main.elm')
    .then(({ Elm }) => {
        // ...
        app.ports.createSubscriptions.subscribe(function (operations) {
            // ...
            absintheSocket = notifiers.reduce((socket, notifier) =>
                AbsintheSocket.observe(socket, notifier, {
                    onAbort,
                    onError,
                    onCancel,
                    onStart,
                    onResult: onResult(app)
                }), absintheSocket)
        });
    });

Now if we create a new category, we'll see it appear at the top of the categories list.

When we're looking at a category, let's subscribe to new threads for that category:

module Subscriptions exposing (categoryAdded, threadAdded)
-- ...
import Queries exposing (categorySelection, threadWithoutPostsSelection)
-- ...
threadAdded : Firestorm.Scalar.Id -> SelectionSet Thread RootSubscription
threadAdded categoryId =
    Subscription.selection identity
        |> with (Subscription.threadAdded { categoryId = categoryId } threadWithoutPostsSelection)
module Queries exposing
    ( -- ...
    , threadWithoutPostsSelection
    )
port module Main exposing (main)
-- ...
type SubscriptionData
    = -- ...
    | ThreadAddedSubscription Thread
-- ...
update msg model =
    case msg of
        -- ...
         GotSubscriptionData subscriptionData ->
            let
                -- ...
                categoryId =
                    case model.category of
                        Nothing ->
                            stringToId ""

                        Just category ->
                            category.id

                threadAddedDecoder =
                    Graphql.Document.decoder
                        (Subscription.selection identity
                            |> with (Subscription.threadAdded { categoryId = categoryId } Queries.threadWithoutPostsSelection)
                        )

                subscriptionDataDecoder =
                    Json.Decode.oneOf
                        [ -- ...
                        , threadAddedDecoder |> Json.Decode.map ThreadAddedSubscription
                        ]
                -- ...
            in
            case data of
                Ok decoded ->
                    case decoded of
                        -- ...
                        ThreadAddedSubscription thread ->
                            ( Model.threadAdded thread model, Cmd.none )

                Err e ->
                    ( model, Cmd.none )
-- ...
graphqlSubscriptions : Model -> Json.Encode.Value
graphqlSubscriptions model =
    Json.Encode.list Json.Encode.string <|
        case model.route of
            -- ...
            Route.Category categoryId ->
                [ Subscriptions.threadAdded (stringToId categoryId)
                    |> Graphql.Document.serializeSubscription
                ]
            -- ...
-- ...
module Model exposing
    ( -- ...
    , threadAdded
    )
-- ...
threadAdded : Thread -> Model -> Model
threadAdded thread model =
    { model | category = model.category |> Maybe.map (\c -> { c | threads = [ thread ] ++ c.threads }) }

Now we see new threads when they're created in the category we're viewing. We can do the same thing to see new posts in a thread:

port module Main exposing (main)
-- ...
type SubscriptionData
    = -- ...
    | PostAddedSubscription Post
-- ...
update msg model =
    case msg of
        -- ...
        GotSubscriptionData subscriptionData ->
            let
                -- ...
                threadId =
                    case model.thread of
                        Nothing ->
                            stringToId ""

                        Just thread ->
                            thread.id

                postAddedDecoder =
                    Graphql.Document.decoder
                        (Subscription.selection identity
                            |> with (Subscription.postAdded { threadId = threadId } Queries.postSelection)
                        )

                subscriptionDataDecoder =
                    Json.Decode.oneOf
                        [ -- ...
                        , postAddedDecoder |> Json.Decode.map PostAddedSubscription
                        ]
                -- ...
            in
            case data of
                Ok decoded ->
                    case decoded of
                        -- ...
                        PostAddedSubscription post ->
                            ( Model.postAdded post model, Cmd.none )

                Err e ->
                    ( model, Cmd.none )
-- ...
graphqlSubscriptions : Model -> Json.Encode.Value
graphqlSubscriptions model =
    Json.Encode.list Json.Encode.string <|
        case model.route of
            -- ...
            Route.Thread categoryId threadId ->
                [ Subscriptions.postAdded (stringToId threadId)
                    |> Graphql.Document.serializeSubscription
                ]
            -- ...
-- ...
module Model exposing
    ( -- ...
    , postAdded
    , -- ...
    )
-- ...
postAdded : Post -> Model -> Model
postAdded post model =
    { model | thread = model.thread |> Maybe.map (\t -> { t | posts = t.posts ++ [ post ] }) }
module Subscriptions exposing (categoryAdded, postAdded, threadAdded)
-- ...
import Queries exposing (categorySelection, postSelection, threadWithoutPostsSelection)
-- ...
postAdded : Firestorm.Scalar.Id -> SelectionSet Post RootSubscription
postAdded threadId =
    Subscription.selection identity
        |> with (Subscription.postAdded { threadId = threadId } postSelection)
module Queries exposing
    ( -- ...
    , postSelection
    , -- ...
    )

That's it. In fairly short order we've wired up subscriptions for the forum client. There are a few things we should really clean up - like not subscribing at all in the Nothing case, and moving subscription knowledge to each page. We won't do that here, but feel free to try it out.

Previewing new threads

We have a new post preview, but we don't have one for new threads. That seems unnecessarily limiting. Also, we'd like the tabs to butt up against the top bar, but right now each page has a default padding. Let's change the ScaffoldConfig type to understand two scenarios - Padded and Unpadded pages:

module Layout exposing (view)
-- ...
import Types exposing (BodyLayout(..))
-- ...
type alias ScaffoldConfig =
    { -- ...
    , body : ( BodyLayout, Element Msg )
    , -- ...
    }
-- ...
appBody ( bodyLayout, body ) =
    let
        padding =
            case bodyLayout of
                Padded ->
                    Brand.defaultBodyPadding

                Unpadded ->
                    Brand.unpaddedBodyPadding
    in
    row
        [ -- ...
        , padding
        ]
    <|
        [ -- ...
        ]
-- ...
module Brand exposing
    ( -- ...
    , unpaddedBodyPadding
    )
-- ...
unpaddedBodyPadding =
    Element.padding 0
-- ...
module Pages.Login exposing (layoutConfig)
-- ...
import Types exposing (BodyLayout(..))


layoutConfig model =
    let
        -- ...
        scaffoldConfig =
            { -- ...
            , body = ( Padded, loginView model )
            , -- ...
            }
    in
    -- ...
-- ...
module Pages.Categories exposing (fetchDataFor, layoutConfig, subscriptions)
-- ...
import Types exposing (BodyLayout(..), Category)
-- ...


layoutConfig model =
    { -- ...
    , scaffoldConfig =
        { -- ...
        , body = ( Padded, categoriesList model.categories )
        }
    }
-- ...
module Pages.Category exposing (fetchDataFor, layoutConfig, subscriptions)
-- ...
import Types exposing (BodyLayout(..), Category, Thread)


layoutConfig model categoryId =
    { -- ...
    , scaffoldConfig =
        { -- ...
        , body =
            ( Padded
            , model.category
                |> Maybe.map categoryShow
                |> Maybe.withDefault (text "Loading...")
            )
        }
    }
-- ...
module Pages.Thread exposing (fetchDataFor, layoutConfig, subscriptions)
-- ...
import Types exposing (BodyLayout(..), Post, Thread)


layoutConfig model categoryId =
    { -- ...
    , scaffoldConfig =
        { -- ...
        , body =
            ( Padded
            , model.thread
                |> Maybe.map threadShow
                |> Maybe.withDefault (text "Loading...")
            )
        }
    }
-- ...
module Pages.FourOhFour exposing (layoutConfig)

-- ...
import Types exposing (BodyLayout(..))


layoutConfig model =
    { -- ...
    , scaffoldConfig =
        { -- ...
        , body = ( Padded, text "404" )
        }
    }
module Pages.NewPost exposing (layoutConfig)
-- ...
import Types exposing (BodyLayout(..), NewPostTab(..))


layoutConfig model categoryId threadId =
    let
        -- ...
        scaffoldConfig =
            { -- ...
            , body =
                ( Unpadded
                , newPostView model (Firestorm.Scalar.Id categoryId) (Firestorm.Scalar.Id threadId)
                )
            , -- ...
            }
    in
    -- ...
-- ...
module Pages.NewThread exposing (layoutConfig)
-- ...
import Types exposing (BodyLayout(..))


layoutConfig model categoryId =
    let
        -- ...
        scaffoldConfig =
            { -- ...
            , body =
                ( Unpadded
                , newThreadView model (Helpers.stringToId categoryId)
                )
            , -- ...
            }
    in
    -- ...
-- ...

Now the tabs on the NewPost page bump up against the app bar. Let's update the NewThread page to use tabs as well:

module Pages.NewThread exposing (layoutConfig)

import Brand
import Element
    exposing
        ( Element
        , fill
        , height
        , row
        , spacing
        , text
        , width
        )
import Element.Background as Background
import Element.Events as Events
import Element.Font as Font
import Element.Input as Input
import Firestorm.Scalar
import Helpers
import Markdown
import Model exposing (Model)
import Msg exposing (..)
import Route
import Types exposing (BodyLayout(..), NewPostTab(..))


layoutConfig model categoryId =
    let
        submitButton =
            Input.button
                [ Element.alignRight
                , Brand.defaultPadding
                , Background.color Brand.primaryColor
                , Font.color Brand.primaryTextColor
                ]
                { onPress = Just (CreateThread (stringToId categoryId))
                , label = text "Submit"
                }

        appBarConfig =
            { title = Just "New Thread"
            , actions = Nothing
            , backRoute = Just (Route.Category categoryId)
            }

        scaffoldConfig =
            { appBar = Just appBarConfig
            , body =
                ( Unpadded
                , newThreadView model (stringToId categoryId)
                )
            , floatingActionButton = Just submitButton
            }
    in
    { title = "New Thread"
    , scaffoldConfig = scaffoldConfig
    }


newThreadView : Model -> Firestorm.Scalar.Id -> Element Msg
newThreadView model categoryId =
    let
        displayedView =
            case model.newThreadTab of
                Editor ->
                    newThreadFormView model.threadTitle model.threadBody

                Preview ->
                    preview model.threadTitle model.threadBody
    in
    Element.column
        [ width fill
        , height fill
        , Brand.tabbedBodyPadding
        ]
        [ newThreadTabs model.newThreadTab
        , displayedView
        ]


newThreadTabs : NewPostTab -> Element Msg
newThreadTabs newThreadTab =
    row [ width fill ]
        [ tab "Editor" (newThreadTab == Editor) (SetNewThreadTab Editor)
        , tab "Preview" (newThreadTab == Preview) (SetNewThreadTab Preview)
        ]


tab : String -> Bool -> Msg -> Element Msg
tab label isActive msg =
    let
        backgroundColor =
            case isActive of
                True ->
                    Brand.primaryColorBolder

                False ->
                    Brand.primaryColor
    in
    Element.el
        [ width fill
        , Element.padding 20
        , Background.color backgroundColor
        , Font.color Brand.primaryTextColor
        , Events.onClick msg
        , Element.pointer
        ]
    <|
        text label


newThreadFormView : String -> String -> Element Msg
newThreadFormView title body =
    Element.column
        [ width fill
        , spacing 40
        , Brand.defaultPadding
        ]
        [ Input.text []
            { onChange = SetThreadTitle
            , text = title
            , placeholder = Nothing
            , label = Input.labelAbove [] <| Element.text "Title"
            }
        , Input.multiline
            [ height (Element.px 300) ]
            { onChange = SetThreadBody
            , text = body
            , placeholder = Nothing
            , label = Input.labelAbove [] <| Element.text "First Post"
            , spellcheck = True
            }
        ]


preview : String -> String -> Element Msg
preview title body =
    Element.el
        [ Element.paddingXY Brand.defaultPaddingAmount 0
        , Background.color Brand.cardColor
        , width fill
        , height fill
        ]
    <|
        Element.html <|
            Markdown.toHtml [] <|
                "##"
                    ++ title
                    ++ "\n"
                    ++ body
module Msg exposing (Msg(..))
-- ...
type Msg
    = -- ...
    | SetNewThreadTab NewPostTab
module Model exposing
    ( -- ...
    , setNewThreadTab
    , -- ...
    )

import Browser.Navigation as Nav
import Graphql.Http
import Route exposing (Route)
import Types exposing (..)


init key url =
    let
        -- ...
    in
    { -- ...
    , newThreadTab = Editor
    , -- ...
    }


type alias Model =
    { -- ...
    , newThreadTab : NewPostTab
    , -- ...
    }
-- ...
setNewThreadTab : NewPostTab -> Model -> Model
setNewThreadTab newThreadTab model =
    { model | newThreadTab = newThreadTab }
port module Main exposing (main)
-- ...
update msg model =
    case msg of
        -- ...
        SetNewThreadTab newThreadTab ->
            ( Model.setNewThreadTab newThreadTab model, Cmd.none )
-- ...

Summary

We just built an essentially-complete realtime forum application in Elm. This is a great start.

Now find something that could be better, and send us a pull request :)

Here are some ideas - feel free to add a GitHub issue for these ideas and let us know if you're working on them, we'll be glad to help:

  • Retain the authentication token and thread it into the flags when we start the application.
  • Move control of the subscriptions to the corresponding pages, the same way fetchDataFor works.
  • Use krisajenkins/remotedata to model the GraphQL resources. You can handle the Loading state with damienklinner/elm-spinner, or any other way you'd like.
  • General cleanup of the code.
  • Finding a few more types.
  • Handling pagination for categories, potentially with FabienHenon/elm-infinite-scroll.

    • We should introduce pagination for other resources on the backend as well.
  • Encourage unauthenticated users to log in and redirect them back to the previous route, at the point that they need authentication.