2019-01-31 02:54:47 +00:00
|
|
|
module Component.RawHtml where
|
|
|
|
|
|
|
|
import Prelude
|
|
|
|
|
|
|
|
import Data.Foldable (for_)
|
|
|
|
import Data.Maybe (Maybe(..))
|
|
|
|
import Effect (Effect)
|
2019-03-08 16:48:46 +00:00
|
|
|
import Effect.Aff (Aff, forkAff, makeAff)
|
|
|
|
import Effect.Class (liftEffect)
|
2019-01-31 02:54:47 +00:00
|
|
|
import Globals (RawHTML(..))
|
|
|
|
import Halogen as H
|
|
|
|
import Halogen.HTML as HH
|
|
|
|
import Halogen.HTML.Properties as HP
|
|
|
|
import Web.HTML (HTMLElement)
|
|
|
|
|
|
|
|
foreign import unsafeSetInnerHTML :: HTMLElement -> RawHTML -> Effect Unit
|
|
|
|
|
2019-03-01 04:45:34 +00:00
|
|
|
data Action i
|
|
|
|
= SetInnerHTML
|
|
|
|
| Receive (Input i)
|
2019-01-31 02:54:47 +00:00
|
|
|
|
|
|
|
type Input i = i
|
|
|
|
|
|
|
|
type State i =
|
|
|
|
{ elRef :: H.RefLabel
|
|
|
|
, inputval :: Input i
|
|
|
|
}
|
|
|
|
|
2021-06-10 17:47:44 +00:00
|
|
|
component :: forall q o. H.Component q (Input String) o Aff
|
2019-01-31 02:54:47 +00:00
|
|
|
component = mkComponent RawHTML
|
|
|
|
|
2021-06-10 17:47:44 +00:00
|
|
|
mkComponent :: forall q i o. (Input i -> RawHTML) -> H.Component q (Input i) o Aff
|
2019-03-01 04:45:34 +00:00
|
|
|
mkComponent toRawHTML =
|
|
|
|
H.mkComponent
|
|
|
|
{ initialState: \inputval -> { elRef: H.RefLabel "inputval", inputval }
|
|
|
|
, render
|
|
|
|
, eval: H.mkEval (H.defaultEval { handleAction = handleAction
|
|
|
|
, initialize = Just SetInnerHTML
|
|
|
|
, receive = Just <<< Receive
|
|
|
|
})
|
|
|
|
}
|
2019-01-31 02:54:47 +00:00
|
|
|
where
|
2019-03-01 04:45:34 +00:00
|
|
|
render :: forall m. (State i) -> H.ComponentHTML (Action i) () m
|
2019-01-31 02:54:47 +00:00
|
|
|
render state =
|
|
|
|
HH.div
|
|
|
|
[ HP.ref state.elRef ]
|
|
|
|
[]
|
|
|
|
|
2019-03-01 04:45:34 +00:00
|
|
|
handleAction :: (Action i) -> H.HalogenM (State i) (Action i) () o Aff Unit
|
|
|
|
handleAction = case _ of
|
|
|
|
SetInnerHTML -> do
|
2019-01-31 02:54:47 +00:00
|
|
|
{ elRef } <- H.get
|
|
|
|
mel <- H.getHTMLElementRef elRef
|
|
|
|
for_ mel \el -> do
|
|
|
|
{ inputval } <- H.get
|
2019-03-08 16:48:46 +00:00
|
|
|
H.liftAff $ forkAff $ makeAff \cb -> do
|
|
|
|
liftEffect $ unsafeSetInnerHTML el (toRawHTML inputval)
|
|
|
|
mempty
|
2019-03-01 04:45:34 +00:00
|
|
|
pure unit
|
2019-01-31 02:54:47 +00:00
|
|
|
|
2019-03-01 04:45:34 +00:00
|
|
|
Receive inputval -> do
|
2019-01-31 02:54:47 +00:00
|
|
|
H.modify_ _ { inputval = inputval }
|
2019-03-01 04:45:34 +00:00
|
|
|
handleAction $ SetInnerHTML
|