Brought in data model / dependencies

A combination of the previous effort plus a few things swiped from
Quatro

src/App.fs

@@ -0,0 +1,36 @@
+/// Main server module for myPrayerJournal
+module MyPrayerJournal.App
+
+open Reader
+open System.IO
+open Suave
+open Suave.Filters
+open Suave.Operators
+
+/// Data Configuration singleton 
+let lazyCfg = lazy (DataConfig.FromJson <| try File.ReadAllText "data-config.json" with _ -> "{}")
+/// RethinkDB connection singleton
+let lazyConn = lazy lazyCfg.Force().CreateConnection ()
+/// Application dependencies
+let deps = {
+  new IDependencies with
+    member __.Conn with get () = lazyConn.Force ()
+  }
+
+/// Suave application
+let app : WebPart =
+  choose [
+    GET >=> Files.browseHome
+    GET >=> Files.browseFileHome "index.html"
+    RequestErrors.NOT_FOUND "Page not found." 
+  ]
+let suaveCfg = { defaultConfig with homeFolder = Some (Path.GetFullPath "./wwwroot/") }
+  
+[<EntryPoint>]
+let main argv = 
+  // Establish the data environment
+  liftDep getConn (Data.establishEnvironment >> Async.RunSynchronously)
+  |> run deps
+
+  startWebServer suaveCfg app
+  0 

src/Data.fs

@@ -0,0 +1,130 @@
+namespace MyPrayerJournal
+
+open Chiron
+open RethinkDb.Driver
+open RethinkDb.Driver.Net
+open System
+
+type ConfigParameter =
+  | Hostname of string
+  | Port     of int
+  | AuthKey  of string
+  | Timeout  of int
+  | Database of string
+
+type DataConfig = { Parameters : ConfigParameter list }
+with
+  member this.CreateConnection () : IConnection =
+    let folder (builder : Connection.Builder) block =
+      match block with
+      | Hostname x -> builder.Hostname x
+      | Port     x -> builder.Port     x
+      | AuthKey  x -> builder.AuthKey  x
+      | Timeout  x -> builder.Timeout  x
+      | Database x -> builder.Db       x
+    let bldr =
+      this.Parameters
+      |> Seq.fold folder (RethinkDB.R.Connection ())
+    upcast bldr.Connect()
+  member this.Database =
+    match this.Parameters
+          |> List.filter (fun x -> match x with Database _ -> true | _ -> false)
+          |> List.tryHead with
+    | Some (Database x) -> x
+    | _ -> RethinkDBConstants.DefaultDbName
+  static member FromJson json =
+    match Json.parse json with
+    | Object config ->
+        let options =
+          config
+          |> Map.toList
+          |> List.map (fun item ->
+              match item with
+              | "Hostname", String x -> Hostname x
+              | "Port",     Number x -> Port <| int x
+              | "AuthKey",  String x -> AuthKey x
+              | "Timeout",  Number x -> Timeout <| int x
+              | "Database", String x -> Database x
+              | key, value ->
+                  invalidOp <| sprintf "Unrecognized RethinkDB configuration parameter %s (value %A)" key value)
+        { Parameters = options }
+    | _ -> { Parameters = [] }
+
+
+/// Tables for data storage
+module DataTable =
+  /// The table for prayer requests
+  [<Literal>]
+  let Request = "Request"
+  /// The table for users
+  [<Literal>]
+  let User = "User"
+
+/// Extensions for the RethinkDB connection
+[<RequireQualifiedAccess>]
+module Data =
+  
+  let private r = RethinkDB.R
+
+  /// Set up the environment for MyPrayerJournal
+  let establishEnvironment (conn : IConnection) =
+    /// Shorthand for the database
+    let db () = r.Db "myPrayerJournal"
+    // Be chatty about what we're doing
+    let mkStep = sprintf "[MyPrayerJournal] %s"
+    let logStep = mkStep >> Console.WriteLine
+    let logStepStart = mkStep >> Console.Write
+    let logStepEnd () = Console.WriteLine " done"
+    /// Ensure the database exists
+    let checkDatabase () =
+      async {
+        logStep "|> Checking database"
+        let! dbList = r.DbList().RunResultAsync<string list> conn 
+        match dbList |> List.contains "myPrayerJournal" with
+        | true -> ()
+        | _ ->
+            logStepStart "   Database not found - creating..."
+            do! r.DbCreate("myPrayerJournal").RunResultAsync conn
+            logStepEnd ()
+        }
+    /// Ensure all tables exit
+    let checkTables () =
+      async {
+        logStep "|> Checking tables"
+        let! tables = db().TableList().RunResultAsync<string list> conn
+        [ DataTable.Request; DataTable.User ]
+        |> List.filter (fun tbl -> not (tables |> List.contains tbl))
+        |> List.map (fun tbl ->
+            async {
+              logStepStart <| sprintf "   %s table not found - creating..." tbl
+              do! db().TableCreate(tbl).RunResultAsync conn
+              logStepEnd()
+              })
+        |> List.iter Async.RunSynchronously
+      }
+    /// Ensure the proper indexes exist
+    let checkIndexes () =
+      async {
+        logStep "|> Checking indexes"
+        let! reqIdx = db().Table(DataTable.Request).IndexList().RunResultAsync<string list> conn
+        match reqIdx |> List.contains "UserId" with
+        | true -> ()
+        | _ ->
+            logStepStart <| sprintf "   %s.UserId index not found - creating..." DataTable.Request
+            do! db().Table(DataTable.Request).IndexCreate("UserId").RunResultAsync conn
+            logStepEnd ()
+        let! usrIdx = db().Table(DataTable.User).IndexList().RunResultAsync<string list> conn
+        match usrIdx |> List.contains "Email" with
+        | true -> ()
+        | _ ->
+            logStepStart <| sprintf "   %s.Email index not found - creating..." DataTable.User
+            do! db().Table(DataTable.User).IndexCreate("Email").RunResultAsync conn
+            logStepEnd ()
+        }
+    async {
+      logStep "Database checks starting"
+      do! checkDatabase ()
+      do! checkTables ()
+      do! checkIndexes ()
+      logStep "Database checks complete"
+      }

