[ Elm / Stylesheets / Interop ]: Use Elm & Javascript interop to allow for CSS modules in Elm files

HasStylesheet.elm

module HasStylesheet exposing (..)

import Html exposing (Html, div, text)
import Html.Attributes exposing (class)
import Stylesheets exposing (fetchClasses, getClass, onlyFor)

type Message
  = NoOp
  | ReceiveStyles Stylesheets.Message

type alias Model =
  { classes : Stylesheets.Model
  }


stylesheet : String
stylesheet = "./Example.module.css"


init : ( Model, Cmd Message )
init =
  Model Stylesheets.init ! [ fetchClasses stylesheet ]


view : Model -> Html Message
view model =
  div
    [ class (getClass "container" model.classes) ]
    [ text (toString model) ]


subscriptions : Model -> Sub Message
subscriptions model =
  Sub.batch
    [ Sub.map ReceiveStyles Stylesheets.subscriptions
    ]


update : Message -> Model -> ( Model, Cmd Message )
update message model =
  case message of
    NoOp ->
      model ! []

    ReceiveStyles stylesMessage ->
      let
        classes = onlyFor stylesheet stylesMessage model.classes

      in
        { model | classes = classes } ! []

index.js

import { Main } from './Main'

const getStylesheetsContext = () =>
  require.context('./', true, /\.css$/)

const stylesheets = getStylesheetsContext()
const app = Main.embed(document.getElementById('page'))
const receiveClasses = (file, styles) =>
  () =>
    app.ports.receiveClasses.send(
      { key: file, value: styles }
    )


if (module.hot) {
  module.hot.accept(stylesheets.id, () => {
    const reloadedStylesheets = getStylesheetsContext()

    reloadedStylesheets.keys().forEach(key => {
      const styles = reloadedStylesheets(key)

      setImmediate(receiveClasses(key, styles))
    })
  })
}

app.ports.fetchClasses.subscribe(file => {
  const styles = stylesheets(file)

  setImmediate(receiveClasses(file, styles))
})

Stylesheets.elm

port module Stylesheets exposing (..)

import Dict exposing (Dict, union, empty, get)
import Json.Decode exposing (dict, string, Decoder, Value, decodeValue)


type Message = ReceiveClass Key Model

type alias Classed = { classes : Model }
type alias Key = String
type alias Model = Dict String String
type alias Sheet =
  { key : Key
  , value : Value
  }


port fetchClasses : String -> Cmd message
port receiveClasses : (Sheet -> message) -> Sub message


subscriptions : Sub Message
subscriptions =
  let
    decode : Sheet -> Message
    decode { key, value } =
      ReceiveClass key (getDecodedResult value)

  in
    receiveClasses decode


decoder : Decoder Model
decoder = dict string


getDecodedResult : Value -> Model
getDecodedResult value =
  case decodeValue decoder value of
    Ok value ->
      value

    Err _ ->
      empty


onlyFor : Key -> Message -> Model -> Model
onlyFor key message model =
  let
    (classes, _) = update message model

  in
    case message of
      ReceiveClass givenKey _ ->
        if key == givenKey then
          classes
        else
          model


update : Message -> Model -> (Model, Cmd Message)
update message model =
  case message of
    ReceiveClass key dictionary ->
      let
        classes = union dictionary model

      in
        (classes, Cmd.none)


getClass : String -> Model -> String
getClass string model =
  case get string model of
    Just class ->
      class

    Nothing ->
      ""


init : Model
init = empty