Removed a number of FIXMEs
This commit is contained in:
parent
180a5ec9ce
commit
d4afec1277
@ -124,7 +124,6 @@ toWaiApp' y resource session' env = do
|
|||||||
: encodePathInfo (fixSegs $ quasiRender site u)
|
: encodePathInfo (fixSegs $ quasiRender site u)
|
||||||
rr <- parseWaiRequest env session'
|
rr <- parseWaiRequest env session'
|
||||||
onRequest y rr
|
onRequest y rr
|
||||||
print pathSegments -- FIXME remove
|
|
||||||
let ya = case eurl of
|
let ya = case eurl of
|
||||||
Left _ -> runHandler (errorHandler y NotFound)
|
Left _ -> runHandler (errorHandler y NotFound)
|
||||||
render
|
render
|
||||||
|
|||||||
@ -38,7 +38,6 @@ data PageContent url = PageContent
|
|||||||
, pageBody :: Hamlet url IO ()
|
, pageBody :: Hamlet url IO ()
|
||||||
}
|
}
|
||||||
|
|
||||||
-- FIXME some typeclasses for the stuff below?
|
|
||||||
-- | Converts the given Hamlet template into 'Content', which can be used in a
|
-- | Converts the given Hamlet template into 'Content', which can be used in a
|
||||||
-- Yesod 'Response'.
|
-- Yesod 'Response'.
|
||||||
hamletToContent :: Hamlet (Routes master) IO () -> GHandler sub master Content
|
hamletToContent :: Hamlet (Routes master) IO () -> GHandler sub master Content
|
||||||
|
|||||||
@ -98,9 +98,9 @@ getOpenIdForward = do
|
|||||||
render <- getUrlRender
|
render <- getUrlRender
|
||||||
let complete = render OpenIdComplete
|
let complete = render OpenIdComplete
|
||||||
res <- runAttemptT $ OpenId.getForwardUrl oid complete
|
res <- runAttemptT $ OpenId.getForwardUrl oid complete
|
||||||
|
let errurl err = render OpenIdR ++ "?message=" ++ encodeUrl (show err)
|
||||||
attempt
|
attempt
|
||||||
(\err -> redirectString RedirectTemporary -- FIXME
|
(\err -> redirectString RedirectTemporary $ errurl err)
|
||||||
$ "/auth/openid/?message=" ++ encodeUrl (show err))
|
|
||||||
(redirectString RedirectTemporary)
|
(redirectString RedirectTemporary)
|
||||||
res
|
res
|
||||||
|
|
||||||
@ -109,9 +109,9 @@ getOpenIdComplete = do
|
|||||||
rr <- getRequest
|
rr <- getRequest
|
||||||
let gets' = reqGetParams rr
|
let gets' = reqGetParams rr
|
||||||
res <- runAttemptT $ OpenId.authenticate gets'
|
res <- runAttemptT $ OpenId.authenticate gets'
|
||||||
let onFailure err = redirectString RedirectTemporary -- FIXME
|
render <- getUrlRender
|
||||||
$ "/auth/openid/?message="
|
let errurl err = render OpenIdR ++ "?message=" ++ encodeUrl (show err)
|
||||||
++ encodeUrl (show err)
|
let onFailure err = redirectString RedirectTemporary $ errurl err
|
||||||
let onSuccess (OpenId.Identifier ident) = do
|
let onSuccess (OpenId.Identifier ident) = do
|
||||||
y <- getYesod
|
y <- getYesod
|
||||||
header authCookieName ident
|
header authCookieName ident
|
||||||
@ -207,22 +207,6 @@ redirectLogin = do
|
|||||||
Rpxnow -> RpxnowR -- FIXME this doesn't actually show a login page?
|
Rpxnow -> RpxnowR -- FIXME this doesn't actually show a login page?
|
||||||
redirectSetDest RedirectTemporary r
|
redirectSetDest RedirectTemporary r
|
||||||
|
|
||||||
{- FIXME
|
|
||||||
-- | Determinge the path requested by the user (ie, the path info). This
|
|
||||||
-- includes the query string.
|
|
||||||
requestPath :: (Functor m, Monad m, RequestReader m) => m String
|
|
||||||
requestPath = do
|
|
||||||
env <- waiRequest
|
|
||||||
let q = case B8.unpack $ W.queryString env of
|
|
||||||
"" -> ""
|
|
||||||
q'@('?':_) -> q'
|
|
||||||
q' -> '?' : q'
|
|
||||||
return $! dropSlash (B8.unpack $ W.pathInfo env) ++ q
|
|
||||||
where
|
|
||||||
dropSlash ('/':x) = x
|
|
||||||
dropSlash x = x
|
|
||||||
-}
|
|
||||||
|
|
||||||
-- | Redirect to the given URL, and set a cookie with the current URL so the
|
-- | Redirect to the given URL, and set a cookie with the current URL so the
|
||||||
-- user will ultimately be sent back here.
|
-- user will ultimately be sent back here.
|
||||||
redirectSetDest :: RedirectType
|
redirectSetDest :: RedirectType
|
||||||
@ -230,13 +214,13 @@ redirectSetDest :: RedirectType
|
|||||||
-> GHandler sub master a
|
-> GHandler sub master a
|
||||||
redirectSetDest rt dest = do
|
redirectSetDest rt dest = do
|
||||||
ur <- getUrlRender
|
ur <- getUrlRender
|
||||||
|
toMaster <- getRouteToMaster
|
||||||
curr <- getRoute
|
curr <- getRoute
|
||||||
let curr' = case curr of
|
let curr' = case curr of
|
||||||
Just x -> ur x
|
Just x -> ur x
|
||||||
Nothing -> "/" -- should never happen anyway
|
Nothing -> "/" -- should never happen anyway
|
||||||
dest' = ur dest
|
|
||||||
addCookie destCookieTimeout destCookieName curr'
|
addCookie destCookieTimeout destCookieName curr'
|
||||||
redirectString rt dest' -- FIXME use redirect?
|
redirect rt $ toMaster dest
|
||||||
|
|
||||||
-- | Read the 'destCookieName' cookie and redirect to this destination. If the
|
-- | Read the 'destCookieName' cookie and redirect to this destination. If the
|
||||||
-- cookie is missing, then use the default path provided.
|
-- cookie is missing, then use the default path provided.
|
||||||
@ -248,4 +232,4 @@ redirectToDest rt def = do
|
|||||||
(x:_) -> do
|
(x:_) -> do
|
||||||
deleteCookie destCookieName
|
deleteCookie destCookieName
|
||||||
return x
|
return x
|
||||||
redirectString rt dest -- FIXME use redirect?
|
redirectString rt dest
|
||||||
|
|||||||
@ -39,10 +39,6 @@ showFreq Weekly = "weekly"
|
|||||||
showFreq Monthly = "monthly"
|
showFreq Monthly = "monthly"
|
||||||
showFreq Yearly = "yearly"
|
showFreq Yearly = "yearly"
|
||||||
showFreq Never = "never"
|
showFreq Never = "never"
|
||||||
{- FIXME
|
|
||||||
instance ConvertSuccess SitemapChangeFreq Html where
|
|
||||||
convertSuccess = (cs :: String -> Html) . cs
|
|
||||||
-}
|
|
||||||
|
|
||||||
data SitemapUrl url = SitemapUrl
|
data SitemapUrl url = SitemapUrl
|
||||||
{ sitemapLoc :: url
|
{ sitemapLoc :: url
|
||||||
|
|||||||
@ -1,7 +1,6 @@
|
|||||||
{-# LANGUAGE QuasiQuotes #-}
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-} -- FIXME due to bug in web-routes-quasi
|
|
||||||
---------------------------------------------------------
|
---------------------------------------------------------
|
||||||
--
|
--
|
||||||
-- Module : Yesod.Helpers.Static
|
-- Module : Yesod.Helpers.Static
|
||||||
@ -42,7 +41,6 @@ data Static = Static FileLookup
|
|||||||
staticArgs :: FileLookup -> Static
|
staticArgs :: FileLookup -> Static
|
||||||
staticArgs = Static
|
staticArgs = Static
|
||||||
|
|
||||||
-- FIXME bug in web-routes-quasi generates warning here
|
|
||||||
$(mkYesodSub "Static" [] [$parseRoutes|
|
$(mkYesodSub "Static" [] [$parseRoutes|
|
||||||
/* StaticRoute GET
|
/* StaticRoute GET
|
||||||
|])
|
|])
|
||||||
|
|||||||
@ -108,7 +108,7 @@ applyLayoutJson :: Yesod master
|
|||||||
applyLayoutJson t x toH toJ = do
|
applyLayoutJson t x toH toJ = do
|
||||||
let pc = PageContent
|
let pc = PageContent
|
||||||
{ pageTitle = cs t
|
{ pageTitle = cs t
|
||||||
, pageHead = return () -- FIXME allow user to supply?
|
, pageHead = return ()
|
||||||
, pageBody = toH x
|
, pageBody = toH x
|
||||||
}
|
}
|
||||||
y <- getYesodMaster
|
y <- getYesodMaster
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user