DEV Community: Moremi Vannak

Pure in-app navigation implemented in Elm (URL become a thin wrapper instead)

Moremi Vannak — Tue, 27 Oct 2026 07:56:32 +0000

In the usual Elm app the URL is the source of truth. To go somewhere, update writes the URL, and the app only moves when the URL comes back as UrlChanged. This works, but after a while I found three problems with it, so I tried the other way around: the model owns where the app is, and the URL just follows it. I am writing it down in case I forget, or in case someone else finds it useful.

You can see the sample code here: https://github.com/rinn7e/elm-navigation-project

It has the same small blog three times (a list of posts, a post, an about page, a login page, and a page to write a new post that only signed-in users can open):

elm-blog: the usual way, as in elm-spa-example
elm-blog-url-wrapper: the thin URL wrapper
elm-blog-url-wrapper-screen-naming: the same as the second one, with other names

The test account is test / testtest.

Requirement

This post aims for those who are already familiar with Elm and Browser.application.

Every tool is a local dev dependency (Elm, elm-format, Vite with vite-plugin-elm, Tailwind v4), so in each app folder this is enough:

npm install
npm run dev

The usual way

Until the section on opaque types, the snippets show the apps as they were at this commit. That section adds opaque types to all three apps.

Here are the branches of update in elm-blog that write the URL:

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case ( msg, model.page ) of
        ( LinkClicked urlRequest, _ ) ->
            case urlRequest of
                Browser.Internal url ->
                    ( model, Nav.pushUrl model.key (Url.toString url) )

                Browser.External href ->
                    ( model, Nav.load href )

        ( UrlChanged url, _ ) ->
            changeRouteTo (Route.fromUrl url) model

        ( ClickedLogout, _ ) ->
            ( { model | user = Nothing }
            , Cmd.batch [ storeUser Nothing, Route.replaceUrl model.key Route.Home ]
            )

        ( GotLoginMsg subMsg, Login login ) ->
            case Login.update subMsg login of
                ( _, Just user ) ->
                    ( { model | user = Just user }
                    , Cmd.batch [ storeUser (Just user), Route.replaceUrl model.key Route.Home ]
                    )

        -- ...

And the guard lives in changeRouteTo, where the URL comes back:

        Just Route.NewPost ->
            if model.user == Nothing then
                ( model, Route.replaceUrl model.key Route.Login )

            else
                ( { model | page = NewPost NewPost.init }, Cmd.none )

The problems with this are:

Navigation is spread over update. Every branch that wants to move the app has to write the URL itself. A new branch that forgets it leaves the URL showing something other than the screen.
The echo. Everything the app writes comes back as UrlChanged, so one move is two updates: one that writes the URL, and one that really changes the page. I wrote about this before in Solving Elm Router "Double Update" Problem, where I needed an isInternal flag to ignore it. With a guard it is even more: a guest clicking "Write" is three messages and two URL writes (LinkClicked, push /new, UrlChanged /new, replace /login, UrlChanged /login).
The sync. Between the write and the echo, the model and the URL do not agree. Right after a login, model.user is set but the page is still the login page until UrlChanged arrives.

The idea

The URL is not state. It shows where the app is, the same way the view shows what the app holds, so it can be written from the model too:

The model owns where the app is (the destination). update never touches the URL.
One wrapper around the root update writes the URL after every step, from the destination read from the model. A change of destination pushes an entry, the same destination writes nothing.
The URL is never the source of truth: it is only parsed into a move at boot, on back / forward, and when a link is clicked (Elm hands links to us as URLs). The guard runs on every move, and when it redirects, the URL is corrected with a replace.
Only one module (Route) knows how a destination is spelled as a URL.

The thin URL wrapper

The Route module and the pages do not change at all. Everything below is in Main.elm of elm-blog-url-wrapper.

1. The destination is read, not stored

The page in the model already says where the app is, so the destination is not stored a second time. It is read from the page:

destinationOf : Model -> Maybe Route
destinationOf model =
    case model.page of
        NotFound ->
            Nothing

        Home ->
            Just Route.Home

        Post slug ->
            Just (Route.Post slug)

        About ->
            Just Route.About

        Login _ ->
            Just Route.Login

        NewPost _ ->
            Just Route.NewPost

In a bigger app each part of the model keeps its own piece (the screen shown, an open dialog, a tab) and destinationOf puts them together.

2. Navigating is a model change

A move goes through the guard, and the destination shown already is dropped. It returns a Model, there is no Cmd:

navigate : Maybe Route -> Model -> Model
navigate maybeRoute model =
    let
        destination =
            guard model maybeRoute
    in
    if destination == destinationOf model then
        model

    else
        openPage destination model


guard : Model -> Maybe Route -> Maybe Route
guard model maybeRoute =
    case maybeRoute of
        Just Route.Login ->
            if model.user /= Nothing then
                Just Route.Home

            else
                maybeRoute

        Just Route.NewPost ->
            if model.user == Nothing then
                Just Route.Login

            else
                maybeRoute

        _ ->
            maybeRoute

openPage is the old changeRouteTo without the guard and without the Cmd.

