/
Browse.hs
55 lines (51 loc) · 1.83 KB
/
Browse.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
{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
module Handler.Browse
( getBrowseR
) where
import Wiki
import Handler.Labels (getLTree)
import Handler.Topic (showLTree)
import Data.Maybe (mapMaybe, catMaybes)
import qualified Data.Set as Set
import Data.List (sortBy)
import Data.Ord (comparing)
data Entry = Entry
{ etitle :: Text
, eauthor :: User
, eurl :: WikiRoute
}
getBrowseR :: Handler RepHtml
getBrowseR = do
ltree <- getLTree
sel <- mapMaybe (fromSinglePiece . fst) . reqGetParams <$> getRequest
let active = flip elem sel
entriesT <- catMaybes <$> (runDB $ selectList [] [] >>= mapM (\(tid, t) -> do
lids <- (map $ topicLabelLabel . snd) <$> selectList [TopicLabelTopic ==. tid] []
if applyFilter sel lids
then do
u <- get404 $ topicOwner t
return $ Just Entry
{ etitle = topicTitle t
, eauthor = u
, eurl = TopicR tid
}
else return Nothing))
entriesM <- catMaybes <$> (runDB $ selectList [] [] >>= mapM (\(mid, m) -> do
lids <- (map $ mapLabelLabel . snd) <$> selectList [MapLabelMap ==. mid] []
if applyFilter sel lids
then do
u <- get404 $ tMapOwner m
return $ Just Entry
{ etitle = tMapTitle m
, eauthor = u
, eurl = ShowMapR mid
}
else return Nothing))
let entries = sortBy (comparing etitle) $ entriesT ++ entriesM
defaultLayout $ do
addScript $ StaticR jquery_js
$(widgetFile "browse")
applyFilter :: [LabelId] -- ^ selected
-> [LabelId] -- ^ this topic
-> Bool
applyFilter sel top = Set.fromList sel `Set.isSubsetOf` Set.fromList top