Merge pull request #4 from f-o-a-m/halogen

add Halogen examples and some braking changes
f-o-a-m · May 9, 2018 · 0fdf1c1 · 0fdf1c1
2 parents 9322a5d + c3ddad7
commit 0fdf1c1
Show file tree

Hide file tree

Showing 20 changed files with 401 additions and 11,917 deletions.
diff --git a/.gitignore b/.gitignore
@@ -7,3 +7,4 @@
 /.psc*
 /.purs*
 /.psa*
+package-lock.json
diff --git a/.travis.yml b/.travis.yml
@@ -4,13 +4,16 @@ sudo: required
 node_js: stable
 install:
   - npm i
-  - npm run build
+  - bower i --production
 script:
-  - npm run -s example
+  - npm run build
+  - bower i
+  - npm run example-map
+  - npm run example-map-halogen
 deploy:
   provider: pages
   skip_cleanup: true
   github_token: $GITHUB_TOKEN # Set in travis-ci.org dashboard
-  local_dir: example/dist
+  local_dir: example/map/dist
   on:
     branch: master
diff --git a/bower.json b/bower.json
@@ -1,5 +1,6 @@
 {
   "name": "purescript-react-map-gl",
+  "description": "purescript wrappers for react-map-gl",
   "ignore": [
     "**/.*",
     "node_modules",
@@ -10,12 +11,15 @@
     "purescript-prelude": "^3.1.1",
     "purescript-console": "^3.0.0",
     "purescript-react": "^5.1.0",
-    "purescript-generics-rep": "^5.4.0"
+    "purescript-generics-rep": "^5.4.0",
+    "purescript-record": "^0.2.6"
   },
   "devDependencies": {
     "purescript-psci-support": "^3.0.0",
     "purescript-dom": "^4.15.0",
     "purescript-record": "^0.2.6",
-    "purescript-react-dom": "^5.0.0"
+    "purescript-react-dom": "^5.0.0",
+    "purescript-halogen": "^3.1.3",
+    "purescript-aff-bus": "^3.1.0"
   }
 }
diff --git a/example/.gitignore → example/map-halogen/.gitignore b/example/.gitignore → example/map-halogen/.gitignore
@@ -2,3 +2,4 @@
 /output/
 /bower_components/
 /node_modules/
