[#166] WIP - Fetch data

- add `isomorphic-fetch`
- first FFI of `isomorphic-fetch`
- fetch mock data
- show progress (webpack)

front-ps/bower.json

@@ -16,5 +16,8 @@
     "purescript-aff": "^3.0.0",
     "purescript-affjax": "^4.0.0",
     "purescript-hyper": "^0.7.3"
+  },
+  "devDependencies": {
+    "purescript-debug": "3.0.0"
   }
 }

front-ps/package.json

@@ -12,7 +12,7 @@
   "scripts": {
     "postinstall": "bower cache clean && bower install",
     "clean": "rimraf static/dist && rimraf dist",
-    "build": "npm run clean && webpack --config ./webpack.config.client.js --progress --profile --colors && webpack --config ./webpack.config.server.js --progress --profile --colors",
+    "build": "npm run clean && webpack --config ./webpack.config.client.js --progress && webpack --config ./webpack.config.server.js --progress",
     "watch": "npm run clean && node ./webpack.config.client.js",
     "serve": "npm run build && node ./dist/server.js",
     "start": "npm run watch",
@@ -29,7 +29,9 @@
   },
   "dependencies": {
     "bower": "^1.7.9",
+    "es6-promise": "^4.1.1",
     "express": "^4.13.4",
+    "isomorphic-fetch": "^2.2.1",
     "preact": "^8.1.0",
     "preact-compat": "^3.16.0",
     "purescript": "^0.11.5",

front-ps/src/Guide/Api/Http.purs

@@ -0,0 +1,10 @@
+module Guide.Http where
+
+import Prelude
+
+import Control.Monad.Aff (Aff)
+import Lib.IsomorphicFetch (FETCH, fetch)
+
+fetchGithubUsers :: forall eff. Int -> Aff (fetch :: FETCH | eff) String
+-- fetchGithubUsers since = fetch $ "https://api.github.com/users?since=" <> show since
+fetchGithubUsers _ = fetch "https://jsonplaceholder.typicode.com/users"

front-ps/src/Guide/Events.purs

@@ -2,9 +2,15 @@ module Guide.Events where
 
 import Prelude
 
+import Control.Monad.Aff (attempt)
+import Control.Monad.Eff.Exception (Error)
+import Data.Array ((:))
+import Data.Either (Either(..))
 import Data.Maybe (Maybe(..))
+import Guide.Http (fetchGithubUsers)
 import Guide.Routes (Route(..), match)
 import Guide.State (State(..))
+import Lib.IsomorphicFetch (FETCH)
 import Network.HTTP.Affjax (AJAX)
 import Pux (EffModel, noEffects, onlyEffects)
 import Pux.DOM.Events (DOMEvent)
@@ -13,20 +19,53 @@ data Event
   -- Routing
   = PageView Route
   | Navigate String DOMEvent
+  -- playground
+  | RequestGithubUsers
+  | ReceiveGithubUsers (Either Error String)
 
-type AppEffects eff = (ajax :: AJAX | eff)
+type AppEffects eff = (ajax :: AJAX, fetch :: FETCH | eff)
 
 foldp :: ∀ eff. Event -> State -> EffModel State Event (AppEffects eff)
+
+-- Playground
+
+foldp RequestGithubUsers state = onlyEffects state
+  [ attempt (fetchGithubUsers 4) >>= pure <<< Just <<< ReceiveGithubUsers
+  ]
+
+foldp (ReceiveGithubUsers (Right users)) (State st) = noEffects $
+  State $
+    st  { loaded = true
+        , users = users
+        }
+
+foldp (ReceiveGithubUsers (Left error)) s@(State st) = noEffects $
+  State $
+    st  { loaded = true
+        , errors = (show error) : st.errors
+        }
+
+-- Routing
 foldp (Navigate url ev) state = onlyEffects state
   [ -- TODO (sectore): Update history (on client side only)
-  pure <<< Just $ PageView (match url)
+    pure <<< Just $ PageView (match url)
   ]
 
 foldp (PageView route) (State st) =
-  routeEffects route (State $ st { route = route, loaded = true })
+  routeEffects route (State $ st { route = route })
 
 routeEffects :: ∀ fx. Route -> State -> EffModel State Event (AppEffects fx)
-routeEffects Home s@(State st) = noEffects $ s
-routeEffects Haskell s@(State st) = noEffects $ s
-routeEffects Playground s@(State st) = noEffects $ s
-routeEffects (NotFound url) s@(State st) = noEffects $ s
+routeEffects Home s@(State st) = noEffects $
+  State $ st { loaded = true }
+
+routeEffects Haskell s@(State st) = noEffects $
+  State $ st { loaded = true }
+
+routeEffects Playground s@(State st) =
+  { state: State $ st { loaded = false }
+  , effects: [
+      attempt (fetchGithubUsers 2) >>= pure <<< Just <<< ReceiveGithubUsers
+  ]}
+
+routeEffects (NotFound url) s@(State st) = noEffects $
+  State $ st { loaded = true }

front-ps/src/Guide/State.purs

@@ -11,16 +11,21 @@ newtype State = State
   { title :: String
   , route :: Route
   , loaded :: Boolean
+  , errors :: Array String
+  , users :: String
   }
 
-derive instance genericState :: Generic State _
+derive instance gState :: Generic State _
 derive instance newtypeState :: Newtype State _
-
-instance showState :: Show State where show = genericShow
+instance showState :: Show State where
+  show = genericShow
 
 init :: String -> State
 init url = State
   { title: config.title
   , route: match url
   , loaded: false
+  , errors: []
+  -- playground
+  , users: ""
   }

front-ps/src/Guide/Types.purs

@@ -0,0 +1,28 @@
+module Guide.Types where
+
+import Prelude
+
+import Data.Foreign.Class (class Decode, class Encode)
+import Data.Foreign.Generic (defaultOptions, genericDecode, genericEncode)
+import Data.Generic.Rep (class Generic)
+import Data.Generic.Rep.Show (genericShow)
+import Data.Newtype (class Newtype)
+import Lib.IsomorphicFetch (URI)
+
+newtype User = User {
+  login :: String,
+  avatar_url :: URI,
+  html_url :: URI
+}
+
+derive instance gUser :: Generic User _
+derive instance newtypeUser :: Newtype User _
+derive instance eqUser :: Eq User
+instance showUser :: Show User where
+  show = genericShow
+instance decodeUser :: Decode User where
+  decode = genericDecode $ defaultOptions { unwrapSingleConstructors = true }
+instance encodeUser :: Encode User where
+  encode = genericEncode $ defaultOptions { unwrapSingleConstructors = true }
+
+type Users = Array User

front-ps/src/Guide/View/Playground.purs

@@ -2,22 +2,25 @@ module Guide.View.Playground where
 
 import Prelude
 
-import Guide.State (State)
 import Guide.Events (Event(..))
 import Guide.Routes (Route(Home), toUrl)
-
+import Guide.State (State(..))
 import Pux.DOM.Events (onClick) as P
 import Pux.DOM.HTML (HTML) as P
-
 import Text.Smolder.HTML (div, h2, a) as S
 import Text.Smolder.HTML.Attributes (href) as S
 import Text.Smolder.Markup ((#!), (!))
 import Text.Smolder.Markup (text) as S
 
 playgroundView :: State -> P.HTML Event
-playgroundView _ =
+playgroundView (State st) =
   S.div $ do
     S.h2 $ S.text "Playground"
     S.a ! S.href (toUrl Home)
         #! P.onClick (Navigate $ toUrl Home)
         $ S.text "Back to Home"
+    S.div
+      #! P.onClick (const RequestGithubUsers)
+      $ S.text "Fetch Github users!"
+    S.div
+      $ S.text $ "Users: " <> st.users

front-ps/src/Lib/IsomorphicFetch/IsomorphicFetch.js

@@ -0,0 +1,17 @@
+
+require('es6-promise').polyfill();
+require('isomorphic-fetch');
+
+exports.fetchImpl = function(uri, done, fail) {
+  return fetch(uri)
+  	.then( function(response) {
+      const status = response.status;
+  		if (status >= 400) {
+        return fail('Bad response from server -> status : ' + status);
+  		}
+  		return response.json();
+  	})
+    .then(function(data) {
+  		done(data)();
+  	});
+  };

front-ps/src/Lib/IsomorphicFetch/IsomorphicFetch.purs

@@ -0,0 +1,23 @@
+module Lib.IsomorphicFetch where
+
+import Prelude
+
+import Control.Monad.Aff (Aff, makeAff)
+import Control.Monad.Eff (Eff, kind Effect)
+import Control.Monad.Eff.Exception (Error)
+import Data.Function.Uncurried (Fn3, runFn3)
+
+
+foreign import data FETCH :: Effect
+
+type URI = String
+
+foreign import fetchImpl :: forall a eff . Fn3 URI
+  (a -> Eff (fetch :: FETCH | eff) Unit)
+  (Error -> Eff (fetch :: FETCH | eff) Unit)
+  (Eff (fetch :: FETCH | eff) Unit)
+
+
+fetch :: forall a eff. URI -> Aff (fetch :: FETCH | eff) a
+fetch uri = makeAff \errCb successCb ->
+  runFn3 fetchImpl uri successCb errCb

front-ps/src/Server.purs

@@ -1,25 +1,26 @@
 module Server where
 
 import Prelude
-import Guide.Events (AppEffects, Event(..), foldp)
-import Guide.Routes (Route(..), match)
-import Guide.State (State(..), init)
-import Guide.View.HTMLWrapper (htmlWrapper)
-import Guide.View.Layout (view)
+
 import Control.IxMonad (ibind)
 import Control.Monad.Aff.Class (liftAff, class MonadAff)
 import Control.Monad.Eff (Eff)
 import Control.Monad.Eff.Class (liftEff, class MonadEff)
 import Control.Monad.Eff.Console (CONSOLE)
-import Data.Int (fromString)
 import Data.Foreign.Generic (defaultOptions, genericEncodeJSON)
+import Data.Int (fromString)
 import Data.Maybe (fromMaybe)
 import Data.Newtype (un)
-import Hyper.Node.Server (runServer, defaultOptionsWithLogging)
-import Hyper.Port (Port(Port))
+import Guide.Events (AppEffects, Event(..), foldp)
+import Guide.Routes (Route(..), match)
+import Guide.State (State(..), init)
+import Guide.View.HTMLWrapper (htmlWrapper)
+import Guide.View.Layout (view)
 import Hyper.Conn (Conn)
 import Hyper.Middleware (Middleware, lift')
 import Hyper.Node.FileServer (fileServer)
+import Hyper.Node.Server (runServer, defaultOptionsWithLogging)
+import Hyper.Port (Port(Port))
 import Hyper.Request (class Request, getRequestData)
 import Hyper.Response (class Response, class ResponseWritable, ResponseEnded, StatusLineOpen, closeHeaders, respond, writeStatus)
 import Hyper.Status (statusNotFound, statusOK)
@@ -55,7 +56,11 @@ appHandler = do
     }
 
   -- | Inject initial state used to bootstrap app in support/client.entry.js
+  -- _ <- liftEff $ log "XXX Before"
+  -- _ <- traceAnyM app.state
   state <- lift' $ liftAff $ waitState (\(State st) -> st.loaded) app
+  -- _ <- traceAnyM "XXX After"
+  -- _ <- traceAny state
   let state_json = "window.__puxInitialState = "
                  <> (genericEncodeJSON (defaultOptions { unwrapSingleConstructors = true }) state)
                  <> ";"

front-ps/src/common.js

@@ -0,0 +1,2 @@
+require('es6-promise').polyfill();
+require('isomorphic-fetch');

front-ps/src/index.client.js

@@ -0,0 +1,25 @@
+// shared js 
+import './common.js';
+// client app
+import Client from './Client.purs';
+
+// window.__puxInitialState is the JSON serialized state injected after
+// rendering on the server (src/Server.purs).
+const initialState = Client.readState(window.__puxInitialState);
+
+// If hot-reloading, hook into each state change and re-render using the last
+// state.
+if (module.hot) {
+  let app = Client.main(window.location.pathname)(window.__puxLastState || initialState)()
+
+  // Hook for pux devtools
+  window.__puxApp = app;
+
+  app.state.subscribe((state) => {
+    window.__puxLastState = state;
+  });
+
+  module.hot.accept();
+} else {
+  Client.main(window.location.pathname)(initialState)()
+}

front-ps/src/index.server.js

@@ -0,0 +1,5 @@
+// shared js
+import './common.js';
+// server app
+import Server from './Server.purs';
+Server.main();

front-ps/webpack.config.client.js

@@ -4,9 +4,10 @@ const path = require('path')
 const webpack = require('webpack')
 const isProd = process.env.NODE_ENV === 'production'
 
-const entries = [path.join(__dirname, 'support/client.entry.js')]
+const entries = [ path.join(__dirname, 'src/index.client.js')]
 
 const plugins = [
+  new webpack.ProgressPlugin(),
   new webpack.DefinePlugin({
     'process.env.NODE_ENV': JSON.stringify(process.env.NODE_ENV),
     '$PRODUCTION': isProd,

front-ps/webpack.config.server.js

@@ -3,8 +3,10 @@ const webpack = require('webpack')
 const nodeExternals = require('webpack-node-externals')
 const isProd = process.env.NODE_ENV === 'production'
 
-const entries = [path.join(__dirname, 'support', 'server.entry.js')]
+const entries = [ path.join(__dirname, 'src', 'index.server.js')
+  ]
 const plugins = [
+  new webpack.ProgressPlugin(),
   new webpack.ProvidePlugin({
     'XMLHttpRequest': 'xhr2'
   }),

front-ps/yarn.lock

@@ -871,8 +871,8 @@ end-of-stream@^1.0.0:
     once "^1.4.0"
 
 enhanced-resolve@^3.0.0:
-  version "3.2.0"
-  resolved "https://registry.yarnpkg.com/enhanced-resolve/-/enhanced-resolve-3.2.0.tgz#7b60300c98e155a9caa06bf4550ec010bf74f6f8"
+  version "3.3.0"
+  resolved "https://registry.yarnpkg.com/enhanced-resolve/-/enhanced-resolve-3.3.0.tgz#950964ecc7f0332a42321b673b38dc8ff15535b3"
   dependencies:
     graceful-fs "^4.1.2"
     memory-fs "^0.4.0"
@@ -921,6 +921,10 @@ es6-map@^0.1.3:
     es6-symbol "~3.1.1"
     event-emitter "~0.3.5"
 
+es6-promise@^4.1.1:
+  version "4.1.1"
+  resolved "https://registry.yarnpkg.com/es6-promise/-/es6-promise-4.1.1.tgz#8811e90915d9a0dba36274f0b242dbda78f9c92a"
+
 es6-set@~0.1.5:
   version "0.1.5"
   resolved "https://registry.yarnpkg.com/es6-set/-/es6-set-0.1.5.tgz#d2b3ec5d4d800ced818db538d28974db0a73ccb1"
@@ -1462,8 +1466,8 @@ hash-base@^2.0.0:
     inherits "^2.0.1"
 
 hash.js@^1.0.0, hash.js@^1.0.3:
-  version "1.1.2"
-  resolved "https://registry.yarnpkg.com/hash.js/-/hash.js-1.1.2.tgz#bf5c887825cfe40b9efde7bf11bd2db26e6bf01b"
+  version "1.1.3"
+  resolved "https://registry.yarnpkg.com/hash.js/-/hash.js-1.1.3.tgz#340dedbe6290187151c1ea1d777a3448935df846"
   dependencies:
     inherits "^2.0.3"
     minimalistic-assert "^1.0.0"
@@ -1749,7 +1753,7 @@ isobject@^2.0.0:
   dependencies:
     isarray "1.0.0"
 
-isomorphic-fetch@^2.1.1:
+isomorphic-fetch@^2.1.1, isomorphic-fetch@^2.2.1:
   version "2.2.1"
   resolved "https://registry.yarnpkg.com/isomorphic-fetch/-/isomorphic-fetch-2.2.1.tgz#611ae1acf14f5e81f729507472819fe9733558a9"
   dependencies: