Minor fixes, bool parameter instance
This commit is contained in:
parent
e2f217f981
commit
a607da06d3
2
TODO
2
TODO
@ -1 +1,3 @@
|
|||||||
Catch exceptions and return as 500 errors
|
Catch exceptions and return as 500 errors
|
||||||
|
approot
|
||||||
|
Request parameters without a request object?
|
||||||
|
|||||||
@ -86,7 +86,7 @@ authOpenidForm = do
|
|||||||
"<input type='submit' value='Login'>" ++
|
"<input type='submit' value='Login'>" ++
|
||||||
"</form>"
|
"</form>"
|
||||||
case dest of
|
case dest of
|
||||||
Just dest' -> addCookie 20 "DEST" dest'
|
Just dest' -> addCookie 120 "DEST" dest'
|
||||||
Nothing -> return ()
|
Nothing -> return ()
|
||||||
htmlResponse html
|
htmlResponse html
|
||||||
|
|
||||||
|
|||||||
@ -160,7 +160,7 @@ hackHeaderParam name = do
|
|||||||
-- | Extract the cookie which specifies the identifier for a logged in
|
-- | Extract the cookie which specifies the identifier for a logged in
|
||||||
-- user.
|
-- user.
|
||||||
identifier :: Parameter a => RequestParser a
|
identifier :: Parameter a => RequestParser a
|
||||||
identifier = hackHeaderParam authCookieName
|
identifier = hackHeaderParam authCookieName -- FIXME better error message
|
||||||
|
|
||||||
-- | Get the raw 'Hack.Env' value.
|
-- | Get the raw 'Hack.Env' value.
|
||||||
parseEnv :: RequestParser Hack.Env
|
parseEnv :: RequestParser Hack.Env
|
||||||
@ -278,6 +278,12 @@ instance Parameter Day where
|
|||||||
then Right $ fromGregorian y m d
|
then Right $ fromGregorian y m d
|
||||||
else Left $ "Invalid date: " ++ s
|
else Left $ "Invalid date: " ++ s
|
||||||
|
|
||||||
|
-- for checkboxes; checks for presence
|
||||||
|
instance Parameter Bool where
|
||||||
|
readParams [] = Right False
|
||||||
|
readParams [_] = Right True
|
||||||
|
readParams x = Left $ "Invalid Bool parameter: " ++ show x
|
||||||
|
|
||||||
-- | The input for a resource.
|
-- | The input for a resource.
|
||||||
--
|
--
|
||||||
-- Each resource can define its own instance of 'Request' and then more
|
-- Each resource can define its own instance of 'Request' and then more
|
||||||
|
|||||||
@ -45,7 +45,7 @@ tryLookup def key = fromMaybe def . lookup key
|
|||||||
|
|
||||||
-- | Format a 'UTCTime' in W3 format; useful for setting cookies.
|
-- | Format a 'UTCTime' in W3 format; useful for setting cookies.
|
||||||
formatW3 :: UTCTime -> String
|
formatW3 :: UTCTime -> String
|
||||||
formatW3 = formatTime defaultTimeLocale "%FT%X-08:00" -- FIXME time zone?
|
formatW3 = formatTime defaultTimeLocale "%FT%X-00:00"
|
||||||
|
|
||||||
----- Testing
|
----- Testing
|
||||||
testSuite :: Test
|
testSuite :: Test
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user