+package-lock.json
diff --git a/example/map-halogen/README.md b/example/map-halogen/README.md
@@ -0,0 +1,18 @@
+## Build Instructions
+
+You can build this from the root directory
+
+```bash
+> npm i
+> npm run build
+> npm run example-map-halogen
+```
+
+or in this directory
+
+```bash
+> npm i
+> npm run build
+```
+
+Open `dist/index.html` to view the map.
diff --git a/example/bower.json → example/map-halogen/bower.json b/example/bower.json → example/map-halogen/bower.json
diff --git a/example/map-halogen/dist/index.html b/example/map-halogen/dist/index.html
@@ -0,0 +1,19 @@
+<!doctype html>
+<html>
+    <head>
+        <link href='https://api.mapbox.com/mapbox-gl-js/v0.42.0/mapbox-gl.css' rel='stylesheet' />
+        <title>react-map-gl example - map halogen</title>
+        <style>
+            body {margin: 0;}
+            .goto {
+                position: absolute;
+                top: 0px;
+                left: 0px;
+            }
+        </style>
+    </head>
+    <body>
+        <div id="app"></div>
+        <script src="example.js"></script>
+    </body>
+</html>
diff --git a/example/package.json → example/map-halogen/package.json b/example/package.json → example/map-halogen/package.json
diff --git a/example/map-halogen/src/Main.purs b/example/map-halogen/src/Main.purs
@@ -0,0 +1,76 @@
+module Main where
+
+import Prelude
+
+import Control.Monad.Aff.Class (class MonadAff)
+import Control.Monad.Eff (Eff)
+import Control.Monad.Eff.AVar (AVAR)
+import Control.Monad.Eff.Console (CONSOLE, log)
+import DOM (DOM)
+import Data.Foldable (for_)
+import Data.Maybe (Maybe(..))
+import Data.Newtype (over)
+import Halogen (liftEff)
+import Halogen as H
+import Halogen.Aff as HA
+import Halogen.HTML as HH
+import Halogen.HTML.Events as HE
+import Halogen.HTML.Properties as HP
+import Halogen.VDom.Driver (runUI)
+import MapComponent (MapMessages(..), MapQuery(..), mapComponent)
+import MapGL (LngLat, Viewport(..), lat, lng, makeLngLat)
+
+type State = {}
+
+data Query a
+  = GoTo LngLat a
+  | HandleMapUpdate MapMessages a
+
+data MapSlot = MapSlot
+derive instance eqMapSlot :: Eq MapSlot
+derive instance ordMapSlot :: Ord MapSlot
+
+ui 
+  :: forall m eff
+  . MonadAff (dom :: DOM, console :: CONSOLE, avar :: AVAR | eff) m
+  => H.Component HH.HTML Query Unit Void m
+ui =
+  H.parentComponent
+    { initialState: const initialState
+    , render
+    , eval
+    , receiver: const Nothing
+    }
+  where
+
+  initialState :: State
+  initialState = {}
+
+  render :: State -> H.ParentHTML Query MapQuery MapSlot m
+  render _ =
+    HH.div_
+      [ HH.slot MapSlot mapComponent unit $ Just <<< H.action <<< HandleMapUpdate
+      , HH.button
+          [ HP.class_ (HH.ClassName "goto")
+          , HE.onClick (HE.input_ $ GoTo $ makeLngLat 44.81647122397245 41.661632116606455) 
+          ]
+          [ HH.text "GoTo Tbilisi" ]
+      ]
+
+  eval :: Query ~> H.ParentDSL State Query MapQuery MapSlot Void m
+  eval (GoTo lnglat next) = do
+    mbVp <- H.query MapSlot $ H.request AskViewport
+    for_ mbVp \vp -> do
+      let nextVp = over Viewport (_{ latitude = lat lnglat, longitude = lng lnglat, zoom = 12.0}) vp
+      H.query MapSlot $ H.action $ SetViewport nextVp
+    pure next
+  eval (HandleMapUpdate msg next) = do
+    case msg of
+      OnViewportChange vp -> liftEff $ log $ show vp
+      OnClick info -> liftEff $ log $ show info.lngLat
+    pure next
+
+main :: Eff (HA.HalogenEffects (console :: CONSOLE)) Unit
+main = HA.runHalogenAff do
+  body <- HA.awaitBody
+  runUI ui unit body
diff --git a/example/map-halogen/src/MapComponent.purs b/example/map-halogen/src/MapComponent.purs
@@ -0,0 +1,189 @@
+module MapComponent
+  ( MapQuery(SetViewport, AskViewport)
+  , MapProps
+  , MapMessages(..)
+  , mapComponent
+  ) where
+
+import Prelude
+
+import Control.Lazy (fix)
+import Control.Monad.Aff (error, launchAff_)
+import Control.Monad.Aff.AVar (AVar, takeVar, putVar, makeEmptyVar)
+import Control.Monad.Aff.Bus as Bus
+import Control.Monad.Aff.Class (class MonadAff, liftAff)
+import Control.Monad.Eff.AVar (AVAR)
+import Control.Monad.Eff.Uncurried (mkEffFn1)
+import DOM (DOM)
+import DOM.HTML (window)
+import DOM.HTML.Types (htmlElementToElement)
+import DOM.HTML.Window as Window
+import Data.Maybe (Maybe(..))
+import Data.Tuple (snd)
+import Halogen (liftEff)
+import Halogen as H
+import Halogen.HTML as HH
+import Halogen.HTML.Properties as HP
+import Halogen.Query.EventSource as ES
+import MapGL (ClickInfo, Viewport)
+import MapGL as MapGL
+import Partial.Unsafe (unsafeCrashWith)
+import React as R
+import ReactDOM (render) as RDOM
+
+
+type MapState = Maybe (Bus.BusW Commands)
+
+type MapProps = Unit
+
+data MapQuery a
+  = Initialize a
+  | SetViewport Viewport a
+  | AskViewport (Viewport -> a)
+  | HandleMessages Messages a
+
+data MapMessages
+  = OnViewportChange Viewport
+  | OnClick ClickInfo
+
+mapComponent :: forall eff m. MonadAff (dom :: DOM, avar :: AVAR | eff) m => H.Component HH.HTML MapQuery MapProps MapMessages m
+mapComponent =
+  H.lifecycleComponent
+    { initialState: const initialState
+    , render
+    , eval
+    , initializer: Just (H.action Initialize)
+    , finalizer: Nothing
+    , receiver: const Nothing
+    }
+  where
+
+  initialState :: MapState
+  initialState = Nothing
+
+  render :: MapState -> H.ComponentHTML MapQuery
+  render = const $ HH.div [ HP.ref (H.RefLabel "map") ] []
+
+  eval :: MapQuery ~> H.ComponentDSL MapState MapQuery MapMessages m
+  eval = case _ of
+    Initialize next -> do
+      H.getHTMLElementRef (H.RefLabel "map") >>= case _ of
+        Nothing -> unsafeCrashWith "There must be an element with ref `map`"
+        Just el' -> do
+          win <- liftEff window
+          width <- liftEff $ Window.innerWidth win
+          height <- liftEff $ Window.innerHeight win
+          messages <- liftAff Bus.make
+          liftEff $ void $ RDOM.render (R.createFactory mapClass { messages: snd $ Bus.split messages, width, height}) (htmlElementToElement el')
+          H.subscribe $ H.eventSource (\emit -> launchAff_ $ fix \loop -> do
+              Bus.read messages >>= emit >>> liftEff
+              loop
+            )
+            (Just <<< flip HandleMessages ES.Listening)
+      pure next
+    HandleMessages msg next -> do
+      case msg of
+        IsInitialized bus -> H.put $ Just bus
+        PublicMsg msg' -> H.raise msg'
+      pure next
+    SetViewport vp next -> do
+      mbBus <- H.get
+      case mbBus of
+        Nothing -> unsafeCrashWith "At this point bus must be in state from eval SetViewport"
+        Just bus -> do
+          liftAff $ Bus.write (SetViewport' vp) bus
+      pure next
+    AskViewport reply -> do
+      mbBus <- H.get
+      case mbBus of
+        Nothing -> unsafeCrashWith "At this point bus must be in state from eval AskViewport"
+        Just bus -> do
+          var <- liftAff makeEmptyVar
+          liftAff $ Bus.write (AskViewport' var) bus
+          vp <- liftAff $ takeVar var
+          pure $ reply vp
+
+data Commands
+  = SetViewport' Viewport
+  | AskViewport' (AVar Viewport)
+
+data Messages
+  = IsInitialized (Bus.BusW Commands)
+  | PublicMsg MapMessages
+
+type Props =
+  { messages :: Bus.BusW Messages
+  , width :: Int
+  , height :: Int
+  }
+
+type State =
+  { command :: Bus.BusRW Commands
+  , viewport :: MapGL.Viewport
+  }
+
+mapClass :: R.ReactClass Props
+mapClass = R.createClass spec
+    { componentDidMount = componentDidMount
+    , componentWillUnmount = componentWillUnmount
+    }
+  where
+    componentWillUnmount :: forall eff. R.ComponentWillUnmount Props State (avar :: AVAR | eff)
+    componentWillUnmount this = R.readState this >>= \{ command } ->
+      launchAff_ $ do
+        props <- liftEff $ R.getProps this
+        Bus.kill (error "kill from componentWillUnmount") command
+
+    componentDidMount :: forall eff. R.ComponentDidMount Props State (avar :: AVAR, dom ∷ DOM |eff)
+    componentDidMount this = do
+      { command } <- R.readState this
+      launchAff_ $ fix \loop -> do
+        msg <- Bus.read command
+        case msg of
+          SetViewport' vp -> liftEff $ R.transformState this _{viewport = vp}
+          AskViewport' var -> liftEff (R.readState this) >>= \{viewport} -> putVar viewport var
+        loop
+
+    spec :: forall eff. R.ReactSpec Props State R.ReactElement (dom :: DOM, avar :: AVAR | eff)
+    spec = R.spec' initialState render
+
+    render :: forall eff. R.Render Props State R.ReactElement eff
+    render this = do
+      { messages } <- R.getProps this
+      { viewport } <- R.readState this
+      pure
+        $ R.createFactory MapGL.mapGL
+        $ MapGL.mkProps viewport
+          { onViewportChange: mkEffFn1 $ \newVp -> do
+              launchAff_ $ Bus.write (PublicMsg $ OnViewportChange newVp) messages
+              void $ R.transformState this _{viewport = newVp}
+          , onClick: mkEffFn1 $ \info -> do
+              launchAff_ $ Bus.write (PublicMsg $ OnClick info) messages
+          , mapStyle: mapStyle
+          , mapboxApiAccessToken: mapboxApiAccessToken
+          }
+
+    initialState :: forall eff. R.GetInitialState Props State (dom :: DOM, avar :: AVAR | eff)
+    initialState this = do
+      command <- Bus.make
+      { messages, width, height } <- R.getProps this
+      launchAff_ $ Bus.write (IsInitialized $ snd $ Bus.split command) messages
+      pure
+        { viewport: MapGL.Viewport
+          { width
+          , height
+          , longitude: -74.00539284665783
+          , latitude: 40.70544878575082
+          , zoom: 10.822714855509464
+          , pitch: 0.0
+          , bearing: 0.0
+          }
+        , command
+        }
+
+
+mapStyle :: String
+mapStyle = "mapbox://styles/mapbox/dark-v9"
+
+mapboxApiAccessToken :: String
+mapboxApiAccessToken = "pk.eyJ1IjoiYmxpbmt5MzcxMyIsImEiOiJjamVvcXZtbGYwMXgzMzNwN2JlNGhuMHduIn0.ue2IR6wHG8b9eUoSfPhTuQ"
diff --git a/example/map/.gitignore b/example/map/.gitignore
@@ -0,0 +1,5 @@
+/dist/example.js
+/output/
+/bower_components/
+/node_modules/
+package-lock.json
diff --git a/example/README.md → example/map/README.md b/example/README.md → example/map/README.md
@@ -5,7 +5,7 @@ You can build this from the root directory
 ```bash
 > npm i
 > npm run build
-> npm run example
+> npm run example-map
 ```
 
 or in this directory

diff --git a/example/map/bower.json b/example/map/bower.json
@@ -0,0 +1,11 @@
+{
+  "name": "icon",
+  "private": true,
+  "dependencies": {
+    "purescript-react": "^5.1.0",
+    "purescript-react-map-gl": "*",
+    "purescript-dom": "^4.15.0",
+    "purescript-record": "^0.2.6",
+    "purescript-react-dom": "^5.0.0"
+  }
+}
diff --git a/example/dist/index.html → example/map/dist/index.html b/example/dist/index.html → example/map/dist/index.html
@@ -2,7 +2,10 @@
 <html>
     <head>
         <link href='https://api.mapbox.com/mapbox-gl-js/v0.42.0/mapbox-gl.css' rel='stylesheet' />
-        <title>react-map-gl example - icons</title>
+        <title>react-map-gl example - map</title>
+        <style>
+            body {margin: 0;}
+        </style>
     </head>
     <body>
         <div id="app"></div>
-Original file line number
+Diff line change
@@ Expand Up / @@ -7,3 +7,4 @@ @@
     /.psc*
     /.purs*
     /.psa*
+    package-lock.json