Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
Setting up Leaflet.js with Reflex.Dom
<!DOCTYPE html>
<html>
<head>
<!-- Add leaflet css -->
<link
rel="stylesheet" href="https://unpkg.com/leaflet@1.5.1/dist/leaflet.css"
integrity="sha512-xwE/Az9zrjBIphAcBb3F6JVqxf46+CDLwfLMHloNu6KEQCAWi6HcDUbeOfBIptF7tcCzusKFjFw2yuvEpDL9wQ=="
crossorigin=""
/>
<script language="javascript" src="rts.js"></script>
<script language="javascript" src="lib.js"></script>
<script language="javascript" src="out.js"></script>
<!-- Add leaflet javascript -->
<script
src="https://unpkg.com/leaflet@1.5.1/dist/leaflet.js"
integrity="sha512-GffPMF3RvMeYyc1LWMHtK8EbPv0iNZ8/oTtHPx9/cc2ILxQ+u905qIwdpULaqDkyBKgOaB57QTMg7ztg8Jm2Og=="
crossorigin="">
</script>
</head>
<body>
</body>
<script language="javascript" src="runmain.js" defer></script>
</html>
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE JavaScriptFFI #-}
{-# LANGUAGE OverloadedStrings #-}
import Reflex.Dom hiding (JSRef, Element)
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 :: MonadWidget t m => m ()
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

ali-abrar commented Oct 18, 2015

Note that this code will only work in GHCJS.

@ali-abrar

This comment has been minimized.

Copy link
Owner Author

ali-abrar 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

philderbeast 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.

@ali-abrar

This comment has been minimized.

Copy link
Owner Author

ali-abrar commented Sep 7, 2019

Updated to work with reflex-platform. Tested using hash 83dda45e2a91e6c657fe82bc63415e6dc283dc1a.

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.