unsafe innerHTML in Halogen

Main.purs

module Main where

import Prelude

import Effect (Effect)
import Effect.Aff (Aff)
import Data.Maybe (Maybe(..))
import Halogen as H
import Halogen.Aff as HA
import Halogen.HTML as HH
import Halogen.HTML.Properties as HP
import Halogen.HTML.Events as HE
import Halogen.VDom.Driver (runUI)
import Data.Foldable (traverse_)
import Web.DOM.Element (Element)
import Type.Proxy (Proxy(..))
import Unsafe.Coerce (unsafeCoerce)
import Record.Builder (Builder, insert)

-- Super unsafe way of making this run in TryPS
-- instead of FFIing this function properly.
-- Don't try this at home!
setInnerHTML :: String -> Element -> Effect Unit
setInnerHTML html container =
  let
    builder :: Builder (Record ()) (Record ( innerHTML :: String ))
    builder = insert (Proxy :: Proxy "innerHTML") html
    unsafeEffect = (unsafeCoerce builder) container
  in unit <$ pure unsafeEffect

main :: Effect Unit
main = HA.runHalogenAff do
  body <- HA.awaitBody
  runUI outer "<h1>hello <i>there</i></h1>" body

outer :: forall q. H.Component q String Void Aff
outer =
  H.mkComponent
    { initialState: identity
    , render
    , eval: H.mkEval $ H.defaultEval
      { handleAction = H.put
      , receive = Just
      , initialize = Nothing
      }
    }
  where

  render html = HH.div_
    [ HH.input [ HP.value html, HE.onValueInput identity ]
    , HH.slot (Proxy :: Proxy "") unit component html absurd
    ]

component :: forall q. H.Component q String Void Aff
component =
  H.mkComponent
    { initialState: identity
    , render
    , eval: H.mkEval $ H.defaultEval
      { handleAction = handleAction
      , receive = Just <<< Just
      , initialize = Just Nothing
      }
    }
  where

  render _ = HH.div [ HP.ref (H.RefLabel "container") ] []

  handleAction mhtml = do
    html <- case mhtml of
      Just html -> html <$ H.put html
      Nothing -> H.get
    H.getRef (H.RefLabel "container") >>= traverse_ \container -> do
      H.liftEffect $ setInnerHTML html container