So the branches of update only change the model. A login sets the user and navigates home, and nothing in update knows about the URL:

        ( LinkClicked urlRequest, _ ) ->
            case urlRequest of
                Browser.Internal url ->
                    ( navigate (Route.fromUrl url) model, Cmd.none )

                Browser.External href ->
                    ( model, Nav.load href )

        ( UrlChanged url, _ ) ->
            ( navigate (Route.fromUrl url) model, Cmd.none )

        ( ClickedLogout, _ ) ->
            ( navigate (Just Route.Home) { model | user = Nothing }
            , storeUser Nothing
            )

        ( GotLoginMsg subMsg, Login login ) ->
            case Login.update subMsg login of
                ( _, Just user ) ->
                    ( navigate (Just Route.Home) { model | user = Just user }
                    , storeUser (Just user)
                    )

        -- ...

Links stay a tags with an href (open in a new tab still works). Elm sends every plain click on them to onUrlRequest, so LinkClicked is just one more move: it opens the page, it does not push the URL.

3. The wrapper

This is the only place that writes the URL:

updateWithUrl : Msg -> Model -> ( Model, Cmd Msg )
updateWithUrl msg model =
    let
        ( newModel, cmd ) =
            update msg model
    in
    ( newModel, Cmd.batch [ urlCmd msg model newModel, cmd ] )


urlCmd : Msg -> Model -> Model -> Cmd Msg
urlCmd msg model newModel =
    case ( msg, destinationOf newModel ) of
        ( _, Nothing ) ->
            -- The not found page writes no URL: no link of the app leads to it
            Cmd.none

        ( UrlChanged url, Just route ) ->
            if Route.fromUrl url == Just route then
                Cmd.none

            else
                Route.replaceUrl newModel.key route

        ( _, Just route ) ->
            if destinationOf model == Just route then
                Cmd.none

            else if guard newModel (destinationOf model) /= destinationOf model then
                -- The guard would redirect the destination before
                Route.replaceUrl newModel.key route

            else
                Route.pushUrl newModel.key route

And it replaces update in the program:

main : Program (Maybe String) Model Msg
main =
    Browser.application
        { init = init
        , view = view
        , update = updateWithUrl
        , subscriptions = \_ -> Sub.none
        , onUrlRequest = LinkClicked
        , onUrlChange = UrlChanged
        }

A back or forward of the browser (UrlChanged) has its entry already, so it is only corrected when the guard redirected it. Every other step pushes a new destination, with one exception: when the guard would now redirect the destination you left, its entry is replaced. After a login the login page would only redirect home, so back goes to the page before the login. The same after logging out on /new.

Apart from telling a back / forward from the rest, the wrapper decides from the state (the destination before and after the step), not from which branch of update moved the app. So it cannot be forgotten.

The echo is still there in Elm (Nav.pushUrl and Nav.replaceUrl send UrlChanged), but now it is harmless: it is the destination shown, so navigate drops it and the wrapper writes nothing. No isInternal flag is needed.

4. Boot

At boot the URL is read once. The page is opened through the guard right away, and the URL is corrected with a replace only when the guard redirected it:

init : Maybe String -> Url -> Nav.Key -> ( Model, Cmd Msg )
init user url key =
    let
        urlDestination =
            Route.fromUrl url

        bootModel =
            { key = key
            , user = user
            , posts = BlogPost.all
            , page = NotFound
            }

        model =
            openPage (guard bootModel urlDestination) bootModel
    in
    ( model, bootUrlCmd urlDestination model )

bootUrlCmd compares urlDestination with destinationOf model and calls Route.replaceUrl when they differ.

What changed

In src, only Main.elm changed from elm-blog. You can check with:

git diff --no-index elm-blog/src elm-blog-url-wrapper/src

update never writes the URL: each branch only changes the model.
The guard runs on every move, before the page opens: at boot, on back / forward, and inside the app.
A guest clicking "Write" is two messages (LinkClicked, and the echo of /login, which is dropped) and one URL write. /new is never written.
Logging out from a page the guard still allows (/about) now pushes /, so back returns to that page. In elm-blog it replaced the entry.
The model and the URL agree after every step. The not found page is the exception: it writes no URL, which is fine because no link of the app leads to it.

Opaque types: make impossible updates impossible

This part works with either way of navigating, so I added it to all three apps.

There is one hole left in both. Nothing stops a branch of update from writing the page directly:

{ model | page = NewPost NewPost.init }

That compiles, and the guard is skipped for that step. In elm-blog a guest now sees the new post page. In the wrapper apps the URL follows to /new, and only the echo of it happens to go back through the guard: that is luck, not design. The guard runs only if every move remembers to call it.

So I gave the guard and the page their own modules, with opaque types: the module exposes the type but not its constructor, so only that module can build a value with it.

module Guard exposing (Guarded, guard, route)


type Guarded
    = Guarded (Maybe Route)


guard : Maybe String -> Maybe Route -> Guarded
-- ...

module CurrentPage exposing (CurrentPage, Page(..), open, page, setLogin, setNewPost)


type CurrentPage
    = CurrentPage Page


open : Guarded -> CurrentPage

