Last active
June 8, 2020 04:47
-
-
Save ali-abrar/fa2adbbb7ee64a0295cb to your computer and use it in GitHub Desktop.
Setting up Leaflet.js with Reflex.Dom
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| <!DOCTYPE html> | |
| <html> | |
| <head> | |
| <!-- Add leaflet css --> | |
| <link | |
| rel="stylesheet" href="https://unpkg.com/[email protected]/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/[email protected]/dist/leaflet.js" | |
| integrity="sha512-GffPMF3RvMeYyc1LWMHtK8EbPv0iNZ8/oTtHPx9/cc2ILxQ+u905qIwdpULaqDkyBKgOaB57QTMg7ztg8Jm2Og==" | |
| crossorigin=""> | |
| </script> | |
| </head> | |
| <body> | |
| </body> | |
| <script language="javascript" src="runmain.js" defer></script> | |
| </html> |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| {-# 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 "© <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 () |
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.
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.
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
Note that this code will only work in GHCJS.