Terria

Scratch.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE FlexibleContexts #-}
module Scratch where

import Data.Monoid ((<>))

import Control.Monad.Trans (liftIO)

import Reflex.Dom.Core

import Data.Aeson

import GHCJS.Marshal

import GHCJS.DOM
import GHCJS.DOM.EventM
import GHCJS.DOM.Types hiding (Array)
import GHCJS.DOM.HTMLIFrameElement
import GHCJS.DOM.Window
import GHCJS.DOM.WindowEventHandlers
import GHCJS.DOM.MessageEvent

import Unsafe.Coerce

setupMessageEvents :: GHCJS.DOM.Types.Element -> JSM ()
setupMessageEvents el = do
  w <- currentWindowUnchecked
  _ <- on w message $ do
    iFrameWindow <- getContentWindow (uncheckedCastTo HTMLIFrameElement el)
    e <- event
    s <- getSource e
    d <- getData e
    if (s == Just (toEventTarget iFrameWindow) && (unsafeCoerce d :: JSString) == "ready")
    then do
      let
        initMessage =
          object [
            "initSources" .= Array [object [
               "initialCamera" .= object [
                 "north" .= Number (read "-33.827")
               , "east" .= Number (read "151.249")
               , "south" .= Number (read "-33.907")
               , "west" .= Number (read "151.165")
               ]
            ,  "catalog" .= Array [object [
                 "type" .= String "group"
               , "name" .= String "Foo"
               , "isPromoted" .= Bool True
               , "isOpen" .= Bool True
               , "items" .= Array [
                   object [
                     "type" .= String "csv"
                   , "name" .= String "My Data"
                   , "data" .= String "POA,Some Value\n2000,1\n2205,2"
                   , "isEnabled" .= Bool True
                   ]
                 ]
               ]]
            ]]
          ]
      postMessage iFrameWindow initMessage ("http://nationalmap.gov.au" :: JSString) ([] :: [AbstractWorker])
    else pure ()
  pure ()

nationalMap ::
  MonadWidget t m =>
  m ()
nationalMap = do
  let
    attrs =
      "id" =: "embeddedNationalMap" <>
      "src" =: "http://nationalmap.gov.au" <>
      "width" =: "1024" <>
      "height" =: "768"
  (e', _) <- elAttr' "iframe" attrs $ pure ()

  liftJSM $ setupMessageEvents (_element_raw e')

  pure ()