Skip to content

Instantly share code, notes, and snippets.

@christiantakle christiantakle/leaf.hs forked from ali-abrar/leaf.hs
Created Mar 22, 2016

Embed
What would you like to do?
Setting up Leaflet.js with Reflex.Dom
{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI #-}
import Reflex.Dom
import Data.Monoid
import GHCJS.Types
import GHCJS.Foreign
import GHCJS.DOM.Element
import GHCJS.DOM.Types
import Control.Monad.IO.Class
newtype LeafletMap = LeafletMap { unLeafletMap :: JSRef LeafletMap }
newtype LeafletTileLayer = LeafletTileLayer { unLeafletTileLayer :: JSRef LeafletTileLayer }
foreign import javascript unsafe "L['map']($1)" leafletMap_ :: JSRef Element -> IO (JSRef LeafletMap)
foreign import javascript unsafe "$1['setView']([$2, $3], $4)" leafletMapSetView_ :: JSRef LeafletMap -> Double -> Double -> Int -> IO ()
foreign import javascript unsafe "L['tileLayer']($1, { maxZoom: $2, attribution: $3})" leafletTileLayer_ :: JSString -> Int -> JSString -> IO (JSRef LeafletTileLayer)
foreign import javascript unsafe "$1['addTo']($2)" leafletTileLayerAddToMap_ :: JSRef LeafletTileLayer -> JSRef LeafletMap -> IO ()
foreign import javascript unsafe "$1['invalidateSize']()" leafletMapInvalidateSize_ :: JSRef LeafletMap -> IO ()
leafletMap :: IsElement e => e -> IO LeafletMap
leafletMap e = do
lm <- leafletMap_ $ unElement $ toElement e
return $ LeafletMap lm
leafletMapSetView :: LeafletMap -> (Double, Double) -> Int -> IO ()
leafletMapSetView lm (lat, lng) zoom =
leafletMapSetView_ (unLeafletMap lm) lat lng zoom
leafletTileLayer :: String -> Int -> String -> IO LeafletTileLayer
leafletTileLayer src maxZoom attribution = do
ltl <- leafletTileLayer_ (toJSString src) maxZoom (toJSString attribution)
return $ LeafletTileLayer ltl
leafletTileLayerAddToMap :: LeafletTileLayer -> LeafletMap -> IO ()
leafletTileLayerAddToMap ltl lm = leafletTileLayerAddToMap_ (unLeafletTileLayer ltl) (unLeafletMap lm)
main :: IO ()
main = mainWidget bodyTag
bodyTag = do
(e, _) <- elAttr' "div" ("style" =: "height: 300px;") $ return ()
lm <- liftIO $ do
lm <- leafletMap $ _el_element e
leafletMapSetView lm (40.769, -73.9655) 13
ltl <- leafletTileLayer "http://{s}.tile.openstreetmap.org/{z}/{x}/{y}.png" 19 "&copy; <a href='http://www.openstreetmap.org/copyright'>OpenStreetMap</a>"
leafletTileLayerAddToMap ltl lm
return lm
-- The call to invalidateSize below works around the issue described in this post:
-- http://stackoverflow.com/questions/17863904/leaflet-mapbox-rendering-issue-grey-area
postBuild <- getPostBuild
performEvent_ $ fmap (\_ -> liftIO $ leafletMapInvalidateSize_ $ unLeafletMap lm) postBuild
return ()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.