Skip to content

Instantly share code, notes, and snippets.

@ali-abrar ali-abrar/leaf.hs
Last active Feb 12, 2019

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 ()
@ali-abrar

This comment has been minimized.

Copy link
Owner Author

commented Oct 18, 2015

Note that this code will only work in GHCJS.

@ali-abrar

This comment has been minimized.

Copy link
Owner Author

commented Oct 18, 2015

The result (as of Revision 5) should look something like this.

Note that you'll have to include leaflet js and css files on your page, as described here. One way to do this is to edit the index.html file that ghcjs produces (you might want to take care that your modified file doesn't get overwritten with each build).

I'm building this using try-reflex.

@philderbeast

This comment has been minimized.

Copy link

commented Feb 12, 2019

Thanks @ali-abrar for showing how to do this. Starting from this gist I've been able to show maps of race courses in the sky and the tracks of competing pilots with similar code.

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.