Declarative focus management API

Focus.elm

{-| Focus management is not a trivial task, but luckly most of it's logic can be fully self
contained by principrals of Elm archituture.
-}

import Html exposing (Attribute, Html)
import Html.Attributes exposing (attribute)
import Html.Events
import Setting exposing (setting)

{-| Your focusable UI component will need to embed foucs state represented by this model.
`value` field tracks current state of the focus. `version` field is necessary to ensure
that multiple focus changes with in same render loop won't be ignored by VirtualDom. For
example it could be that focus will change from focused to blured and back to focused
between renders version will help VirtualDOM diff process to detect that there was a
change.
Note: Please do not concentrate on `version` field too much as alternativeof stategy can
be used to adress above issue.
-}
type alias Model =
  { value : Bool
  , version : Int
  }

{-| Creates initial focus state.
-}
init : Bool -> Model
init focused =
  { version = 0
  , value = focused
  }

type Msg
  = Focus
  | Blur

{-| UI components can just delegate all the focus management here.
-}
update : Msg -> Model -> Model
update msg model =
  -- We only increment version if there actually is a change, but this could be reconsidred
  -- if some issues will be pointed out with this strategy.
  case msg of
    Focus ->
      case model.value of
        True ->
          model
        False ->
          focus model
    Blur ->
      case model.value of
        False ->
          model
        True ->
          blur model

{-| UI components may want to request focus on some other events and this is a
function that can be used to do it. User may want to retain focus on blur
event & this fuction can be used to do that.
-}
focus : Model -> Model
focus model =
  { version = model.version + 1
  , value = True
  }

{-| UI components may want to request blur on some other events and this is a
function that can be used to do it. User may also want to retain blur on focus
event & this fuction can be used to do that.
-}
blur : Model -> Model
blur model =
  { version = model.version + 1
  , value = False
  }

{-| focused function can be used to construct an attribute that will reflec
focus state onto actual DOM on next render.
-}
focused : Model -> Attribute message
-- See focusSetter implementation in `Focus.js`.
-- focused model = attribute "focused" "focused"
focused model = setting model Native.focusSetter

{-| Helper function handling focus events.
-}
onFocus : ( Msg -> msg ) -> Attribute msg
onFocus toMsg = Html.Events.onFocus (toMsg Focus)

{-| Helper function for handling blur events
-}
onBlur : ( Msg -> msg ) -> Attribute msg
onBlur toMsg = Html.Events.onBlur (toMsg Blur)

focusable :
  ( List (Attribute msg) -> List (Html msg) -> Html msg ) -> 
  List (Attribute msg) ->
  List (Html msg) ->
  (Msg -> msg) ->
  Model ->
  Html msg
 
focusable node attributes children toMsg model =
  node 
   (List.append attributes [focused model, onFocus toMsg, onBlur toMsg])
   children

Focus.js

