Elm composition example

FilterBar.elm

module FilterBar exposing (..)

import Html exposing (..)
import Html.Attributes exposing (alt, class, href, id, src, style)
import Html.Attributes.Aria exposing (ariaHidden, role)
import Html.Events exposing (onClick)


---- PROGRAM ----


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



---- MODEL ----


type alias Year =
    String


type alias Model =
    { debug : Bool
    , selectedYear : Year
    , years : List Year
    , visibleYears : List Year
    }



---- UPDATE ----


noYear : Year
noYear =
    ""


init : ( Model, Cmd Msg )
init =
    { debug = True
    , selectedYear = "2017"
    , years = [ "2017", "2016", "2015", "2014", "2013", "2012", "2011", "2010", "2009" ]
    , visibleYears = [ "2016", "2015", "2014", "2013", "2012" ]
    }
        ! []


type Msg
    = SelectYear Year
    | ShiftLeft
    | ShiftRight
    | NoOp


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    let
        newModel =
            case msg of
                SelectYear year ->
                    { model | selectedYear = year } ! []

                ShiftLeft ->
                    let
                        newVisibleYears : List Year
                        newVisibleYears =
                            shiftYears ShiftLeft model.visibleYears model.years
                    in
                    { model | visibleYears = newVisibleYears } ! []

                ShiftRight ->
                    let
                        newVisibleYears : List Year
                        newVisibleYears =
                            shiftYears ShiftRight model.visibleYears model.years
                    in
                    { model | visibleYears = newVisibleYears } ! []

                _ ->
                    model ! []
    in
    if model.debug then
        Debug.log "Updated model" newModel
    else
        newModel



---- VIEW ----


view : Model -> Html Msg
view model =
    div []
        [ viewRightPane model
        ]


viewRightPane : Model -> Html Msg
viewRightPane model =
    div [ class "c-table-archive" ]
        [ div [ class "c-table-archive__tabs js-paginate-tabs" ] [ viewFilterBar model ]
        , div [ class "tabs-content" ]
            [ section [ role "tabpanel", ariaHidden False, class "content active" ]
                [ section []
                    []
                ]
            ]
        ]


viewFilterBar : Model -> Html Msg
viewFilterBar model =
    let
        build year =
            viewYear year model.selectedYear

        items =
            List.concat
                [ [ viewArrowPrevious model ]
                , List.map build model.visibleYears
                , [ viewArrowNext model ]
                ]
    in
    ul [ class "tabs", role "tablist" ] items


viewArrowPrevious : Model -> Html Msg
viewArrowPrevious { selectedYear, years, visibleYears } =
    let
        firstYear =
            Maybe.withDefault noYear (List.head years)

        firstVisibleYear =
            Maybe.withDefault noYear (List.head visibleYears)

        canClick =
            firstYear /= firstVisibleYear

        styles =
            if canClick then
                "c-table-archive__tabs-prev"
            else
                "c-table-archive__tabs-prev disabled"

        chevron =
            i [ class "fa fa-chevron-left" ] []
    in
    li [ class styles ]
        [ if canClick then
            span [ onClick ShiftLeft ] [ chevron ]
          else
            span [] [ chevron ]
        ]


viewArrowNext : Model -> Html Msg
viewArrowNext { selectedYear, years, visibleYears } =
    let
        lastYear =
            Maybe.withDefault noYear (years |> List.reverse |> List.head)

        lastVisibleYear =
            Maybe.withDefault noYear (visibleYears |> List.reverse |> List.head)

        canClick =
            lastYear /= lastVisibleYear

        styles =
            if canClick then
                "c-table-archive__tabs-next"
            else
                "c-table-archive__tabs-next disabled"

        chevron =
            i [ class "fa fa-chevron-right" ] []
    in
    li [ class styles ]
        [ if canClick then
            span [ onClick ShiftRight ] [ chevron ]
          else
            span [] [ chevron ]
        ]


viewYear : Year -> Year -> Html Msg
viewYear year selectedYear =
    let
        width90 =
            [ ( "width", "90px" ) ]

        styles =
            if year == selectedYear then
                "tab-title active"
            else
                "tab-title"
    in
    li [ class styles, role "presentation", onClick (SelectYear year) ]
        [ a [ role "tab", style width90 ]
            [ text year ]
        ]



--- HELPERS


shiftYears : Msg -> List Year -> List Year -> List Year
shiftYears msg years allYears =
    let
        yearsLength =
            List.length years

        allYearsIndexed =
            List.indexedMap (,) allYears

        firstVisibleYear =
            case msg of
                ShiftRight ->
                    Maybe.withDefault noYear (years |> List.drop 1 |> List.head)

                ShiftLeft ->
                    let
                        firstYear =
                            Maybe.withDefault noYear (List.head years)
                    in
                    allYears
                        |> List.filter (\year -> year > firstYear)
                        |> List.reverse
                        |> List.take 1
                        |> List.head
                        |> Maybe.withDefault noYear

                _ ->
                    noYear

        newYears =
            allYears
                |> List.filter (\year -> year <= firstVisibleYear)
                |> List.take yearsLength

        newYearsLength =
            List.length newYears
    in
    if newYearsLength < yearsLength then
        years
    else
        newYears

