Skip to content

Commit bacf99d

Browse files
willia4willia4
committed
Refactored the individual item pages into a common function
1 parent f029735 commit bacf99d

File tree

6 files changed

+113
-91
lines changed

6 files changed

+113
-91
lines changed

‎src/ElectricLemur.Muscadine.Site/ElectricLemur.Muscadine.Site.fsproj‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -45,6 +45,7 @@
4545
<Compile Include="Project.fs" />
4646
<Compile Include="Debug.fs" />
4747
<Compile Include="FrontendHelpers.fs" />
48+
<Compile Include="ItemHelper.fs" />
4849
<Compile Include="FrontendColophon.fs" />
4950
<Compile Include="FrontendBook.fs" />
5051
<Compile Include="FrontendProject.fs" />

‎src/ElectricLemur.Muscadine.Site/FrontendBook.fs‎

Lines changed: 1 addition & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -102,33 +102,4 @@ module Handlers =
102102
return! htmlView pageHtml next ctx
103103
}
104104

105-
let GET_itemPage slug : HttpHandler =
106-
fun next (ctx: HttpContext) -> task {
107-
let! item = Items.tryLookupBySlug slug Book.documentType Book.makeModelFromJObject ctx
108-
109-
let! content =
110-
item
111-
|> Option.map (fun item ->
112-
let icon = match item.CoverImagePaths with
113-
| Some paths -> Image.Icon.Image paths
114-
| None -> Items.getDefaultIcon Book.documentType
115-
116-
icon, item)
117-
|> Option.mapAsync (fun (icon, item) -> task {
118-
let! microblogEntries = Microblog.loadMicroblogsForDocument Book.documentType item.Id ctx
119-
return (icon, microblogEntries, item)
120-
})
121-
|> Task.bind (Option.mapAsync (fun (icon, microblogEntries, item) -> task {
122-
let! tags = Tag.loadTagsForDocument Book.documentType item.Id ctx
123-
return (icon, tags, microblogEntries, item)
124-
}))
125-
|> Task.map (Option.map (fun (icon, tags, microblogEntries, item) ->
126-
FrontendHelpers.makeItemPage item.Title item.Description icon tags microblogEntries ctx))
127-
128-
match content with
129-
| None -> return! (setStatusCode 404 >=> text "Page not found") next ctx
130-
| Some content ->
131-
let pageHtml = FrontendHelpers.layout FrontendHelpers.PageDefinitions.Books content [ "frontend/item_page.scss" ] ctx
132-
return! (htmlView pageHtml next ctx)
133-
134-
}
105+
let GET_itemPage slug : HttpHandler = ItemHelper.Handlers.GET_itemPage Book.documentType slug

‎src/ElectricLemur.Muscadine.Site/FrontendGame.fs‎

Lines changed: 1 addition & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -103,33 +103,4 @@ module Handlers =
103103
return! htmlView pageHtml next ctx
104104
}
105105

106-
let GET_itemPage slug : HttpHandler =
107-
fun next (ctx: HttpContext) -> task {
108-
let! item = Items.tryLookupBySlug slug Game.documentType Game.makeModelFromJObject ctx
109-
110-
let! content =
111-
item
112-
|> Option.map (fun item ->
113-
let icon = match item.CoverImagePaths with
114-
| Some paths -> Image.Icon.Image paths
115-
| None -> Items.getDefaultIcon Game.documentType
116-
117-
icon, item)
118-
|> Option.mapAsync (fun (icon, item) -> task {
119-
let! microblogEntries = Microblog.loadMicroblogsForDocument Game.documentType item.Id ctx
120-
return (icon, microblogEntries, item)
121-
})
122-
|> Task.bind (Option.mapAsync (fun (icon, microblogEntries, item) -> task {
123-
let! tags = Tag.loadTagsForDocument Game.documentType item.Id ctx
124-
return (icon, tags, microblogEntries, item)
125-
}))
126-
|> Task.map (Option.map (fun (icon, tags, microblogEntries, item) ->
127-
FrontendHelpers.makeItemPage item.Name item.Description icon tags microblogEntries ctx))
128-
129-
match content with
130-
| None -> return! (setStatusCode 404 >=> text "Page not found") next ctx
131-
| Some content ->
132-
let pageHtml = FrontendHelpers.layout FrontendHelpers.PageDefinitions.Games content [ "frontend/item_page.scss" ] ctx
133-
return! (htmlView pageHtml next ctx)
134-
135-
}
106+
let GET_itemPage slug : HttpHandler = ItemHelper.Handlers.GET_itemPage Game.documentType slug

‎src/ElectricLemur.Muscadine.Site/FrontendProject.fs‎

Lines changed: 1 addition & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -102,33 +102,4 @@ module Handlers =
102102
return! htmlView pageHtml next ctx
103103
}
104104

105-
let GET_itemPage slug : HttpHandler =
106-
fun next (ctx: HttpContext) -> task {
107-
let! item = Items.tryLookupBySlug slug Project.documentType Project.makeModelFromJObject ctx
108-
109-
let! content =
110-
item
111-
|> Option.map (fun item ->
112-
let icon = match item.IconImagePaths with
113-
| Some paths -> Image.Icon.Image paths
114-
| None -> Items.getDefaultIcon Project.documentType
115-
116-
icon, item)
117-
|> Option.mapAsync (fun (icon, item) -> task {
118-
let! microblogEntries = Microblog.loadMicroblogsForDocument Project.documentType item.Id ctx
119-
return (icon, microblogEntries, item)
120-
})
121-
|> Task.bind (Option.mapAsync (fun (icon, microblogEntries, item) -> task {
122-
let! tags = Tag.loadTagsForDocument Project.documentType item.Id ctx
123-
return (icon, tags, microblogEntries, item)
124-
}))
125-
|> Task.map (Option.map (fun (icon, tags, microblogEntries, item) ->
126-
FrontendHelpers.makeItemPage item.Name item.Description icon tags microblogEntries ctx))
127-
128-
match content with
129-
| None -> return! (setStatusCode 404 >=> text "Page not found") next ctx
130-
| Some content ->
131-
let pageHtml = FrontendHelpers.layout FrontendHelpers.PageDefinitions.Projects content [ "frontend/item_page.scss" ] ctx
132-
return! (htmlView pageHtml next ctx)
133-
134-
}
105+
let GET_itemPage slug : HttpHandler = ItemHelper.Handlers.GET_itemPage Project.documentType slug