The model now holds a CurrentPage, and the only way to make one is open, which takes a Guarded, which only guard makes. The forms of the login and new post pages still change in place, but only through setLogin and setNewPost, which keep the page shown.

In elm-blog, changeRouteTo opens the page through them:

changeRouteTo : Maybe Route -> Model -> ( Model, Cmd Msg )
changeRouteTo maybeRoute model =
    let
        guarded =
            Guard.guard model.user maybeRoute
    in
    case Guard.route guarded of
        Just route ->
            if Just route /= maybeRoute then
                ( model, Route.replaceUrl model.key route )

            else
                ( { model | page = CurrentPage.open guarded }, Cmd.none )

        Nothing ->
            ( { model | page = CurrentPage.open guarded }, Cmd.none )

The wrapper apps use the same two modules, and their navigate becomes:

navigate : Maybe Route -> Model -> Model
navigate maybeRoute model =
    let
        destination =
            Guard.guard model.user maybeRoute
    in
    if Guard.route destination == destinationOf model then
        model

    else
        { model | page = CurrentPage.open destination }

And the write from above no longer compiles:

-- TYPE MISMATCH ----------------------------------------- WritePageDirectly.elm

I cannot update the `page` field like this:

13|     { model | page = NewPost NewPost.init }
                         ^^^^^^^^^^^^^^^^^^^^
This `NewPost` call produces:

    Page

But it should be:

    CurrentPage

The same for CurrentPage.open (Just Route.NewPost) (a route is not a Guarded) and for Guard.Guarded (Just Route.NewPost) (the constructor is not exposed). In each app, npm run check:opaque compiles these cases from compile-fail/ and checks that each one fails.

This is "make impossible states impossible", but for updates: the compiler stops a write that skips the owner of the value. Elm needs no tricks for it. There are no casts, and a record update needs a value of the type of the field, which only the owner module can make.

One honest limit: any module can still import Guard.guard and CurrentPage.open, because they are exposed, and guard trusts the user it is given. The types make sure every page went through them, but who calls them, and with what, is still decided by how the modules are laid out.

Conclusion

That is it. The URL becomes a thin adapter at the edges: written from the model after every step, and parsed into a move only when the browser hands one to us.

If the naming makes it harder to follow, it is because Route and Page are names from the URL-first way. In elm-blog-url-wrapper-screen-naming I changed the names only: Page is Screen (what the app shows) and Route is Destination (where the app is):

type Screen
    = NotFound
    | Home
    | Post String
    | About
    | Login Login.Model
    | NewPost NewPost.Model

destinationOf : Model -> Maybe Destination
destinationOf model =
    case CurrentScreen.screen model.screen of
        NotFound ->
            Nothing

        Home ->
            Just Destination.Home

        -- ...

With these names the model holds the current screen, and the destination is read from it.

I hope to hear from others if they reach the same conclusion. Feel free to ask me anything as well.

Thanks for reading!

How to use fp-ts-routing to parse url and format it back

Moremi Vannak — Sun, 08 Mar 2026 09:32:17 +0000

fp-ts-routing kinda lacks comprehensive documentation, so I am writing this blog post to address that gap.

If anyone doesn't know what it is, you can check the library here (it's pretty powerful library even though it's a bit old):

My goal is to achieve the following:

Map a URL string (including query parameters) to app route type.
Map app route type back to a URL string.

I will define these two functions as:

parseAppRoute
toUrlString

Note

I have to use my patch here https://github.com/rinn7e/fp-ts-routing which replaces .then with .and. The main reason is that .then seems
to be a reserved method in vitest and will cause the test to hangs forever.

If you don't use vitest, using .then should be fine.

Requirement

This tutorial aims for those who are already familiar with TypeScript and basic functional programming concepts (Option, Matcher).

Libraries needed:

fp-ts: npm install fp-ts
fp-ts-routing: npm install github:rinn7e/fp-ts-routing
io-ts: npm install io-ts (for query parameter validation)
vitest: npm install vitest --save-dev (for testing)

You can see the sample code and test here: https://github.com/rinn7e/my-blog/tree/master/6-how-to-use-fp-ts-routing

Defining Types

First, we need to define our page types and the overall app route structure. We will use a discriminated union for different pages.

import * as O from 'fp-ts/lib/Option'
import { Option } from 'fp-ts/lib/Option'

export type RoomId = string
export type ChatId = string
export type RoomCategory = 'active' | 'archived' | 'deleted'

export type RoomPage = {
  readonly _tag: 'RoomPage'
  roomId: Option<RoomId>
  chatId: Option<ChatId>
  category: RoomCategory
}

export type SearchPage = {
  readonly _tag: 'SearchPage'
  roomId: Option<RoomId>
  searchText: string
}

export type NotFoundPage = {
  readonly _tag: 'NotFoundPage'
  path: string[]
}

export type AppPage = RoomPage | SearchPage | NotFoundPage

export type AppRoute = {
  page: AppPage
  sidebarOpen: boolean
}

export const defaultAppRoute: AppRoute = {
  page: { _tag: 'RoomPage', roomId: O.none, chatId: O.none, category: 'active' },
  sidebarOpen: false
}

Defining Matches

We use fp-ts-routing matches to define the URL structure.

