Created
April 30, 2016 20:47
-
-
Save amitaibu/49ac3f4933a6f2641e43d4a111431d5a to your computer and use it in GitHub Desktop.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Handler.Events where | |
import qualified Data.Text.Read as T | |
import Handler.Event | |
import Import | |
addPager :: ( PersistEntity val | |
, PersistEntityBackend val ~ YesodPersistBackend m | |
, PersistQuery (YesodPersistBackend m) | |
, Yesod m | |
) | |
=> Int | |
-> [ SelectOpt val ] | |
-> HandlerT m IO [ SelectOpt val ] | |
addPager resultsPerPage selectOpt = do | |
mpage <- lookupGetParam "page" | |
let pageNumber = case (T.decimal $ fromMaybe "0" mpage) of | |
Left _ -> 0 | |
Right (val, _) -> val | |
let pagerOpt = [ LimitTo resultsPerPage | |
, OffsetBy $ (pageNumber - 1) * resultsPerPage | |
] | |
return $ selectOpt `mappend` pagerOpt | |
-- @todo: Generalize not to be only for Event | |
addOrder :: ( PersistQuery (YesodPersistBackend m) | |
, Yesod m | |
) | |
=> [SelectOpt Event] | |
-> HandlerT m IO [ SelectOpt Event ] | |
addOrder selectOpt = do | |
morder <- lookupGetParam "order" | |
let order = case morder of | |
Nothing -> Desc EventId | |
Just val -> Asc EventId | |
return $ selectOpt `mappend` [order] | |
getEventsR :: Handler Value | |
getEventsR = do | |
selectOpt <- (addPager 5) [] >>= addOrder | |
events <- runDB $ selectList [] selectOpt :: Handler [Entity Event] | |
return $ object ["data" .= events] | |
postEventsR :: Handler Value | |
postEventsR = do | |
event <- requireJsonBody :: Handler Event | |
eid <- runDB $ insert event | |
returnVal <- getEventR eid | |
sendResponseStatus status201 returnVal |
Author
amitaibu
commented
Apr 30, 2016
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment