fable experiments

build.cmd

@@ -0,0 +1,5 @@
+cd src\Client
+dotnet fable webpack -p
+cd ..\Server
+dotnet build
+cd ..\..

dev-cli.cmd

@@ -0,0 +1,2 @@
+@cd src\Client
+dotnet fable webpack-dev-server

dev-server.cmd

@@ -0,0 +1,2 @@
+@cd src\Server
+dotnet watch run

paket.dependencies

@@ -2,14 +2,13 @@ source https://www.nuget.org/api/v2
 source .nuget-packages
 storage: none
 
-clitool Microsoft.DotNet.Watcher.Tools 2.0.0
-
 nuget Suave
 nuget Suave.OAuth
 nuget Suave.Experimental
 nuget Akkling > 0.7.0
 nuget Akkling.Streams > 0.7.0
 nuget Newtonsoft.Json
+nuget Fable.JsonConverter
 
 nuget Microsoft.Extensions.Configuration
 nuget Microsoft.Extensions.Configuration.Json
@@ -21,4 +20,5 @@ nuget Fable.Elmish.React
 nuget Fable.Elmish.Browser
 nuget Fable.Elmish.Debugger
 
+clitool Microsoft.DotNet.Watcher.Tools 2.0.0
 clitool dotnet-fable

paket.lock

@@ -28,9 +28,8 @@ NUGET
       Fable.Core (>= 1.2.4) - restriction: >= netcoreapp2.0
       FSharp.Core (>= 4.2.3) - restriction: >= netcoreapp2.0
       Microsoft.NETCore.App (>= 2.0) - restriction: >= netcoreapp2.0
-    Dotnet.ProjInfo (0.7.4) - restriction: >= netcoreapp2.0
-      FSharp.Core (>= 4.1.17) - restriction: && (< net45) (>= netstandard1.6)
-      NETStandard.Library (>= 1.6.1) - restriction: && (< net45) (>= netstandard1.6)
+    Dotnet.ProjInfo (0.8) - restriction: >= netcoreapp2.0
+      FSharp.Core (>= 4.2.3) - restriction: && (< net45) (>= netstandard2.0)
     Fable.Compiler (1.2.4) - restriction: >= netcoreapp2.0
       Fable.Core (>= 1.2.4) - restriction: >= netstandard1.6
       FSharp.Compiler.Service (>= 14.0.2) - restriction: >= netstandard1.6
@@ -68,10 +67,14 @@ NUGET
       Fable.PowerPack (>= 1.3) - restriction: >= netstandard1.6
       Fable.React (>= 1.2) - restriction: >= netstandard1.6
       FSharp.Core (>= 4.2.3) - restriction: >= netstandard1.6
-    Fable.Import.Browser (0.1.1) - restriction: >= netstandard1.6
+    Fable.Import.Browser (0.1.2) - restriction: >= netstandard1.6
       Fable.Core (>= 1.1.15) - restriction: >= netstandard1.6
       FSharp.Core (>= 4.2.3) - restriction: >= netstandard1.6
       NETStandard.Library (>= 1.6.1) - restriction: >= netstandard1.6
+    Fable.JsonConverter (1.0.2)
+      FSharp.Core (>= 4.1.17) - restriction: || (>= net45) (>= netstandard1.6)
+      NETStandard.Library (>= 1.6.1) - restriction: && (< net45) (>= netstandard1.6)
+      Newtonsoft.Json (>= 9.0.1) - restriction: || (>= net45) (>= netstandard1.6)
     Fable.PowerPack (1.3) - restriction: >= netstandard1.6
       Fable.Core (>= 1.2.4) - restriction: >= netstandard1.6
       Fable.Import.Browser (>= 0.1) - restriction: >= netstandard1.6

readme.md

@@ -9,15 +9,26 @@ Sample chat application built with netcore, F#, Akka.net and Fable.
 * yarn (`npm i yarn -g`)
 * npm5: JS package manager
 
-
 ## Building and running the app
 
 * Install JS dependencies: `yarn`
-* **Move to `src` folder**: `cd src`
+* **Move to `src/Client` folder**: `cd src\Client`
+* Install F# dependencies: `dotnet restore`
+* Build client bundle: `dotnet fable webpack -p`
+* **Move to `src/Server` folder**: `cd src\Server`
 * Install F# dependencies: `dotnet restore`
-* Start Fable daemon and [Webpack](https://webpack.js.org/) dev server: `dotnet fable npm-start`
+* Run the server: `dotnet run`
+
+
+## Developing the app
+
+* Start the server (see instruction above)
+* **Move to `src/Client` folder**: `cd src\Client`
+* Start Fable daemon and [Webpack](https://webpack.js.org/) dev server: `dotnet fable webpack-dev-server`
 * In your browser, open: http://localhost:8080/
 
+> Notice: logon screen will redirect your browser to localhost:8083 (per configuration of server auth handler), you have manually change the port to 8080
+
 ## References
 
 * [paket and dotnet cli](https://fsprojects.github.io/Paket/paket-and-dotnet-cli.html)

src/Client/App.fs

@@ -5,8 +5,6 @@ open Elmish.Browser.Navigation
 open Elmish.Browser.UrlParser
 open Fable.Core
 open Fable.Core.JsInterop
-open Fable.Import
-open Fable.Import.Browser
 open Types
 open App.State
 open Global
@@ -50,7 +48,7 @@ let root model dispatch =
         [ ClassName "navbar-bg" ]
         [ div
             [ ClassName "container" ]
-            [ Navbar.View.root ] ]
+            [ Navbar.View.root model.userinfo ] ]
       div
         [ ClassName "section" ]
         [ div

src/Client/Home/View.fs

@@ -4,7 +4,6 @@ open Fable.Core
 open Fable.Core.JsInterop
 open Fable.Helpers.React
 open Fable.Helpers.React.Props
-open Types
 
 let root model dispatch =
   div
@@ -17,8 +16,8 @@ let root model dispatch =
               Placeholder "Type your name"
               DefaultValue model
               AutoFocus true
-              OnChange (fun ev -> !!ev.target?value |> ChangeStr |> dispatch ) ] ]
+              OnChange (fun ev -> !!ev.target?value |> Types.ChangeStr |> dispatch ) ] ]
       br [ ]
       span
         [ ]
-        [ str (sprintf "Hello %s" model) ] ]
+        [ str (sprintf "Hello %s!" model) ] ]

src/Client/Navbar/View.fs

@@ -3,6 +3,8 @@ module Navbar.View
 open Fable.Helpers.React
 open Fable.Helpers.React.Props
 
+open UserInfo.Types
+
 let navButton classy href faClass txt =
     p
         [ ClassName "control" ]
@@ -18,23 +20,33 @@ let navButton classy href faClass txt =
                 [ ]
                 [ str txt ] ] ]
 
-let navButtons =
+let private userInfoText =
+    function
+    | NotLoggedIn -> "Please login"
+    | UserInfo u -> u.Nick
+    | Error x -> "error" + x.ToString()
+
+
+let navButtons userInfo =
     span
         [ ClassName "nav-item" ]
         [ div
             [ ClassName "field is-grouped" ]
-            [ navButton "twitter" "https://twitter.com/FableCompiler" "fa-twitter" "Twitter"
-              navButton "github" "https://github.com/fable-compiler/fable-elmish" "fa-github" "Fork me"
-              navButton "github" "https://gitter.im/fable-compiler/Fable" "fa-comments" "Gitter" ] ]
+            [
+                p [ ClassName "control" ]
+                  [ p [ClassName "userinfo"] [str <| userInfoText userInfo]]
+                navButton "twitter" "https://twitter.com/OlegZee" "fa-twitter" "Twitter"
+                navButton "" "/logoff" "fa-hand-o-right" "Log off"
+                ] ]
 