import { lit, str, query, end, Match, Parser, Formatter, Route } from 'fp-ts-routing'
import * as t from 'io-ts'

// Match any number of string segments in the path.
// Used for the "not found" route to capture the invalid path.
const anyStrings = new Match<{ path: string[] }>(
  new Parser((r) => O.some([{ path: r.parts }, new Route([], r.query)])),
  new Formatter((r, a) => new Route(r.parts.concat(a.path), r.query)),
)

// Query parameters validation
// ?sidebar=<some-value->
const sharedParams = t.exact(t.partial({
  sidebar: t.string
}))

// ?category=<some-value->
const roomQuery = t.exact(t.partial({
  category: t.string
}))

// basic matches
// /
const roomBlankMatch = query(t.intersection([roomQuery, sharedParams])).and(end)

// /rooms/:roomId
const roomOneMatch = lit('rooms')
  .and(str('roomId'))
  .and(query(t.intersection([roomQuery, sharedParams])))
  .and(end)

// /rooms/:roomId/chats/:chatId
const roomChatMatch = lit('rooms')
  .and(str('roomId'))
  .and(lit('chats'))
  .and(str('chatId'))
  .and(query(t.intersection([roomQuery, sharedParams])))
  .and(end)

// /search?q=...&room_id=...
// ?q=<some-value->&room_id=<some-value->
const searchParams = t.partial({
  q: t.string,
  room_id: t.string
})

const searchMatch = lit('search')
  .and(query(t.intersection([searchParams, sharedParams])))
  .and(end)

// otherwise
const notFoundMatch = anyStrings.and(query(sharedParams)).and(end)

Creating the Parser

Now we combine these matches into a single router using .alt.

import { zero, parse, format } from 'fp-ts-routing'

const toRoute = (page: AppPage) => (p: any): AppRoute => ({
  page,
  sidebarOpen: p.sidebar === 'true'
})

const appRouter: Parser<AppRoute> = zero<AppRoute>()
  .alt(roomBlankMatch.parser.map(toRoute({ _tag: 'RoomPage', roomId: O.none, chatId: O.none, category: 'active' })))
  .alt(roomOneMatch.parser.map((p) => toRoute({
      _tag: 'RoomPage',
      roomId: O.some(p.roomId),
      chatId: O.none,
      category: (p.category as RoomCategory) || 'active'
    })(p)
  ))
  .alt(roomChatMatch.parser.map((p) => toRoute({
      _tag: 'RoomPage',
      roomId: O.some(p.roomId),
      chatId: O.some(p.chatId),
      category: (p.category as RoomCategory) || 'active'
    })(p)
  ))
  .alt(searchMatch.parser.map((p) => toRoute({
      _tag: 'SearchPage',
      roomId: p.room_id ? O.some(p.room_id) : O.none,
      searchText: p.q || ''
    })(p)
  ))
  .alt(notFoundMatch.parser.map((p) => toRoute({ _tag: 'NotFoundPage', path: p.path })(p)))

The 2 Core Functions

Finally, we implement parseAppRoute and toUrlString.

1. parseAppRoute

This function takes the current URL href and converts it into our AppRoute type.

export const parseAppRoute = (href: string): AppRoute => {
  return parse(appRouter, Route.parse(href), defaultAppRoute)
}

2. toUrlString

This function takes an AppRoute and generates the corresponding URL string.

export const toUrlString = (route: AppRoute): string => {
  const params = { sidebar: route.sidebarOpen ? 'true' : undefined }

  switch (route.page._tag) {
    case 'RoomPage': {
      const roomParams = { ...params, category: route.page.category }
      if (O.isSome(route.page.roomId)) {
          if (O.isSome(route.page.chatId)) {
            return format(roomChatMatch.formatter, {
                ...roomParams,
                roomId: route.page.roomId.value,
                chatId: route.page.chatId.value
            })
          }
          return format(roomOneMatch.formatter, {
              ...roomParams,
              roomId: route.page.roomId.value
          })
      }
      return format(roomBlankMatch.formatter, roomParams)
    }
    case 'SearchPage': {
      return format(searchMatch.formatter, {
          ...params,
          q: route.page.searchText,
          room_id: O.toUndefined(route.page.roomId)
      })
    }
    case 'NotFoundPage': {
      return format(notFoundMatch.formatter, { ...params, path: route.page.path })
    }
    default:
      return '/'
  }
}

Testing with Vitest

Testing is a crucial part of ensuring your routing logic works as expected. We use Vitest for running our tests.

import { describe, it, expect } from 'vitest'
import { parseAppRoute, toUrlString, type AppRoute, type RoomPage, type SearchPage, type NotFoundPage } from '../src/route.js'
import * as O from 'fp-ts/lib/Option.js'

describe('Route parsing and generation', () => {
  it('should parse SearchPage correctly', () => {
    const route = parseAppRoute('/search?q=hello&room_id=room-123')
    expect(route.page._tag).toBe('SearchPage')
    const searchPage = route.page as SearchPage
    expect(searchPage.searchText).toBe('hello')
    expect(O.isSome(searchPage.roomId)).toBe(true)
  })

  it('should handle unknown paths with NotFoundPage', () => {
    const route = parseAppRoute('/unknown/path/here')
    expect(route.page._tag).toBe('NotFoundPage')
  })
})

