Version 3 #67

Merged
danieljsummers merged 53 commits from version-3 into master 2021-10-26 23:39:59 +00:00
4 changed files with 144 additions and 44 deletions
Showing only changes of commit f86ca395a4 - Show all commits

View File

@ -99,12 +99,14 @@ module Startup =
[<AutoOpen>]
module private Helpers =
/// Async wrapper around a LiteDB query that returns multiple results
let doListQuery<'T> (q : ILiteQueryable<'T>) =
q.ToList () |> Task.FromResult
open System.Linq
/// Async wrapper around a LiteDB query that returns 0 or 1 results
let doSingleQuery<'T> (q : ILiteQueryable<'T>) =
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
let toListAsync<'T> (q : 'T seq) =
(q.ToList >> Task.FromResult) ()
/// Convert a sequence to a list asynchronously (used for LiteDB IO)
let firstAsync<'T> (q : 'T seq) =
q.FirstOrDefault () |> Task.FromResult
/// Async wrapper around a request update
@ -142,8 +144,8 @@ module private Helpers =
/// Retrieve a request, including its history and notes, by its ID and user ID
let tryFullRequestById reqId userId (db : LiteDatabase) = task {
let! req = doSingleQuery (db.requests.Query().Where (fun it -> it.id = reqId && it.userId = userId))
return match box req with null -> None | _ -> Some req
let! req = db.requests.Find (Query.EQ ("_id", RequestId.toString reqId |> BsonValue)) |> firstAsync
return match box req with null -> None | _ when req.userId = userId -> Some req | _ -> None
}
/// Add a history entry
@ -166,7 +168,7 @@ let addRequest (req : Request) (db : LiteDatabase) =
/// Retrieve all answered requests for the given user
let answeredRequests userId (db : LiteDatabase) = task {
let! reqs = doListQuery (db.requests.Query().Where(fun req -> req.userId = userId))
let! reqs = db.requests.Find (Query.EQ ("userId", UserId.toString userId |> BsonValue)) |> toListAsync
return
reqs
|> Seq.map toJournalFull
@ -177,7 +179,7 @@ let answeredRequests userId (db : LiteDatabase) = task {
/// Retrieve the user's current journal
let journalByUserId userId (db : LiteDatabase) = task {
let! jrnl = doListQuery (db.requests.Query().Where(fun req -> req.userId = userId))
let! jrnl = db.requests.Find (Query.EQ ("userId", UserId.toString userId |> BsonValue)) |> toListAsync
return
jrnl
|> Seq.map toJournalLite

View File

@ -61,7 +61,6 @@ module Error =
open Cuid
open LiteDB
open System.Security.Claims
open Microsoft.Extensions.Logging
/// Handler helpers
[<AutoOpen>]
@ -188,7 +187,6 @@ module Components =
authorize
>=> fun next ctx -> task {
let! jrnl = Data.journalByUserId (userId ctx) (db ctx)
do! System.Threading.Tasks.Task.Delay (TimeSpan.FromSeconds 5.)
return! renderComponent [ Views.Journal.journalItems jrnl ] next ctx
}
@ -201,19 +199,11 @@ module Home =
withMenuRefresh >=> partialIfNotRefresh Views.Home.home
/// /api/journal and /journal URLs
/// /journal URL
module Journal =
/// GET /api/journal
let journal : HttpHandler =
authorize
>=> fun next ctx -> task {
let! jrnl = Data.journalByUserId (userId ctx) (db ctx)
return! json jrnl next ctx
}
// GET /journal
let journalPage : HttpHandler =
let journal : HttpHandler =
authorize
>=> withMenuRefresh
>=> fun next ctx -> task {
@ -222,18 +212,19 @@ module Journal =
}
/// Legalese
/// /legal URLs
module Legal =
// GET /legal/privacy-policy
let privacyPolicy : HttpHandler =
withMenuRefresh >=> partialIfNotRefresh Views.Legal.privacyPolicy
// GET /legal/terms-of-service
let termsOfService : HttpHandler =
withMenuRefresh >=> partialIfNotRefresh Views.Legal.termsOfService
/// /api/request URLs
/// /api/request and /request(s) URLs
module Request =
/// POST /api/request
@ -311,12 +302,22 @@ module Request =
| None -> return! Error.notFound next ctx
}
/// GET /api/requests/answered
/// GET /requests/active
let active : HttpHandler =
authorize
>=> withMenuRefresh
>=> fun next ctx -> task {
let! reqs = Data.journalByUserId (userId ctx) (db ctx)
return! partialIfNotRefresh (Views.Request.active reqs) next ctx
}
/// GET /requests/answered
let answered : HttpHandler =
authorize
>=> withMenuRefresh
>=> fun next ctx -> task {
let! reqs = Data.answeredRequests (userId ctx) (db ctx)
return! json reqs next ctx
return! partialIfNotRefresh (Views.Request.answered reqs) next ctx
}
/// GET /api/request/[req-id]
@ -396,6 +397,7 @@ module Request =
| None -> return! Error.notFound next ctx
}
open Giraffe.EndpointRouting
/// The routes for myPrayerJournal
@ -405,16 +407,18 @@ let routes =
route "journal-items" Components.journalItems
route "nav-items" Components.navItems
]
route "/journal" Journal.journalPage
route "/journal" Journal.journal
subRoute "/legal/" [
route "privacy-policy" Legal.privacyPolicy
route "terms-of-service" Legal.termsOfService
]
subRoute "/request" [
route "s/active" Request.active
route "s/answered" Request.answered
]
subRoute "/api/" [
GET [
route "journal" Journal.journal
subRoute "request" [
route "s/answered" Request.answered
routef "/%s/full" Request.getFull
routef "/%s/notes" Request.getNotes
routef "/%s" Request.get

View File

@ -4,8 +4,24 @@ open Giraffe.ViewEngine
open Giraffe.ViewEngine.Htmx
open System
/// Target the `main` tag with boosted links
let toMain = _hxTarget "main"
[<AutoOpen>]
module Helpers =
/// Target the `main` tag with boosted links
let toMain = _hxTarget "main"
/// Create a Material icon
let icon name = span [ _class "material-icons" ] [ str name ]
/// Create a card when there are no results found
let noResults heading link buttonText text =
div [ _class "card" ] [
h5 [ _class "card-header"] [ str heading ]
div [ _class "card-body text-center" ] [
p [ _class "card-text" ] text
a [ _class "btn btn-primary"; _href link; _hxBoost; toMain ] [ str buttonText ]
]
]
/// View for home page
module Home =
@ -227,23 +243,97 @@ module Journal =
let journalItems items =
match items |> List.isEmpty with
| true ->
div [ _class "card no-requests" ] [
h5 [ _class "card-header"] [ str "No Active Requests" ]
div [ _class "card-body text-center" ] [
p [ _class "card-text" ] [
rawText "You have no requests to be shown; see the &ldquo;Active&rdquo; link above for snoozed or "
rawText "deferred requests, and the &ldquo;Answered&rdquo; link for answered requests"
]
a [
_class "btn btn-primary"
_href "/request/new/edit"
_hxBoost; toMain
] [ str "Add a Request" ]
]
noResults "No Active Requests" "/request/new/edit" "Add a Request" [
rawText "You have no requests to be shown; see the &ldquo;Active&rdquo; link above for snoozed or "
rawText "deferred requests, and the &ldquo;Answered&rdquo; link for answered requests"
]
| false -> p [] [ str "There are requests" ]
/// Views for request pages and components
module Request =
/// Create a request within the list
let reqListItem req =
let jsNow = int64 (DateTime.UtcNow - DateTime.UnixEpoch).TotalMilliseconds
let reqId = RequestId.toString req.requestId
let isAnswered = req.lastStatus = Answered
let isSnoozed = Ticks.toLong req.snoozedUntil > jsNow
let isPending = (not isSnoozed) && Ticks.toLong req.showAfter > jsNow
let btnClass = _class "btn btn-light"
tr [] [
td [ _class "action-cell" ] [
div [ _class "btn-group btn-group-sm"; Accessibility._roleGroup ] [
a [ btnClass; _href $"/request/{reqId}/full"; _title "View Full Request" ] [ icon "description" ]
if not isAnswered then
a [ btnClass; _href $"/request/{reqId}/edit"; _title "Edit Request" ] [ icon "edit" ]
// TODO: these next two should use hx-patch, targeting replacement of this tr when complete
if isSnoozed then
a [ btnClass; _href $"/request/{reqId}/cancel-snooze"; _title "Cancel Snooze" ] [ icon "restore" ]
if isPending then
a [ btnClass; _href $"/request/{reqId}/show-now"; _title "Show Now" ] [ icon "restore" ]
]
]
td [] [
p [ _class "mpj-request-text mb-0" ] [
str req.text
if isSnoozed || isPending || isAnswered then
br []
small [ _class "text-muted" ] [
em [] [
if isSnoozed then str "Snooze expires date-from-now(value='request.snoozedUntil')"
if isPending then str "Request appears next date-from-now(:value='request.showAfter')"
if isAnswered then str "Answered date-from-now(:value='request.asOf')"
]
]
]
]
]
/// Create a list of requests
let reqList reqs =
table [ _class "table table-hover table-sm align-top" ] [
thead [] [
tr [] [
th [ _scope "col" ] [ str "Actions" ]
th [ _scope "col" ] [ str "Request" ]
]
]
reqs
|> List.map reqListItem
|> tbody []
]
/// View for Active Requests page
let active reqs = article [] [
h2 [] [ str "Active Requests" ]
match reqs |> List.isEmpty with
| true ->
noResults "No Active Requests" "/journal" "Return to your journal"
[ str "Your prayer journal has no active requests" ]
| false -> reqList reqs
]
/// View for Answered Requests page
let answered reqs = article [] [
h2 [] [ str "Answered Requests" ]
match reqs |> List.isEmpty with
| true ->
noResults "No Active Requests" "/journal" "Return to your journal" [
rawText "Your prayer journal has no answered requests; once you have marked one as &ldquo;Answered&rdquo;, "
str "it will appear here"
]
| false -> reqList reqs
]
/// View for Snoozed Requests page
let snoozed reqs = article [] [
h2 [] [ str "Snoozed Requests" ]
reqList reqs
]
/// Layout views
module Layout =
@ -255,7 +345,8 @@ module Layout =
_integrity "sha384-EVSTQN3/azprG1Anm3QDgpJLIm9Nao0Yz1ztcQTwFspd3yD65VohhpuuCOmLASjC"
_crossorigin "anonymous"
]
link [ _href "/style/style.css"; _rel "stylesheet" ]
link [ _href "https://fonts.googleapis.com/icon?family=Material+Icons"; _rel "stylesheet" ]
link [ _href "/style/style.css"; _rel "stylesheet" ]
script [
_src "https://unpkg.com/htmx.org@1.5.0"
_integrity "sha384-oGA+prIp5Vchu6we2YkI51UtVzN9Jpx2Z7PnR1I78PnZlN8LkrCT4lqqqmDkyrvI"

View File

@ -26,6 +26,9 @@ nav .j {
.navbar-nav .is-active-route {
background-color: rgba(255, 255, 255, .2);
}
.action-cell .material-icons {
font-size: 1.1rem ;
}
footer {
border-top: solid 1px lightgray;