Skip to content
This repository was archived by the owner on Apr 3, 2024. It is now read-only.

Commit c0bcdc2

Browse files
danieljsummersdanieljsummers
committed
Quatro Step 3 complete
1 parent b36c3ea commit c0bcdc2

File tree

2 files changed

+112
-90
lines changed

2 files changed

+112
-90
lines changed

‎src/4-Freya-FSharp/App.fs‎

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,8 +5,20 @@ open Freya.Machines.Http
55
open Freya.Routers.Uri.Template
66
open Microsoft.AspNetCore.Builder
77
open Microsoft.AspNetCore.Hosting
8+
open Quatro.Reader
9+
open System.IO
810

911
module App =
12+
let lazyCfg = lazy (File.ReadAllText "data-config.json" |> DataConfig.FromJson)
13+
let cfg = lazyCfg.Force()
14+
let deps = {
15+
new IDependencies with
16+
member __.Conn
17+
with get () =
18+
let conn = lazy (cfg.CreateConnection ())
19+
conn.Force()
20+
}
21+
1022
let hello =
1123
freya {
1224
return Represent.text "Hello World from Freya"
@@ -29,6 +41,11 @@ module App =
2941

3042
[<EntryPoint>]
3143
let main _ =
44+
(*let initDb (conn : IConnection) = conn.EstablishEnvironment cfg.Database |> Async.RunSynchronously
45+
let start = liftDep getConn initDb
46+
start |> run deps *)
47+
liftDep getConn (Data.establishEnvironment cfg.Database >> Async.RunSynchronously)
48+
|> run deps
3249
use host = (new WebHostBuilder()).UseKestrel().UseStartup<Startup>().Build()
3350
host.Run()
3451
0

‎src/4-Freya-FSharp/Data.fs‎

Lines changed: 95 additions & 90 deletions
Original file line numberDiff line numberDiff line change
@@ -16,17 +16,23 @@ type ConfigParameter =
1616
type DataConfig = { Parameters : ConfigParameter list }
1717
with
1818
member this.CreateConnection () : IConnection =
19-
let folder (builder : Connection.Builder) (block : ConfigParameter) =
19+
let folder (builder : Connection.Builder) block =
2020
match block with
2121
| Hostname x -> builder.Hostname x
22-
| Port x -> builder.Port x
23-
| AuthKey x -> builder.AuthKey x
24-
| Timeout x -> builder.Timeout x
25-
| Database x -> builder.Db x
22+
| Port x -> builder.Port x
23+
| AuthKey x -> builder.AuthKey x
24+
| Timeout x -> builder.Timeout x
25+
| Database x -> builder.Db x
2626
let bldr =
2727
this.Parameters
28-
|> Seq.fold folder (RethinkDB.R.Connection())
28+
|> Seq.fold folder (RethinkDB.R.Connection ())
2929
upcast bldr.Connect()
30+
member this.Database =
31+
match this.Parameters
32+
|> List.filter (fun x -> match x with Database _ -> true | _ -> false)
33+
|> List.tryHead with
34+
| Some (Database x) -> x
35+
| _ -> RethinkDBConstants.DefaultDbName
3036
static member FromJson json =
3137
match Json.parse json with
3238
| Object config ->
@@ -36,9 +42,9 @@ with
3642
|> List.map (fun item ->
3743
match item with
3844
| "Hostname", String x -> Hostname x
39-
| "Port", Number x -> Port <| int x
40-
| "AuthKey", String x -> AuthKey x
41-
| "Timeout", Number x -> Timeout <| int x
45+
| "Port", Number x -> Port <| int x
46+
| "AuthKey", String x -> AuthKey x
47+
| "Timeout", Number x -> Timeout <| int x
4248
| "Database", String x -> Database x
4349
| key, value ->
4450
raise <| InvalidOperationException
@@ -56,89 +62,88 @@ module Table =
5662
let User = "User"
5763
let WebLog = "WebLog"
5864

59-
[<AutoOpen>]
60-
module DataExtensions =
61-
type IConnection with
62-
member this.EstablishEnvironment database =
63-
let r = RethinkDB.R
64-
let checkDatabase db =
65+
[<RequireQualifiedAccess>]
66+
module Data =
67+
let establishEnvironment database conn =
68+
let r = RethinkDB.R
69+
let checkDatabase db =
70+
async {
71+
match db with
72+
| null
73+
| "" -> ()
74+
| _ -> let! dbs = r.DbList().RunResultAsync<string list> conn
75+
match dbs |> List.contains db with
76+
| true -> ()
77+
| _ -> do! r.DbCreate(db).RunResultAsync conn
78+
}
79+
let checkTables () =
80+
async {
81+
let! existing = r.TableList().RunResultAsync<string list> conn
82+
[ Table.Category; Table.Comment; Table.Page; Table.Post; Table.User; Table.WebLog ]
83+
|> List.filter (fun tbl -> not (existing |> List.contains tbl))
84+
|> List.map (fun tbl -> async { do! r.TableCreate(tbl).RunResultAsync conn })
85+
|> List.iter Async.RunSynchronously
86+
}
87+
let checkIndexes () =
88+
let indexesFor tbl = async { return! r.Table(tbl).IndexList().RunResultAsync<string list> conn }
89+
let checkCategoryIndexes () =
90+
async {
91+
let! indexes = indexesFor Table.Category
92+
match indexes |> List.contains "WebLogId" with
93+
| true -> ()
94+
| _ -> do! r.Table(Table.Category).IndexCreate("WebLogId").RunResultAsync conn
95+
match indexes |> List.contains "WebLogAndSlug" with
96+
| true -> ()
97+
| _ -> do! r.Table(Table.Category)
98+
.IndexCreate("WebLogAndSlug", ReqlFunction1 (fun row -> upcast r.Array (row.["WebLogId"], row.["Slug"])))
99+
.RunResultAsync conn
100+
}
101+
let checkCommentIndexes () =
102+
async {
103+
let! indexes = indexesFor Table.Comment
104+
match indexes |> List.contains "PostId" with
105+
| true -> ()
106+
| _ -> do! r.Table(Table.Comment).IndexCreate("PostId").RunResultAsync conn
107+
}
108+
let checkPageIndexes () =
65109
async {
66-
match db with
67-
| null
68-
| "" -> ()
69-
| _ -> let! dbs = r.DbList().RunResultAsync<string list> this
70-
match dbs |> List.contains db with
71-
| true -> ()
72-
| _ -> do! r.DbCreate(db).RunResultAsync this
73-
}
74-
let checkTables () =
110+
let! indexes = indexesFor Table.Page
111+
match indexes |> List.contains "WebLogId" with
112+
| true -> ()
113+
| _ -> do! r.Table(Table.Page).IndexCreate("WebLogId").RunResultAsync conn
114+
match indexes |> List.contains "WebLogAndPermalink" with
115+
| true -> ()
116+
| _ -> do! r.Table(Table.Page)
117+
.IndexCreate("WebLogAndPermalink",
118+
ReqlFunction1(fun row -> upcast r.Array(row.["WebLogId"], row.["Permalink"])))
119+
.RunResultAsync conn
120+
}
121+
let checkPostIndexes () =
75122
async {
76-
let! existing = r.TableList().RunResultAsync<string list> this
77-
[ Table.Category; Table.Comment; Table.Page; Table.Post; Table.User; Table.WebLog ]
78-
|> List.filter (fun tbl -> not (existing |> List.contains tbl))
79-
|> List.map (fun tbl -> async { do! r.TableCreate(tbl).RunResultAsync this })
80-
|> List.iter Async.RunSynchronously
81-
}
82-
let checkIndexes () =
83-
let indexesFor tbl = async { return! r.Table(tbl).IndexList().RunResultAsync<string list> this }
84-
let checkCategoryIndexes () =
85-
async {
86-
let! indexes = indexesFor Table.Category
87-
match indexes |> List.contains "WebLogId" with
88-
| true -> ()
89-
| _ -> do! r.Table(Table.Category).IndexCreate("WebLogId").RunResultAsync this
90-
match indexes |> List.contains "WebLogAndSlug" with
91-
| true -> ()
92-
| _ -> do! r.Table(Table.Category)
93-
.IndexCreate("WebLogAndSlug", ReqlFunction1(fun row -> upcast r.Array(row.["WebLogId"], row.["Slug"])))
94-
.RunResultAsync this
95-
}
96-
let checkCommentIndexes () =
97-
async {
98-
let! indexes = indexesFor Table.Comment
99-
match indexes |> List.contains "PostId" with
100-
| true -> ()
101-
| _ -> do! r.Table(Table.Comment).IndexCreate("PostId").RunResultAsync this
102-
}
103-
let checkPageIndexes () =
104-
async {
105-
let! indexes = indexesFor Table.Page
106-
match indexes |> List.contains "WebLogId" with
107-
| true -> ()
108-
| _ -> do! r.Table(Table.Page).IndexCreate("WebLogId").RunResultAsync this
109-
match indexes |> List.contains "WebLogAndPermalink" with
110-
| true -> ()
111-
| _ -> do! r.Table(Table.Page)
112-
.IndexCreate("WebLogAndPermalink",
113-
ReqlFunction1(fun row -> upcast r.Array(row.["WebLogId"], row.["Permalink"])))
114-
.RunResultAsync this
115-
}
116-
let checkPostIndexes () =
117-
async {
118-
let! indexes = indexesFor Table.Post
119-
match indexes |> List.contains "WebLogId" with
120-
| true -> ()
121-
| _ -> do! r.Table(Table.Post).IndexCreate("WebLogId").RunResultAsync this
122-
match indexes |> List.contains "Tags" with
123-
| true -> ()
124-
| _ -> do! r.Table(Table.Post).IndexCreate("Tags").OptArg("multi", true).RunResultAsync this
125-
}
126-
let checkUserIndexes () =
127-
async {
128-
let! indexes = indexesFor Table.User
129-
match indexes |> List.contains "EmailAddress" with
130-
| true -> ()
131-
| _ -> do! r.Table(Table.User).IndexCreate("EmailAddress").RunResultAsync this
132-
}
123+
let! indexes = indexesFor Table.Post
124+
match indexes |> List.contains "WebLogId" with
125+
| true -> ()
126+
| _ -> do! r.Table(Table.Post).IndexCreate("WebLogId").RunResultAsync conn
127+
match indexes |> List.contains "Tags" with
128+
| true -> ()
129+
| _ -> do! r.Table(Table.Post).IndexCreate("Tags").OptArg("multi", true).RunResultAsync conn
130+
}
131+
let checkUserIndexes () =
133132
async {
134-
do! checkCategoryIndexes ()
135-
do! checkCommentIndexes ()
136-
do! checkPageIndexes ()
137-
do! checkPostIndexes ()
138-
do! checkUserIndexes ()
139-
}
133+
let! indexes = indexesFor Table.User
134+
match indexes |> List.contains "EmailAddress" with
135+
| true -> ()
136+
| _ -> do! r.Table(Table.User).IndexCreate("EmailAddress").RunResultAsync conn
137+
}
140138
async {
141-
do! checkDatabase database
142-
do! checkTables ()
143-
do! checkIndexes ()
139+
do! checkCategoryIndexes ()
140+
do! checkCommentIndexes ()
141+
do! checkPageIndexes ()
142+
do! checkPostIndexes ()
143+
do! checkUserIndexes ()
144144
}
145+
async {
146+
do! checkDatabase database
147+
do! checkTables ()
148+
do! checkIndexes ()
149+
}

0 commit comments

Comments
 (0)