src/Dependencies.fs

@@ -0,0 +1,48 @@
+namespace MyPrayerJournal
+
+open RethinkDb.Driver.Net
+
+// -- begin code lifted from #er demo --
+type ReaderM<'d, 'out> = 'd -> 'out
+
+module Reader =
+  // basic operations
+  let run dep (rm : ReaderM<_,_>) = rm dep
+  let constant (c : 'c) : ReaderM<_,'c> = fun _ -> c
+  // lifting of functions and state
+  let lift1 (f : 'd -> 'a -> 'out) : 'a -> ReaderM<'d, 'out> = fun a dep -> f dep a
+  let lift2 (f : 'd -> 'a -> 'b -> 'out) : 'a -> 'b -> ReaderM<'d, 'out> = fun a b dep -> f dep a b
+  let lift3 (f : 'd -> 'a -> 'b -> 'c -> 'out) : 'a -> 'b -> 'c -> ReaderM<'d, 'out> = fun a b c dep -> f dep a b c
+  let liftDep (proj : 'd2 -> 'd1) (rm : ReaderM<'d1, 'output>) : ReaderM<'d2, 'output> = proj >> rm
+  // functor
+  let fmap (f : 'a -> 'b) (g : 'c -> 'a) : ('c -> 'b) = g >> f
+  let map (f : 'a -> 'b) (rm : ReaderM<'d, 'a>) : ReaderM<'d,'b> = rm >> f
+  let (<?>) = map
+  // applicative-functor
+  let apply (f : ReaderM<'d, 'a->'b>) (rm : ReaderM<'d, 'a>) : ReaderM<'d, 'b> =
+    fun dep ->
+      let f' = run dep f
+      let a  = run dep rm
+      f' a
+  let (<*>) = apply
+  // monad
+  let bind (rm : ReaderM<'d, 'a>) (f : 'a -> ReaderM<'d,'b>) : ReaderM<'d, 'b> =
+    fun dep ->
+      f (rm dep) 
+      |> run dep 
+  let (>>=) = bind
+  type ReaderMBuilder internal () =
+    member __.Bind(m, f)    = m >>= f
+    member __.Return(v)     = constant v
+    member __.ReturnFrom(v) = v
+    member __.Delay(f)      = f ()
+  let reader = ReaderMBuilder()
+// -- end code lifted from #er demo --
+
+type IDependencies =
+  abstract Conn : IConnection
+
+[<AutoOpen>]
+module DependencyExtraction =
+  
+  let getConn (deps : IDependencies) = deps.Conn

src/Entities.fs

@@ -0,0 +1,74 @@
+namespace MyPrayerJournal
+
+open Newtonsoft.Json
+
+/// A user
+type User = {
+  /// The Id of the user
+  [<JsonProperty("id")>]
+  Id : string
+  /// The user's e-mail address
+  Email : string
+  /// The user's name
+  Name : string
+  /// The time zone in which the user resides
+  TimeZone : string
+  /// The last time the user logged on
+  LastSeenOn : int64
+}
+  with
+    /// An empty User
+    static member Empty =
+      { Id           = ""
+        Email        = ""
+        Name         = ""
+        TimeZone     = ""
+        LastSeenOn   = int64 0 }
+
+
+/// Request history entry
+type History = {
+  /// The instant at which the update was made
+  AsOf : int64
+  /// The action that was taken on the request
+  Action : string list
+  /// The status of the request (filled if it changed)
+  Status : string option
+  /// The text of the request (filled if it changed)
+  Text : string option
+}
+
+/// A prayer request
+type Request = {
+  /// The Id of the request
+  [<JsonProperty("id")>]
+  Id : string
+  /// The Id of the user to whom this request belongs
+  UserId : string
+  /// The instant this request was entered
+  EnteredOn : int64
+  /// The history for this request
+  History : History list
+}
+  with
+    /// The current status of the prayer request
+    member this.Status =
+      this.History
+      |> List.sortBy (fun item -> -item.AsOf)
+      |> List.map    (fun item -> item.Status)
+      |> List.filter Option.isSome
+      |> List.map    Option.get
+      |> List.head
+    /// The current text of the prayer request
+    member this.Text =
+      this.History
+      |> List.sortBy (fun item -> -item.AsOf)
+      |> List.map    (fun item -> item.Text)
+      |> List.filter Option.isSome
+      |> List.map Option.get
+      |> List.head
+    member this.LastActionOn =
+      this.History
+      |> List.sortBy (fun item -> -item.AsOf)
+      |> List.map    (fun item -> item.AsOf)
+      |> List.head

src/Extensions.fs

@@ -0,0 +1,16 @@
+[<AutoOpen>]
+module MyPrayerJournal.Extensions
+
+open System.Threading.Tasks
+
+// H/T: Suave
+type AsyncBuilder with
+  /// An extension method that overloads the standard 'Bind' of the 'async' builder. The new overload awaits on
+  /// a standard .NET task
+  member x.Bind(t : Task<'T>, f:'T -> Async<'R>) : Async<'R> = async.Bind (Async.AwaitTask t, f)
+
+  /// An extension method that overloads the standard 'Bind' of the 'async' builder. The new overload awaits on
+  /// a standard .NET task which does not commpute a value
+  member x.Bind(t : Task, f : unit -> Async<'R>) : Async<'R> = async.Bind (Async.AwaitTask t, f)
+
+  member x.ReturnFrom(t : Task<'T>) : Async<'T> = Async.AwaitTask t

src/Program.fs

@@ -1,22 +0,0 @@
-// Learn more about F# at http://fsharp.org
-
-open System.IO
-open Suave
-open Suave.Filters
-open Suave.Operators
-
-let app : WebPart =
-  choose [
-    //GET >=> path "/" >=> Files.file "index.html"
-    //GET >=> path "" >=> Files.file "index.html"
-    GET >=> Files.browseHome
-    GET >=> Files.browseFileHome "index.html"
-    RequestErrors.NOT_FOUND "Page not found." 
-  ]
-[<EntryPoint>]
-let main argv = 
-  let config =
-    { defaultConfig with homeFolder = Some (Path.GetFullPath "./wwwroot/") }
-
-  startWebServer config app
-  0 // return an integer exit code

src/project.json

@@ -1,30 +1,44 @@
 {
-  "version": "1.0.0-*",
   "buildOptions": {
-    "debugType": "portable",
-    "emitEntryPoint": true,
-    "compilerName": "fsc",
     "compile": {
       "includeFiles": [
-        "Program.fs"
+        "Extensions.fs",
+        "Entities.fs",
+        "Dependencies.fs",
+        "Data.fs",
+        "App.fs"
       ]
-    }
+    },
+    "compilerName": "fsc",
+    "debugType": "portable",
+    "emitEntryPoint": true,
+    "outputName": "myPrayerJournal"
   },
   "dependencies": {
+    "Chiron": "6.2.1",
+    "Newtonsoft.Json": "9.0.1",
+    "RethinkDb.Driver": "2.3.15",
     "Suave": "2.0.0-rc2"
   },
-  "tools": {
-    "dotnet-compile-fsc": "1.0.0-preview2.1-*"
-  },
   "frameworks": {
     "netcoreapp1.1": {
       "dependencies": {
+        "Microsoft.FSharp.Core.netcore": "1.0.0-alpha-161111",
         "Microsoft.NETCore.App": {
           "type": "platform",
           "version": "1.1.0"
-        },
+        }
-        "Microsoft.FSharp.Core.netcore": "1.0.0-alpha-161111"
+      },
-      }
+      "imports": [
+        "portable-net45+win8+dnxcore50",
+        "portable-net45+win8",
+        "net452",
+        "dnxcore50"
+      ]
     }
-  }
+  },
-}
+  "tools": {
+    "dotnet-compile-fsc": "1.0.0-preview2.1-*"
+  },
+  "version": "0.8.1-*"
+}