-
-
Notifications
You must be signed in to change notification settings - Fork 8
/
Directory.hs
81 lines (70 loc) · 2.77 KB
/
Directory.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
module Handler.Directory where
import Data.List
import qualified Data.ByteString.Char8 as BC
import PathPieces
import qualified Model
import Import
import Handler.Browse (renderFeedsList, addFeedsLinks)
getDirectoryR :: Handler RepHtml
getDirectoryR = do
dir <- groupDirectory `fmap` withDB (Model.getDirectory)
let (dir1, dir2) = splitAt ((length dir + 1) `div` 2) dir
defaultLayout $ do
setTitleI MsgTitleDirectory
let
links :: [(Text, [(Text, Route UIApp, String)])]
links = [("Feeds", [("OPML", DirectoryOpmlR, BC.unpack typeOpml)])]
addFeedsLinks links
[whamlet|$newline always
<h2>_{MsgHeadingDirectory}
^{renderFeedsList links}
<section class="col1 directory">
^{renderEntries dir1}
<section class="col2 directory">
^{renderEntries dir2}
|]
where renderEntries entries =
[hamlet|$newline always
$forall es <- entries
<article class="meta">
<img class="logo"
src="@{UserThumbnailR (Model.dirUser $ head es) (Thumbnail 64)}">
<div class="title">
<h3>
<a href="@{UserR $ Model.dirUser $ head es}">#{Model.dirUserTitle $ head es}
<ul class="feeds">
$forall e <- es
<li xml:lang="#{Model.dirFeedLang e}"
data-types="#{Model.dirFeedTypes e}">
<a href="@{UserFeedR (Model.dirUser e) (Model.dirFeedSlug e)}">
#{Model.dirFeedTitle e}
|]
typeOpml :: ContentType
typeOpml = "text/x-opml"
newtype RepOpml = RepOpml Content
instance HasReps RepOpml where
chooseRep (RepOpml content) _cts =
return (typeOpml, content)
getDirectoryOpmlR :: Handler RepOpml
getDirectoryOpmlR = do
dir <- groupDirectory `fmap` withDB (Model.getDirectory)
url <- getFullUrlRender
RepOpml `fmap`
hamletToContent [xhamlet|$newline always
<opml version="2.0">
<head title="Bitlove.org directory"
ownerId="#{url DirectoryR}">
<body>
$forall es <- dir
<outline text="#{Model.dirUserTitle $ head es}"
htmlUrl="#{url $ UserR (Model.dirUser $ head es)}">
$forall e <- es
<outline text="#{Model.dirFeedTitle e}"
type="rss"
htmlUrl="#{url $ UserFeedR (Model.dirUser e) (Model.dirFeedSlug e)}"
xmlUrl="#{url $ MapFeedR (Model.dirUser e) (Model.dirFeedSlug e)}">
|]
groupDirectory :: [Model.DirectoryEntry] -> [[Model.DirectoryEntry]]
groupDirectory = groupBy $
\e1 e2 ->
Model.dirUser e1 == Model.dirUser e2