Conclusion

That's it for this tutorial. If you have any questions, feel free to comment below.

Thanks for reading

Solving Elm Router "Double Update" Problem

Moremi Vannak — Tue, 16 Sep 2025 13:20:10 +0000

I found some older discussions on this issue, but they did not really provide a clear answer:

It turns out I discovered a simple solution, so I am writing it down in case I forget, or in case someone else finds it useful.

Imagine we have an expensive parseAppRoute function that performs many effects. We do not want it to run twice: once for Navigate and again for UrlChanged. (I am ignoring LinkClicked in this explanation, since in my app I only use Navigate, but the principle is the same.)

The idea is to keep track of a boolean flag called isInternal that indicates whether the URL change originated from inside the app or from an external action such as the browser's back/forward buttons. By default this flag is False, because back/forward navigation can happen at any time.

Whenever I change the route from inside the app, I set isInternal to True. Then, when the follow-up UrlChanged message arrives, I check the flag:

If it is True, I ignore the message and reset the flag to False.
If it is False, I know the change came from the browser (back/forward), so I call parseAppRoute.

This way we avoid calling handling the route change twice.

On initial page load, the route is handled in init, so there is no issue there either.

Here is an example implementation:

parseAppRoute : String -> (Route, Cmd Msg) 
parseAppRoute url =
   let
      newRoute = urlStringToRoute url
   in
      (newRoute, getCmdFrom newRoute)

cmdFromRoute : Route -> Cmd Msg
cmdFromRoute route =
    -- perform expensive side effects


init : Flags -> Url -> Nav.Key -> ( Model, Cmd Msg )
init _ url key =
    let
        (initRoute, initCmd) = parseAppRoute url
    in
    ( { route = initRoute
      , isInternal = False
      , key = key
      }
    , initCmd
    )


-- UPDATE

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        UrlChanged url ->
            if model.isInternal then
                -- Ignore the UrlChanged that we triggered ourselves;
                -- then reset the flag.
                ( { model | isInternal = False }, Cmd.none )

            else
                -- Triggered by browser back/forward navigation
                let
                    (newRoute, newCmd) = parseAppRoute url
                in
                ( { model | route = newRoute }, newCmd )

        Navigate route ->
            let
                href = toUrlString route
                newRouteCmd = cmdFromRoute route
            in
            ( { model
                | isInternal = True -- Mark this as an internal change
                , route = route
              }
            , Cmd.batch [ Nav.pushUrl model.key href, newRouteCmd ]
            )

        LinkClicked req ->
            case req of
                Browser.Internal url ->
                    -- Treat internal clicks like Navigate
                    let
                        (newRoute, newCmd) =
                            parseAppRoute url
                    in
                    ( { model | isInternal = True, route = newRoute }
                    , Cmd.batch
                        [ Nav.pushUrl model.key (Url.toString url)
                        , newCmd
                        ]
                    )

                Browser.External href ->
                    ( model, Nav.load href )

        None ->
            ( model, Cmd.none )

I hope to hear from others if they reach the same conclusion. Feel free to ask me anything as well.

Global Message passing inside Purescript Halogen

Moremi Vannak — Fri, 03 May 2019 02:47:02 +0000

Normally in Router Component of Halogen, you would have a Query to change route like this:

-- Router.purs
Goto page n -> do
    S.log $ show page
    handlePage page
    pure n
HandleHeroListPage msg n -> do
    case msg of
        HeroList.ChangeRoute page -> do
            handlePage page
            pure n
        _ ->
            pure n

The handlePage function would look something like this:

-- Router.purs
handlePage :: Page -> _
handlePage page = do
    currentPage <- H.gets (\s -> s.currentPage)
    case (currentPage == page) of
    true ->
        pure unit
    false -> do
        H.modify_ (_ { currentPage = page })
        pure unit

The problem with this is that to change route we will have to call HE.onClick $ HE.input_ HeroListPage when using in Router Component or when using in child component we would pass a message back to the parent component H.raise $ ChangeRoute HeroListPage and then we handle it like in HandleHeroListPage above.

When changing route by the deep nested component, we would have to pass some kind of messages back to the top component(Router Component) to handle and this could be very annoying.

A faster way is to simply change route with href="/#/home" but using the hash style url is problemtic for search engine as well as google analytic.

Using href without hash href="/home" will reload the page and we do not want this. So that is why we have to change url by changing url manually using pushState.

Global Passing Message can be really handy in this situation, we can pass message directly to Router Component from any child component by using Avar within a AppM ReaderT Pattern.

Our AppM will look like this:

-- AppM.purs
newtype AppM a = AppM (ReaderT Env Aff a)

runAppM :: forall a. Env -> AppM a -> Aff a
runAppM e (AppM m) = runReaderT m e


-- Data.Env.purs
data GlobalMessage 
    = LogoutG 
    | NavigateG Page

type Env = 
    { globalMessage :: AVar GlobalMessage
    , pushStateInterface :: PushStateInterface
    }