focusSetter = function(state, target) {
  var task = _elm_lang$core$Native_Scheduler.nativeBinding(function run(callback) {
    // We avoid defining what target is or how element can be gained from it, let's just say that it can be done in an
    // opaque way. For example `target` could be a query selector that can be used to access element or it could be boxed
    // element or something else poin is only native code will be able to obtian actual element from it.
    const element = deref(target)
    if (state.value) {
      element.focus();
      // If element did not get focused, it is because this is initial render and
      // in such task is run before element are in the document tree and there for
      // calls to`.focus()` has no effect. In such case we just reschedule the task
      if (element.ownerDocument.activeElement !== element) {
        _elm_lang$core$Native_Scheduler.spawn(task)
      }
    } else {
      element.blur()
    }
    callback(succeed(_elm_lang$core$Native_Utils.Tuple0))
  })
  return task

Setting.elm

-- Setter here is somewhat similar to hooks from VirtualDOM library in that
-- that they are passed value & corresponding `Target` and they return
-- task which presumably does something to an DOM element corresponding to
-- passed `Target`. Intentionally we do not define what `Target` let's just
-- say that it something that can be used by native code to reference a
-- DOM Element that it represents.
-- https://github.com/Matt-Esch/virtual-dom/blob/master/docs/hooks.md#hooks
-- Note: Task can not error neither return anything, it's similar to HTML
-- attributes, if it fails to reflect view onto DOM that is it's own problem
-- not a users.
type alias Setter value = value -> HTMLElement -> Task Never ()


-- Setting just takes setter and value it supposed produce HTML element
-- that contains it. It is expected to be pure, meaning that same
-- same setter and value return same setting, there for VirtualDOM will
-- only run settings that have changed - value or setter has changed.
setting : Setter value -> value -> Attribute msg
-- Implementation will be in native or Elm Html / DOM library will be extended
-- to support additional `Setting` type.

TextInput.elm

module TextInput exposing ( Model, Msg, init, update, focus, blur, view, main )

{-| Sample for proposed focus API. Renders a text input which delegates all the
focus management to a Focus module.
-}


import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Html.App as App
import Focus


-- MODEL


type alias Model = 
  { text : String
  , focus : Focus.Model
  }


type Msg
  = UpdateFocus Focus.Msg
  | UpdateText String


init : String -> Bool -> ( Model, Cmd a )
init text focused =
    ( { text = text
      , focus = Focus.init focused
      }
    , Cmd.none
    )


-- UPDATE


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
  case msg of
    UpdateFocus msg ->
      ( { model | focus = Focus.update msg model.focus }
      , Cmd.none
      )
    UpdateText text -> 
      ( { model | text = text }
      , Cmd.none
      )

focus : Model -> ( Model, Cmd Msg )
focus model =
  ( { model | focus = Focus.focus model.focus }
  , Cmd.none
  )

blur : Model -> ( Model, Cmd Msg )
  ( { model | focus = Focus.blur model.focus }
  , Cmd.none
  )

-- VIEW

view : Model -> Html Msg
view model =
  div 
    []
    [ button [ onClick RequestFocus ] [ text "Focus" ]
    , Focus.focusable
      ( input
      , [ type' "text"
        , value model.text
        , onInput UpdateText
        ]
      , []
      , FocusUpdate
      , model.focus
      )
    ]


-- APP


main : Program Never
main =
    App.program
        { init = init
        , update = update
        , view = view
        , subscriptions = always Sub.none
        }

TextInputPair.elm

module TextInputPair exposing ( Model, Msg, init, update, focus, blur, view, main )

{-| Sample for proposed focus API. Renders two inputs that deal with their own foucsing
concerns + two buttons to focus either top or bottom input.
-}


import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Html.App as App
import TextInput


-- MODEL


type alias Model = 
  { top : TextInput.Model
  , bottom : TextInput.Model
  }


type Msg
  = Top TextInput.Msg
  | Bottom TextInput.Msg
  | ActivateTop
  | ActivateBottom


init : String -> String -> ( Model, Cmd a )
init topText bottomTetx focused =
  let
    ( top, topCmd ) = TextInput.init topText False
    ( bottom, bottomCmd ) = TextInput.init bottomText False
  in
    ( { top = top
      , bottom = bottom
      }
    , Cmd.batch [ Cmd.map Top topCmd, Cmd.map Bottom bottomCmd ]
    )


-- UPDATE


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
  case msg of
    Top msg ->
      let
        ( top, cmd ) = TextInput.update msg model.top }
      in
        ( { model | top = top }
        , Cmd.map Top cmd
        )
    Bottom text ->
      let
        ( bottom, cmd ) = TextInput.update msg model.bottom }
      in
        ( { model | bottom = bottom }
        , Cmd.map Bottom cmd
        )
    ActivateTop ->
      let
        ( top, cmd ) = TextInput.focus model.top
      in
        ( { model | top = top }
        , Cmd.map Top cmd
        )
    ActivateBottom ->
      let
        ( bottom, cmd ) = TextInput.focus model.bottom
      in
        ( { model | bottom = bottom }
        , Cmd.map Bottom cmd
        )

-- VIEW

view : Model -> Html Msg
view model =
  div 
    []
    [ button [ onClick ActivateTop ] [ text "Activate top" ]
    , button [ onClick ActivateBottom ] [ text "Activate bottom" ]
    , App.map Top (TextInput.view model.top)
    , App.map Bottom (TextInput.view model.bottom)
    ]


-- APP


main : Program Never
main =
    App.program
        { init = init
        , update = update
        , view = view
        , subscriptions = always Sub.none
        }