2015-09-04 23:23:32 +02:00
|
|
|
module Handler.ListChallenges where
|
|
|
|
|
|
|
|
import Import
|
|
|
|
|
2020-10-12 07:27:32 +02:00
|
|
|
mainCondition :: [Filter Challenge]
|
|
|
|
mainCondition = [ChallengeArchived !=. Just True]
|
|
|
|
|
2015-09-04 23:23:32 +02:00
|
|
|
getListChallengesR :: Handler Html
|
2020-10-12 07:27:32 +02:00
|
|
|
getListChallengesR = generalListChallenges mainCondition
|
|
|
|
|
|
|
|
getListChallengesJsonR :: Handler Value
|
|
|
|
getListChallengesJsonR = generalListChallengesJson mainCondition
|
2019-03-20 16:31:08 +01:00
|
|
|
|
|
|
|
getListArchivedChallengesR :: Handler Html
|
|
|
|
getListArchivedChallengesR = generalListChallenges [ChallengeArchived ==. Just True]
|
|
|
|
|
2020-10-12 07:27:32 +02:00
|
|
|
instance ToJSON (Entity Challenge) where
|
|
|
|
toJSON (Entity _ ch) = object
|
2020-10-15 22:27:16 +02:00
|
|
|
[ "name" .= challengeName ch
|
2020-10-12 07:27:32 +02:00
|
|
|
, "title" .= challengeTitle ch
|
|
|
|
, "description" .= challengeDescription ch
|
2020-10-15 22:27:16 +02:00
|
|
|
, "starred" .= challengeStarred ch
|
|
|
|
, "archived" .= challengeArchived ch
|
2020-10-12 07:27:32 +02:00
|
|
|
]
|
|
|
|
|
|
|
|
generalListChallengesJson :: [Filter Challenge] -> Handler Value
|
|
|
|
generalListChallengesJson filterExpr = do
|
|
|
|
challenges <- getChallenges filterExpr
|
|
|
|
return $ toJSON challenges
|
|
|
|
|
2020-10-12 07:17:48 +02:00
|
|
|
generalListChallenges :: [Filter Challenge] -> Handler Html
|
2019-03-20 16:31:08 +01:00
|
|
|
generalListChallenges filterExpr = do
|
2020-10-12 07:17:48 +02:00
|
|
|
challenges <- getChallenges filterExpr
|
2015-09-04 23:23:32 +02:00
|
|
|
defaultLayout $ do
|
|
|
|
setTitle "List challenges"
|
|
|
|
$(widgetFile "list-challenges")
|
|
|
|
|
2020-10-12 07:17:48 +02:00
|
|
|
getChallenges :: [Filter Challenge] -> Handler [Entity Challenge]
|
|
|
|
getChallenges filterExpr = runDB $ selectList filterExpr [Desc ChallengeStarred, Desc ChallengeStamp]
|
|
|
|
|
|
|
|
listChallengesCore :: [Entity Challenge] -> Widget
|
2015-09-04 23:23:32 +02:00
|
|
|
listChallengesCore challenges = $(widgetFile "list-challenges-core")
|
2018-01-18 08:21:06 +01:00
|
|
|
|
|
|
|
getChallengeImageR :: ChallengeId -> Handler Html
|
|
|
|
getChallengeImageR challengeId = do
|
|
|
|
challenge <- runDB $ get404 challengeId
|
|
|
|
case challengeImage challenge of
|
|
|
|
Just image -> do
|
|
|
|
addHeader "Content-Disposition" "attachment; filename=\"image.png\""
|
|
|
|
sendResponse (typePng, toContent image)
|
|
|
|
Nothing -> sendResponseStatus status202 ()
|