-- Main.purs
main :: Effect Unit
main = do
    log "Purescript is starting..."
    HA.runHalogenAff do
        globalMessage <- AVar.empty
        pushStateInterface <- liftEffect $ RoutingP.makeInterface
        let 
            environment :: Env
            environment = { pushStateInterface, globalMessage}

            rootComponent :: H.Component HH.HTML Router.Query Router.Input Void Aff
            rootComponent = H.hoist (runAppM environment) Router.component
-- ...

Inside our Router, we will fork a Query that listen to AVar changes

Init n -> do
    S.log "Router Initialized"
    void $ H.fork $ eval $ ListenForGlobalMessage n
    pure n
ListenForGlobalMessage n -> do
    globalMessage <- asks _.globalMessage
    query <- H.liftAff $ AVar.take globalMessage
    case query of
    NavigateG page -> do
        handlePage page
        pure unit
    _-> do
        pure unit
    eval (ListenForGlobalMessage n)

From within any child component, we call raiseG which basically put a new global message inside avar

raiseG query = do
  globalMessage <- asks _.globalMessage
  H.liftAff $ AVar.put query globalMessage

Example inside a child component call HeroList, we just call raiseG with the message we want to pass to Router Component directly

GotoHeroDetail n -> do
    S.raiseG $ NavigateG $ HeroDetailPage 1
    pure n

That's it, you can talk a look at fully working example inside my haloge starter project: https://github.com/rinn7e/rinn7e-halogen-starter

Thanks for reading!

Difference between monad-transfomer, mtl, and mtl-style technique

Moremi Vannak — Wed, 06 Mar 2019 11:11:02 +0000

This post is mean to explain the differences between the 3. These 3 terms come up regularly and it is important to differentiate them.

Requirement

This post aims for the pre-intermediate haskell programmers that have already learn the fundamental concept (monad, functor ...) and have written some haskell program already.

Monad Transformer

monad-transformer is a type container such as ReaderT, WriterT ... We will focus on the use-case only.

When people refer to monad-transformer they usually mean something their monad-transformer stack: newtype AppM a = ReaderT Env (LoggingT IO) a

The reason why haskell application use this stack over just IO () because monad-transformer provide extra functionality for example ReaderT provide ask function to get env variable instead of passing it in all the functions.

MTL - Monad Transformer Library

mtl library define various typeclasses that help working with monad-transformer. Remember that mtl is a library not a monad-transformer.

The reason why mtl is created because when we define a function to work with monad-transformer stack, we do not want to use AppM in the function type.

For example:

instead of this askEnvAndReadFile :: FilePath -> AppM String
we want to use this askEnvAndReadFile :: (MonadReader Env m, MonadIO m) -> FilePath -> m String

MonadReader and MonadIO are typeclasses that show that the function can ask for Env and can do IO action. This function can be use within any monad-trasnformer stack that has ReaderT and IO in them, not just our predefined AppM.

MTL-style (tagless final)

Sometimes when mtl is being discussed, it is not about the mtl library itself but the techniques that mtl library uses which is the Tagless Final. I will not provide detail explanation of this, but basically this is a technique that help haskell programmer write function with business model constraint.

For example, we want to define a function that can manage certain resources (make api call to get the resources). We do not want the function to be able to do any IO action.
Below show a function that can only make http call and log, not any other action

app :: (ManageResource m, HasLogging m) -> m ()
app = do
    result <- makeApiCall
    log (show result)
    pure ()

Notice that ManageResource and HasLogging is a typeclass that has nothing to do with mtl library, but instead we define this by ourself:

class (Monad m) => ManageResource m where
  makeApiCall :: m Resource

This is just an interface only, the implementation makeApiCallIO will have MonadIO constraint or return IO monad: makeApiCallIO :: IO Resource).
So when we want to use this function with our stack AppM we can define an instance for this ManageResource typeclass.

instance ManageResource AppM where
  makeApiCall = makeApiCallIO

The useful thing of using typeclass constraints instead of concrete type such as AppM is that we can use a mock stack MockM where we do not actually do any IO action.

Example:

makeApiCallMock :: m Resource
makeApiCallMock = pure someMockData

instance ManageResource MockM where
  makeApiCall = makeApiCallMock

Conclusion

As we can see, the 3 terms are different. The most important thing is the mtl-style technique that is used a lot in realworld haskell application (HasDatabase, HasLogging ...). It is important to be able to read other people constraint typeclasses as well as create our own. I was confused to this 3 terms as well before, hope this clears up some misunderstanding.

Detail Source:

Format Date with Purescript

Moremi Vannak — Sat, 13 Oct 2018 07:11:39 +0000

This will be a simple tutorial on how to parse date with purescript using purescript-formatters. I will use date from postgres: 2018-09-30T12:27:33.168791 as the example

We will need two functions one that will convert string to datetime and another will display that datetime value.

parseDate :: String -> Either DateTime
displayDate :: DateTime -> String

We will need 2 formatters for both decode and display:

parseFormatter :: Formatter
parseFormatter =  unsafePartial fromRight $  parseFormatString "YYYY-MM-DDTHH:mm:ss"