-let root =
+let root (userInfo: UserInfo) =
     nav
         [ ClassName "nav" ]
         [ div
             [ ClassName "nav-left" ]
             [ h1
                 [ ClassName "nav-item is-brand title is-4" ]
-                [ str "Elmish" ] ]
+                [ str "F# Chat" ] ]
           div
             [ ClassName "nav-right" ]
-            [ navButtons ] ]
+            [ navButtons userInfo ] ]

src/Client/State.fs

@@ -25,14 +25,18 @@ let urlUpdate (result: Option<Page>) model =
 let init result =
   let (counter, counterCmd) = Counter.State.init()
   let (home, homeCmd) = Home.State.init()
+  let (uinfo, uinfoCmd) = UserInfo.State.init()
   let (model, cmd) =
     urlUpdate result
       { currentPage = Home
         counter = counter
-        home = home }
+        home = home
+        userinfo = uinfo }
   model, Cmd.batch [ cmd
                      Cmd.map CounterMsg counterCmd
-                     Cmd.map HomeMsg homeCmd ]
+                     Cmd.map HomeMsg homeCmd 
+                     Cmd.map UserInfoMsg uinfoCmd
+                     ]
 
 let update msg model =
   match msg with
@@ -42,3 +46,6 @@ let update msg model =
   | HomeMsg msg ->
       let (home, homeCmd) = Home.State.update msg model.home
       { model with home = home }, Cmd.map HomeMsg homeCmd
+  | UserInfoMsg msg ->
+      let (uinfo, uinfoCmd) = UserInfo.State.update msg model.userinfo
+      { model with userinfo = uinfo }, Cmd.map UserInfoMsg uinfoCmd

src/Client/Types.fs

@@ -5,9 +5,11 @@ open Global
 type Msg =
   | CounterMsg of Counter.Types.Msg
   | HomeMsg of Home.Types.Msg
+  | UserInfoMsg of UserInfo.Types.Msg
 
 type Model = {
     currentPage: Page
     counter: Counter.Types.Model
     home: Home.Types.Model
+    userinfo: UserInfo.Types.UserInfo
   }

src/Client/UserInfo/State.fs

@@ -0,0 +1,29 @@
+module UserInfo.State
+
+open Elmish
+open Fable.PowerPack
+open Fable.PowerPack.Fetch.Fetch_types
+
+open Types
+
+type private WhoPayload = {Id: string; UserId: string; Nickname: string}
+
+let getUserInfo () =
+    promise {
+        let props =
+            [Credentials RequestCredentials.Include]
+        let! response = Fetch.fetchAs<WhoPayload> "/api/who" props
+        return {Nick = response.Nickname; UserId = response.UserId}
+    }
+
+let loadUserInfoCmd = 
+    Cmd.ofPromise getUserInfo () Update FetchError
+
+let init () : UserInfo * Cmd<Msg> =
+  NotLoggedIn, loadUserInfoCmd
+
+let update msg _ =
+  match msg with
+  | Update x ->     UserInfo x, []
+  | Reset ->        NotLoggedIn, []
+  | FetchError x -> Error x, []

src/Client/UserInfo/Types.fs

@@ -0,0 +1,6 @@
+module UserInfo.Types
+
+type UserInfoData = {Nick: string; UserId: string}
+type UserInfo = NotLoggedIn | UserInfo of UserInfoData | Error of exn // FIXME remove error
+
+type Msg = Update of UserInfoData | Reset | FetchError of exn

src/Client/client.fsproj

@@ -6,6 +6,11 @@
     <!-- Global to the app -->
     <Compile Include="Global.fs" />
     <!-- Info -->
+    <Compile Include="UserInfo/Types.fs" />
+    <Compile Include="UserInfo/State.fs" />
+    <!-- Info -->
+    <Compile Include="Info/Types.fs" />
+    <Compile Include="Info/State.fs" />
     <Compile Include="Info/View.fs" />
     <!-- Counter -->
     <Compile Include="Counter/Types.fs" />