FilterBar.js

// alternative implementation in Ramda

import R from 'ramda'

export default function shiftYears ({msg, years, allYears}) {
  if (msg === 'ClickRight') {
    const fn = R.pipe(
      R.filter(n => n <= years[1]),
      R.take(years.length),
    )
    const newItems = fn(allYears)
    return newItems.length < years.length ? years : newItems
  }
  if (msg === 'ClickLeft') {
    const firstVisibleYear = R.pipe(
      R.filter(n => n > years[0]),
      R.reverse,
      R.take(1),
      R.head,
    )(allYears)
    const fn = R.pipe(
      R.filter(n => n <= firstVisibleYear),
      R.take(years.length),
    )
    const newYears = fn(allYears)
    return newYears.length < years.length ? years : newYears
  }
}

FilterBar.test.js

import shiftYears from './shiftYears'

const allYears = ['2017', '2016', '2015', '2014', '2013', '2012', '2011']

const toJSON = JSON.stringify

describe('shiftYears', () => {
  it('shift right', () => {
    const received = shiftYears({msg: 'ClickRight', years: ['2016', '2015', '2014', '2013'], allYears})
    const expected = ['2015', '2014', '2013', '2012']
    expect(toJSON(received)).toEqual(toJSON(expected))
  })

  it('ignore shift right if already shifted to the right side', () => {
    const received = shiftYears({msg: 'ClickRight', years: ['2014', '2013', '2012', '2011'], allYears})
    const expected = ['2014', '2013', '2012', '2011']
    expect(toJSON(received)).toEqual(toJSON(expected))
  })

  it('shift left', () => {
    const received = shiftYears({msg: 'ClickLeft', years: ['2015', '2014', '2013', '2012'], allYears})
    const expected = ['2016', '2015', '2014', '2013']
    expect(toJSON(received)).toEqual(toJSON(expected))
  })

  it('ignore shift left ignored if already shifted to the left side', () => {
    const received = shiftYears({msg: 'ClickLeft', years: ['2017', '2016', '2015', '2014'], allYears})
    const expected = ['2017', '2016', '2015', '2014']
    expect(toJSON(received)).toEqual(toJSON(expected))
  })

})

PressRoom.elm

module PressRoom exposing (..)

import FilterBar
import Html exposing (..)
import Html.Attributes exposing (class)
import Html.Attributes.Aria exposing (ariaHidden, role)


---- PROGRAM ----


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



---- MODEL ----


type alias Model =
    { debug : Bool
    , filterBar : FilterBar.Model
    }



---- UPDATE ----


init : ( Model, Cmd Msg )
init =
    { debug = True
    , filterBar = Tuple.first FilterBar.init
    }
        ! []


type Msg
    = NoOp
    | FilterBarMsg FilterBar.Msg


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    let
        newModel =
            model ! []
    in
    if model.debug then
        Debug.log "Updated model" newModel
    else
        newModel



---- VIEW ----


view : Model -> Html Msg
view model =
    div []
        [ viewRightPane model
        ]


viewRightPane : Model -> Html Msg
viewRightPane model =
    let
        viewFilterBar =
            Html.map FilterBarMsg (FilterBar.viewFilterBar model.filterBar)
    in
    div [ class "c-table-archive" ]
        [ div [ class "c-table-archive__tabs js-paginate-tabs" ] [ viewFilterBar ]
        , div [ class "tabs-content" ]
            [ section [ role "tabpanel", ariaHidden False, class "content active" ]
                [ section [] []
                ]
            ]
        ]

Testing.elm

module Tests exposing (..)

import Expect
import FilterBar exposing (Msg(ShiftLeft, ShiftRight), shiftYears)
import Test exposing (..)


shiftYearsTest : Test
shiftYearsTest =
    let
        allYears =
            [ "2017", "2016", "2015", "2014", "2013", "2012", "2011" ]
    in
    describe "visibleYears"
        [ test "shift right" <|
            \_ ->
                Expect.equal [ "2015", "2014", "2013", "2012" ] (shiftYears ShiftRight [ "2016", "2015", "2014", "2013" ] allYears)
        , test "ignore shift right if already shifted to the right side" <|
            \_ ->
                Expect.equal [ "2014", "2013", "2012", "2011" ] (shiftYears ShiftRight [ "2014", "2013", "2012", "2011" ] allYears)
        , test "shift left" <|
            \_ ->
                Expect.equal [ "2016", "2015", "2014", "2013" ] (shiftYears ShiftLeft [ "2015", "2014", "2013", "2012" ] allYears)
        , test "ignore shift left ignored if already shifted to the left side" <|
            \_ ->
                Expect.equal [ "2017", "2016", "2015", "2014" ] (shiftYears ShiftLeft [ "2017", "2016", "2015", "2014" ] allYears)
        ]