displayFormatter :: Formatter
displayFormatter =  unsafePartial fromRight $  parseFormatString "hh:mm:ss, DD MMM YYYY"

Then we can use this formatter in our previous functions

parseDate :: String -> Either String DateTime
parseDate s = 
    unformat parseFormatter s

displayDate :: DateTime -> String
displayDate d = 
    format displayFormatter d

We can combine them together

parseAndDisplay :: String -> String
parseAndDisplay s = 
    either (\err -> err) (\d -> displayDate d) $ parseDate s

If you run this, you may have noticed a run time error. Because our seconds is in fraction. We do not need that so we can just drop them off.

parseAndDisplay :: String -> String
parseAndDisplay s = 
    either (\err -> err) (\d -> displayDate d) $ parseDate $ String.take 19 s

If you run this with input 2018-09-30T12:27:33.168791, you will get 12:27:33, 30 Sep 2018

There you go here is the full code

import Prelude 

import Data.Either (Either, either, fromRight)
import Data.String as String
import Data.DateTime (DateTime)

import Data.Formatter.DateTime (Formatter, parseFormatString, unformat, format)
import Partial.Unsafe (unsafePartial)

parseFormatter :: Formatter
parseFormatter =  unsafePartial fromRight $ parseFormatString "YYYY-MM-DDTHH:mm:ss"

displayFormatter :: Formatter
displayFormatter =  unsafePartial fromRight $ parseFormatString "hh:mm:ss, DD MMM YYYY"

parseDate :: String -> Either String DateTime
parseDate s = 
    unformat parseFormatter s

displayDate :: DateTime -> String
displayDate d = 
    format displayFormatter d

parseAndDisplay :: String -> String
parseAndDisplay s = 
    either (\err -> err) (\d -> displayDate d) $ parseDate $ String.take 19 s

Display and Edit Google Map in Elm

Moremi Vannak — Sun, 05 Nov 2017 06:35:52 +0000

Using google map in elm is a bit tricky. This tutorial will show how to initialize the map, edit the map, and get the map data through port.

Preview: https://chmar77.github.io/elm-google-map-tutorial/

Requirement

This tutorial aims for those who already familiar with elm.

The tool that is needed:

elm: npm install -g elm
elm-live: npm install -g elm-live

Setting up project

Create following folder structure

elm-google-map
â”œâ”€â”€ src
â”‚   â”œâ”€â”€ Main.elm
â”‚   â”œâ”€â”€ Map.elm
â”‚   â””â”€â”€ Port.elm
â””â”€â”€ index.html

In index.html, copy the following code

<!DOCTYPE html>
<html>
  <head>
    <meta name="viewport" content="width=device-width, initial-scale=1">
    <title>Elm Google Map</title>
    <style>
    html, body{
        margin:0;
        padding:0;
    }
    #map {
        height:300px;
        width:300px;
    }
    #edit-map {
        height:300px;
        width:300px;
    }
    .hidden{
        visibility: hidden;
        height:0;
        width:0;
    }
    </style>
  </head>

  <body>
    <script src="dist/elm.js"></script>
    <script>
    var app = Elm.Main.fullscreen();

    </script>
  </body>
</html>

Run: elm-package install
Copy the following code in Main.elm

module Main exposing (..)

import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)


main : Program Never Model Msg
main =
    Html.program
        { init = init
        , update = update
        , view = view
        , subscriptions = subscriptions
        }


type alias Model =
    { title : String
    }


init : ( Model, Cmd Msg )
init =
    ( { title = "Elm Google Map" }, Cmd.none )


type Msg
    = NoOp


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


view : Model -> Html Msg
view model =
    div []
        [ h1 [] [ text "Elm Google Map" ]
        ]


subscriptions : Model -> Sub Msg
subscriptions model =
    Sub.none

In elm-package.json, change the source-directories from "." to "src"

 "source-directories": [
        "src"
 ],

Run elm-live src/Main.elm --output=dist/elm.js in the root folder of our project and go to http://localhost:8000/ to see our initialized project
If you see 'Elm Google Map' then it means everything is working fine

Creating Map Module

Copy the following code:

module Map exposing (Model, JsObject, init, modify, toJsObject)


type Model
    = Internal
        { latitude : Float
        , longtitude : Float
        }


init : Model
init =
    Internal
        { latitude = 11.55408504200135
        , longtitude = 104.910961602369
        }


modify : Float -> Float -> Model -> Model
modify latitude longtitude (Internal model) =
    Internal
        { model
            | latitude = latitude
            , longtitude = longtitude
        }


type alias JsObject =
    { lat : Float
    , lng : Float
    }


toJsObject : Model -> JsObject
toJsObject (Internal model) =
    { lat = model.latitude
    , lng = model.longtitude
    }

Here we are trying to make our module hidden. Record that uses the Model type, when accessing or modifying will need the function from the module. It cannot access the record directly.

Port Module

port module Port exposing (..)

import Map


-- Outgoing Port


port initializeMap : Map.JsObject -> Cmd msg


port initializeEditMap : Map.JsObject -> Cmd msg


port moveMap : Map.JsObject -> Cmd msg



-- Incoming Port


port mapMoved : (Map.JsObject -> msg) -> Sub msg

