Move DU members to modules

This commit is contained in:
Daniel J. Summers 2019-07-27 20:02:01 -05:00
parent 7fb6bc463e
commit 221d95a2e2
4 changed files with 41 additions and 46 deletions

View File

@ -2,37 +2,36 @@
open FSharp.Control.Tasks.V2.ContextInsensitive open FSharp.Control.Tasks.V2.ContextInsensitive
open Microsoft.FSharpLu open Microsoft.FSharpLu
open Newtonsoft.Json open Newtonsoft.Json
open Raven.Client.Documents
open Raven.Client.Documents.Indexes open Raven.Client.Documents.Indexes
open Raven.Client.Documents.Linq
open System open System
open System.Collections.Generic open System.Collections.Generic
open Raven.Client.Documents.Linq
open Raven.Client.Documents
/// JSON converter for request IDs /// JSON converter for request IDs
type RequestIdJsonConverter() = type RequestIdJsonConverter () =
inherit JsonConverter<RequestId>() inherit JsonConverter<RequestId> ()
override __.WriteJson(writer : JsonWriter, value : RequestId, _ : JsonSerializer) = override __.WriteJson(writer : JsonWriter, value : RequestId, _ : JsonSerializer) =
(string >> writer.WriteValue) value (RequestId.toString >> writer.WriteValue) value
override __.ReadJson(reader: JsonReader, _ : Type, _ : RequestId, _ : bool, _ : JsonSerializer) = override __.ReadJson(reader: JsonReader, _ : Type, _ : RequestId, _ : bool, _ : JsonSerializer) =
(string >> RequestId.fromIdString) reader.Value (string >> RequestId.fromIdString) reader.Value
/// JSON converter for user IDs /// JSON converter for user IDs
type UserIdJsonConverter() = type UserIdJsonConverter () =
inherit JsonConverter<UserId>() inherit JsonConverter<UserId> ()
override __.WriteJson(writer : JsonWriter, value : UserId, _ : JsonSerializer) = override __.WriteJson(writer : JsonWriter, value : UserId, _ : JsonSerializer) =
(string >> writer.WriteValue) value (UserId.toString >> writer.WriteValue) value
override __.ReadJson(reader: JsonReader, _ : Type, _ : UserId, _ : bool, _ : JsonSerializer) = override __.ReadJson(reader: JsonReader, _ : Type, _ : UserId, _ : bool, _ : JsonSerializer) =
(string >> UserId) reader.Value (string >> UserId) reader.Value
/// JSON converter for Ticks /// JSON converter for Ticks
type TicksJsonConverter() = type TicksJsonConverter () =
inherit JsonConverter<Ticks>() inherit JsonConverter<Ticks> ()
override __.WriteJson(writer : JsonWriter, value : Ticks, _ : JsonSerializer) = override __.WriteJson(writer : JsonWriter, value : Ticks, _ : JsonSerializer) =
writer.WriteValue (value.toLong ()) (Ticks.toLong >> writer.WriteValue) value
override __.ReadJson(reader: JsonReader, _ : Type, _ : Ticks, _ : bool, _ : JsonSerializer) = override __.ReadJson(reader: JsonReader, _ : Type, _ : Ticks, _ : bool, _ : JsonSerializer) =
(string >> int64 >> Ticks) reader.Value (string >> int64 >> Ticks) reader.Value
@ -72,7 +71,6 @@ module Extensions =
open Raven.Client.Documents.Commands.Batches open Raven.Client.Documents.Commands.Batches
open Raven.Client.Documents.Operations open Raven.Client.Documents.Operations
open Raven.Client.Documents.Session open Raven.Client.Documents.Session
open System
/// Format an RQL query by a strongly-typed index /// Format an RQL query by a strongly-typed index
let fromIndex (typ : Type) = let fromIndex (typ : Type) =
@ -98,12 +96,12 @@ module Extensions =
/// Add a history entry /// Add a history entry
member this.AddHistory (reqId : RequestId) (hist : History) = member this.AddHistory (reqId : RequestId) (hist : History) =
listPush "history" (string reqId) hist listPush "history" (RequestId.toString reqId) hist
|> this.Advanced.Defer |> this.Advanced.Defer
/// Add a note /// Add a note
member this.AddNote (reqId : RequestId) (note : Note) = member this.AddNote (reqId : RequestId) (note : Note) =
listPush "notes" (string reqId) note listPush "notes" (RequestId.toString reqId) note
|> this.Advanced.Defer |> this.Advanced.Defer
/// Add a request /// Add a request
@ -114,20 +112,20 @@ module Extensions =
// TODO: not right // TODO: not right
member this.AnsweredRequests (userId : UserId) = member this.AnsweredRequests (userId : UserId) =
sprintf "%s where userId = '%s' and lastStatus = 'Answered' order by asOf as long desc" sprintf "%s where userId = '%s' and lastStatus = 'Answered' order by asOf as long desc"
(fromIndex typeof<Requests_AsJournal>) (string userId) (fromIndex typeof<Requests_AsJournal>) (UserId.toString userId)
|> this.Advanced.AsyncRawQuery<JournalRequest> |> this.Advanced.AsyncRawQuery<JournalRequest>
/// Retrieve the user's current journal /// Retrieve the user's current journal
// TODO: probably not right either // TODO: probably not right either
member this.JournalByUserId (userId : UserId) = member this.JournalByUserId (userId : UserId) =
sprintf "%s where userId = '%s' and lastStatus <> 'Answered' order by showAfter as long" sprintf "%s where userId = '%s' and lastStatus <> 'Answered' order by showAfter as long"
(fromIndex typeof<Requests_AsJournal>) (string userId) (fromIndex typeof<Requests_AsJournal>) (UserId.toString userId)
|> this.Advanced.AsyncRawQuery<JournalRequest> |> this.Advanced.AsyncRawQuery<JournalRequest>
/// Retrieve a request, including its history and notes, by its ID and user ID /// Retrieve a request, including its history and notes, by its ID and user ID
member this.TryFullRequestById (reqId : RequestId) userId = member this.TryFullRequestById (reqId : RequestId) userId =
task { task {
let! req = this.LoadAsync (string reqId) let! req = RequestId.toString reqId |> this.LoadAsync
match Option.fromObject req with match Option.fromObject req with
| Some r when r.userId = userId -> return Some r | Some r when r.userId = userId -> return Some r
| _ -> return None | _ -> return None
@ -154,7 +152,7 @@ module Extensions =
task { task {
let! req = let! req =
this.Query<Request, Requests_AsJournal>() this.Query<Request, Requests_AsJournal>()
.Where(fun x -> x.Id = (string reqId) && x.userId = userId) .Where(fun x -> x.Id = (RequestId.toString reqId) && x.userId = userId)
.ProjectInto<JournalRequest>() .ProjectInto<JournalRequest>()
.FirstOrDefaultAsync () .FirstOrDefaultAsync ()
return Option.fromObject req return Option.fromObject req
@ -166,19 +164,19 @@ module Extensions =
r.Script <- "this.recurType = args.Type; this.recurCount = args.Count" r.Script <- "this.recurType = args.Type; this.recurCount = args.Count"
r.Values.["Type"] <- string recurType r.Values.["Type"] <- string recurType
r.Values.["Count"] <- recurCount r.Values.["Count"] <- recurCount
PatchCommandData (string reqId, null, r, null) |> this.Advanced.Defer PatchCommandData (RequestId.toString reqId, null, r, null) |> this.Advanced.Defer
/// Update the "show after" timestamp for a request /// Update the "show after" timestamp for a request
member this.UpdateShowAfter (reqId : RequestId) (showAfter : Ticks) = member this.UpdateShowAfter (reqId : RequestId) (showAfter : Ticks) =
fieldUpdate "showAfter" (string reqId) (showAfter.toLong ()) fieldUpdate "showAfter" (RequestId.toString reqId) (Ticks.toLong showAfter)
|> this.Advanced.Defer |> this.Advanced.Defer
/// Update a snoozed request /// Update a snoozed request
member this.UpdateSnoozed (reqId : RequestId) (until : Ticks) = member this.UpdateSnoozed (reqId : RequestId) (until : Ticks) =
let r = PatchRequest() let r = PatchRequest()
r.Script <- "this.snoozedUntil = args.Item; this.showAfter = args.Item" r.Script <- "this.snoozedUntil = args.Item; this.showAfter = args.Item"
r.Values.["Item"] <- until.toLong () r.Values.["Item"] <- Ticks.toLong until
PatchCommandData (string reqId, null, r, null) |> this.Advanced.Defer PatchCommandData (RequestId.toString reqId, null, r, null) |> this.Advanced.Defer

View File

@ -5,35 +5,35 @@ module MyPrayerJournal.Domain
/// A Collision-resistant Unique IDentifier /// A Collision-resistant Unique IDentifier
type Cuid = type Cuid =
| Cuid of string | Cuid of string
with module Cuid =
/// The string value of the CUID /// The string value of the CUID
override x.ToString () = match x with Cuid y -> y let toString x = match x with Cuid y -> y
/// Request ID is a CUID /// Request ID is a CUID
type RequestId = type RequestId =
| RequestId of Cuid | RequestId of Cuid
with module RequestId =
/// The string representation of the request ID /// The string representation of the request ID
override x.ToString () = match x with RequestId y -> (string >> sprintf "Requests/%s") y let toString x = match x with RequestId y -> (Cuid.toString >> sprintf "Requests/%s") y
/// Create a request ID from a string representation /// Create a request ID from a string representation
static member fromIdString (y : string) = (Cuid >> RequestId) <| y.Replace("Requests/", "") let fromIdString (y : string) = (Cuid >> RequestId) <| y.Replace("Requests/", "")
/// User ID is a string (the "sub" part of the JWT) /// User ID is a string (the "sub" part of the JWT)
type UserId = type UserId =
| UserId of string | UserId of string
with module UserId =
/// The string representation of the user ID /// The string representation of the user ID
override x.ToString () = match x with UserId y -> y let toString x = match x with UserId y -> y
/// A long integer representing seconds since the epoch /// A long integer representing seconds since the epoch
type Ticks = type Ticks =
| Ticks of int64 | Ticks of int64
with module Ticks =
/// The int64 (long) representation of ticks /// The int64 (long) representation of ticks
member x.toLong () = match x with Ticks y -> y let toLong x = match x with Ticks y -> y
/// How frequently a request should reappear after it is marked "Prayed" /// How frequently a request should reappear after it is marked "Prayed"
@ -42,16 +42,16 @@ type Recurrence =
| Hours | Hours
| Days | Days
| Weeks | Weeks
with module Recurrence =
/// The string reprsentation used in the database and the web app /// The string reprsentation used in the database and the web app
override x.ToString () = let toString x =
match x with match x with
| Immediate -> "immediate" | Immediate -> "immediate"
| Hours -> "hours" | Hours -> "hours"
| Days -> "days" | Days -> "days"
| Weeks -> "weeks" | Weeks -> "weeks"
/// Create a recurrence value from a string /// Create a recurrence value from a string
static member fromString x = let fromString x =
match x with match x with
| "immediate" -> Immediate | "immediate" -> Immediate
| "hours" -> Hours | "hours" -> Hours
@ -59,7 +59,7 @@ with
| "weeks" -> Weeks | "weeks" -> Weeks
| _ -> invalidOp (sprintf "%s is not a valid recurrence" x) | _ -> invalidOp (sprintf "%s is not a valid recurrence" x)
/// The duration of the recurrence /// The duration of the recurrence
member x.duration = let duration x =
match x with match x with
| Immediate -> 0L | Immediate -> 0L
| Hours -> 3600000L | Hours -> 3600000L

View File

@ -44,10 +44,6 @@ module private Helpers =
open System.Threading.Tasks open System.Threading.Tasks
open System.Security.Claims open System.Security.Claims
/// Get the database context from DI
// let db (ctx : HttpContext) =
// ctx.GetService<AppDbContext> ()
/// Create a RavenDB session /// Create a RavenDB session
let session (ctx : HttpContext) = let session (ctx : HttpContext) =
ctx.GetService<IDocumentStore>().OpenAsyncSession () ctx.GetService<IDocumentStore>().OpenAsyncSession ()
@ -62,7 +58,7 @@ module private Helpers =
((user >> Option.get) ctx).Value |> UserId ((user >> Option.get) ctx).Value |> UserId
/// Create a request ID from a string /// Create a request ID from a string
let toReqId = Domain.Cuid >> RequestId let toReqId = Cuid >> RequestId
/// Return a 201 CREATED response /// Return a 201 CREATED response
let created next ctx = let created next ctx =
@ -170,7 +166,7 @@ module Request =
let now = jsNow () let now = jsNow ()
do! sess.AddRequest do! sess.AddRequest
{ Request.empty with { Request.empty with
Id = string reqId Id = RequestId.toString reqId
userId = usrId userId = usrId
enteredOn = now enteredOn = now
showAfter = now showAfter = now
@ -209,7 +205,8 @@ module Request =
|> sess.AddHistory reqId |> sess.AddHistory reqId
match hist.status with match hist.status with
| "Prayed" -> | "Prayed" ->
(Ticks >> sess.UpdateShowAfter reqId) <| now.toLong () + (req.recurType.duration * int64 req.recurCount) (Ticks.toLong now) + (Recurrence.duration req.recurType * int64 req.recurCount)
|> (Ticks >> sess.UpdateShowAfter reqId)
| _ -> () | _ -> ()
do! sess.SaveChangesAsync () do! sess.SaveChangesAsync ()
return! created next ctx return! created next ctx

View File

@ -14,7 +14,7 @@ module Configure =
cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath) cfg.SetBasePath(ctx.HostingEnvironment.ContentRootPath)
.AddJsonFile("appsettings.json", optional = true, reloadOnChange = true) .AddJsonFile("appsettings.json", optional = true, reloadOnChange = true)
.AddJsonFile(sprintf "appsettings.%s.json" ctx.HostingEnvironment.EnvironmentName) .AddJsonFile(sprintf "appsettings.%s.json" ctx.HostingEnvironment.EnvironmentName)
.AddEnvironmentVariables() .AddEnvironmentVariables ()
|> ignore |> ignore
open Microsoft.AspNetCore.Server.Kestrel.Core open Microsoft.AspNetCore.Server.Kestrel.Core
@ -46,7 +46,7 @@ module Configure =
/// Configure dependency injection /// Configure dependency injection
let services (sc : IServiceCollection) = let services (sc : IServiceCollection) =
use sp = sc.BuildServiceProvider() use sp = sc.BuildServiceProvider ()
let cfg = sp.GetRequiredService<IConfiguration> () let cfg = sp.GetRequiredService<IConfiguration> ()
sc.AddGiraffe() sc.AddGiraffe()
.AddAuthentication( .AddAuthentication(
@ -61,7 +61,7 @@ module Configure =
opts.Authority <- sprintf "https://%s/" jwtCfg.["Domain"] opts.Authority <- sprintf "https://%s/" jwtCfg.["Domain"]
opts.Audience <- jwtCfg.["Id"]) opts.Audience <- jwtCfg.["Id"])
|> ignore |> ignore
sc.AddSingleton<IJsonSerializer>(NewtonsoftJsonSerializer jsonSettings) sc.AddSingleton<IJsonSerializer> (NewtonsoftJsonSerializer jsonSettings)
|> ignore |> ignore
let config = sc.BuildServiceProvider().GetRequiredService<IConfiguration>().GetSection "RavenDB" let config = sc.BuildServiceProvider().GetRequiredService<IConfiguration>().GetSection "RavenDB"
let store = new DocumentStore () let store = new DocumentStore ()