Prototype for adding context to Elm views using the reader monad

ElmUiWithReader.elm

module Main exposing (main)

import Browser
import Element as Element
import Element.Background as Background
import Element.Events as Events
import Element.Font as Font
import Html exposing (Html, button, div, text)
import Html.Events exposing (onClick)
import Reader



-- Code example


type alias Model =
    { dark : Bool }


type alias Context =
    Model


initialModel : Model
initialModel =
    { dark = False }


type Msg
    = ToggleDark


update : Msg -> Model -> Model
update msg model =
    case msg of
        ToggleDark ->
            { model | dark = not model.dark }


view : Model -> Html Msg
view model =
    Reader.run (viewR model) model
        |> Element.layout []


viewR : Model -> ElementR Context Msg
viewR model =
    rowC
        (withC
            (\ctx ->
                [ Events.onClick ToggleDark
                , Element.spacing 10
                , Element.padding 10
                , Element.pointer
                ]
                    ++ (if ctx.dark then
                            [ Background.color <| Element.rgb 0 0 0
                            , Font.color <| Element.rgb 1 1 1
                            ]

                        else
                            [ Background.color <| Element.rgb 0.95 0.95 0.95
                            ]
                       )
            )
        )
        [ textC "Click me to toggle dark mode"
        , elC
            (withC
                (\ctx ->
                    [ Element.width (Element.px 6)
                    , Element.height (Element.px 6)
                    ]
                        ++ (if ctx.dark then
                                [ Background.color <| Element.rgb 1 1 1
                                ]

                            else
                                [ Background.color <| Element.rgb 0 0 0
                                ]
                           )
                )
            )
            noneC
        ]


main : Program () Model Msg
main =
    Browser.sandbox
        { init = initialModel
        , view = view
        , update = update
        }



-- Wrapped `elm-ui`


type alias ElementR r msg =
    Reader.Reader r (Element.Element msg)


type alias AttributesR r msg =
    Reader.Reader r (List (Element.Attribute msg))


withC : (r -> a) -> Reader.Reader r a
withC =
    Reader.Reader



-- Replicate all `elm-ui` methods to include this type


elC : AttributesR r msg -> ElementR r msg -> ElementR r msg
elC attrsR_ childR =
    Reader.reader Element.el
        |> andMapReader attrsR_
        |> andMapReader childR


rowC : AttributesR r msg -> List (ElementR r msg) -> ElementR r msg
rowC attrsR_ childrenR =
    Reader.reader Element.row
        |> andMapReader attrsR_
        |> andMapReader (allReaders childrenR)


textC : String -> ElementR r msg
textC =
    Reader.reader << Element.text


noneC : ElementR r msg
noneC =
    Reader.reader Element.none



-- Reader utilities


andMapReader : Reader.Reader r a -> Reader.Reader r (a -> b) -> Reader.Reader r b
andMapReader aR fnR =
    Reader.Reader
        (\r ->
            let
                fn =
                    Reader.run fnR r

                a =
                    Reader.run aR r
            in
            fn a
        )


allReaders : List (Reader.Reader r a) -> Reader.Reader r (List a)
allReaders =
    List.foldr
        (\current accumulator ->
            Reader.reader (\current_ accumulator_ -> current_ :: accumulator_)
                |> andMapReader current
                |> andMapReader accumulator
        )
        (Reader.reader [])