Here we divides out port into 2 parts, incoming and outgoing.

Javascript part

add google map script below elm.js script

<script src="https://maps.googleapis.com/maps/api/js?key={{your-api-key}}"></script>

pass the following code below var app = Elm.Main.fullscreen(); in index.html

app.ports.initializeMap.subscribe(function (pos) {
    console.log("Initialize Map")
    var mapDiv = document.getElementById('map');
    console.log(pos);
    if (mapDiv) {
    // Map
    var myLatlng = new google.maps.LatLng(pos);
    var mapOptions = {
        zoom: 15,
        center: myLatlng
    };
    var gmap = new google.maps.Map(mapDiv, mapOptions);

    // Marker
    var marker = new google.maps.Marker({
        position: myLatlng,
        title: "Hello World!"
    });
    marker.setMap(gmap);

    // Listening for map move event
    app.ports.moveMap.subscribe(function (pos) {
        console.log("received", pos);
        var myLatlng = new google.maps.LatLng(pos);
        gmap.setCenter(myLatlng);
        marker.setPosition(myLatlng)
    });


    } else {
    console.log ("Cant find map dom");
    }

});

Here we just create an event listening to initializeMap port from elm. The moveMap event will be used later on when we try to edit the map.

Back to Main Module

We can import out Map and Port Module

import Map
import Port

Update our Model, and init

type alias Model =
    { title : String
    , map : Map.Model
    }

init : ( Model, Cmd Msg )
init =
    ( { title = "Elm Google Map"
      , map = Map.init
      }
    , Map.init
        |> Map.toJsObject
        |> Port.initializeMap
    )

Finally update our view

view : Model -> Html Msg
view model =
    div []
        [ h1 [] [ text model.title ]
        , p [] [ text <| "Current pointer" ++ (toString <| Map.toJsObject model.map) ]
        , div []
            [ div [ id "map" ] []
            ]
        ]

If your are not running elm-live, run elm-live src/Main.elm --output=dist/elm.js again and go to http://localhost:8000/
If you are able to see the map, then everything is working as expected

Editing Map

First add additional javascript below the previous one in index.html

app.ports.initializeEditMap.subscribe(function (pos) {
    console.log("Initialize Edit Map")
    var mapDiv = document.getElementById('edit-map');
    console.log(pos);

    if (mapDiv) {
        // Map
        var myLatlng = new google.maps.LatLng(pos);
        var mapOptions = {
            zoom: 15,
            center: myLatlng
        };
        var gmap = new google.maps.Map(mapDiv, mapOptions);

        // Marker
        var marker = new google.maps.Marker({
            position: myLatlng,
            title: "Hello World!"
        });
        marker.setMap(gmap);

        gmap.addListener('drag', function () {
            var newPos = {
            lat: gmap.getCenter().lat(),
            lng: gmap.getCenter().lng()
            };

            marker.setPosition(newPos);

            app.ports.mapMoved.send(newPos);
        });

    } else {
        console.log ("Cant find edit map dom");
    }

});

Back in Main.elm, add State type to our Model so that we can edit the map

type alias Model =
    { title : String
    , map : Map.Model
    , state : State
    }

type State
    = View
    | Edit

init : ( Model, Cmd Msg )
init =
    ( { title = "Elm Google Map"
      , map = Map.init
      , state = View
      }
    , Map.init
        |> Map.toJsObject
        |> Port.initializeMap
    )

Then add edit button and editView in the view function

view : Model -> Html Msg
view model =
    div []
        [ h1 [] [ text model.title ]
        , p [] [ text <| "Current pointer" ++ (toString <| Map.toJsObject model.map) ]
        , div []
            [ div [ id "map" ] []
            , button [ onClick EditMap ] [ text "Edit" ]
            ]
        , editView model
        ]

Copy the following code for the editView

editView : Model -> Html Msg
editView model =
    div
        [ class <|
            case model.state of
                View ->
                    "hidden"

                Edit ->
                    ""
        ]
        [ hr [] []
        , div [ id "edit-map" ] []
        , button [ onClick SaveEditMap ] [ text "Done" ]
        ]

We also want to listen to the drag event when editing. We can do that by modifying our subscription

subscriptions : Model -> Sub Msg
subscriptions model =
    Port.mapMoved OnEditMapDrag

As you can see about, we create a few new msg and we will have to create and handle them

type Msg
    = NoOp
    | EditMap
    | OnEditMapDrag Map.JsObject
    | SaveEditMap

In our update function

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

        EditMap ->
            ( { model | state = Edit }
            , model.map
                |> Map.toJsObject
                |> Port.initializeEditMap
            )

        OnEditMapDrag { lat, lng } ->
            ( { model | map = Map.modify lat lng model.map }
            , Cmd.none
            )

        SaveEditMap ->
            ( { model | state = View }
            , model.map
                |> Map.toJsObject
                |> Port.moveMap
            )

This is it

The source code is here: https://github.com/chmar77/elm-google-map-tutorial
Preview: https://chmar77.github.io/elm-google-map-tutorial/

That's the end of the tutorial. If something is not working for you, or needs explanation of certain things you do not understand, comment down below.

Thanks for reading !!!