‎src/ElectricLemur.Muscadine.Site/ItemHelper.fs‎

Lines changed: 103 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,103 @@
1+
module ElectricLemur.Muscadine.Site.ItemHelper
2+
open Giraffe
3+
4+
type ItemWrapper =
5+
| Game of Game.Game
6+
| Project of Project.Project
7+
| Book of Book.Book
8+
9+
let tryWrapItem (item: obj) =
10+
match item with
11+
| :? Game.Game as g -> Some (Game g)
12+
| :? Project.Project as p -> Some (Project p)
13+
| :? Book.Book as b -> Some (Book b)
14+
| _ -> None
15+
16+
let wrapItem (item: obj) =
17+
match tryWrapItem obj with
18+
| Some i -> i
19+
| _ -> failwith $"Unable to unwrap type {item.GetType().FullName}"
20+
21+
let fromJObject obj =
22+
Database.documentTypeField |> JObj.getter<string> obj
23+
|> Option.bind (
24+
function
25+
| s when s = Game.documentType -> Some (Game.makeModelFromJObject obj |> Game)
26+
| s when s = Project.documentType -> Some (Project.makeModelFromJObject obj |> Project)
27+
| s when s = Book.documentType -> Some (Book.makeModelFromJObject obj |> Book)
28+
| s -> None
29+
)
30+
31+
let toJObject item =
32+
match item with
33+
| Game g -> Game.makeJObjectFromModel g
34+
| Project p -> Project.makeJObjectFromModel p
35+
| Book b -> Book.makeJObjectFromModel b
36+
37+
let documentType item =
38+
match item with
39+
| Game _ -> Game.documentType
40+
| Project _ -> Project.documentType
41+
| Book _ -> Book.documentType
42+
43+
let itemId item =
44+
match item with
45+
| Game g -> g.Id
46+
| Project p -> p.Id
47+
| Book b -> b.Id
48+
49+
let name item =
50+
match item with
51+
| Game g -> g.Name
52+
| Project p -> p.Name
53+
| Book b -> b.Title
54+
55+
let description item =
56+
match item with
57+
| Game g -> g.Description
58+
| Project p -> p.Description
59+
| Book b -> b.Description
60+
61+
let dateAdded item =
62+
match item with
63+
| Game g -> g.DateAdded
64+
| Project p -> p.DateAdded
65+
| Book b -> b.DateAdded
66+
67+
let coverImages item =
68+
match item with
69+
| Game g -> g.CoverImagePaths
70+
| Project p -> p.IconImagePaths
71+
| Book b -> b.CoverImagePaths
72+
73+
let icon item =
74+
match coverImages item with
75+
| Some coverImages -> Image.Icon.Image coverImages
76+
| None -> Items.getDefaultIcon (documentType item)
77+
78+
module Handlers =
79+
let GET_itemPage itemDocumentType slug : HttpHandler =
80+
fun next ctx -> task {
81+
let! item =
82+
Items.tryLookupBySlug slug itemDocumentType id ctx
83+
|> Task.map (Option.bind fromJObject)
84+
85+
let! content =
86+
item
87+
|> Option.mapAsync (fun item -> task {
88+
let! microblogEntries = Microblog.loadMicroblogsForDocument (documentType item) (itemId item) ctx
89+
return (microblogEntries, item)
90+
})
91+
|> Task.bind (Option.mapAsync (fun (microblogEntries, item) -> task {
92+
let! tags = Tag.loadTagsForDocument (documentType item) (itemId item) ctx
93+
return (tags, microblogEntries, item)
94+
}))
95+
|> Task.map (Option.map (fun (tags, microblogEntries, item) ->
96+
FrontendHelpers.makeItemPage (name item) (description item) (icon item) tags microblogEntries ctx))
97+
98+
match content with
99+
| None -> return! (setStatusCode 404 >=> text "Page not found") next ctx
100+
| Some content ->
101+
let pageHtml = FrontendHelpers.layout FrontendHelpers.PageDefinitions.Games content [ "frontend/item_page.scss" ] ctx
102+
return! (htmlView pageHtml next ctx)
103+
}

‎src/ElectricLemur.Muscadine.Site/Option.fs‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,11 @@ let ofResult (r: Result<'a, 'e>) =
55
| Ok v -> Some v
66
| Error _ -> None
77

8+
let toResult (errorValue: 'e) o =
9+
match o with
10+
| Some v -> Ok v
11+
| None -> Error errorValue
12+
813
/// Takes a Sequence of Options and returns Some of a Sequence of unwrapped values
914
/// iff all Options in the Sequence were Some.
1015
/// If any Option in the Sequence was None, None is returned
@@ -47,4 +52,4 @@ let mapAsync (f: ('a -> System.Threading.Tasks.Task<'b>)) (o: 'a option) = task
4752
| Some o ->
4853
let! answer = f o
4954
return (Some answer)
50-
}
55+
}

0 commit comments

Comments
 (0)