haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge remote-tracking branch 'origin/master' into static-pages

Browse Source
This commit is contained in:
Greg Weber 2012-02-09 15:15:53 -08:00
commit 708b731dd1
5 changed files with 46 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
yesod-auth/openid.hs
View File

@ -11,8 +11,9 @@ import Text.Hamlet (hamlet)
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Yesod.Form import Yesod.Form
import Network.Wai.Handler.Warp (run) import Network.Wai.Handler.Warp (run)
import Network.HTTP.Conduit
data BID = BID data BID = BID { httpManager :: Manager }
mkYesod "BID" [parseRoutes| mkYesod "BID" [parseRoutes|
/ RootR GET / RootR GET
@ -44,11 +45,14 @@ instance YesodAuth BID where
loginDest _ = AfterLoginR loginDest _ = AfterLoginR
logoutDest _ = AuthR LoginR logoutDest _ = AuthR LoginR
getAuthId = return . Just . credsIdent getAuthId = return . Just . credsIdent
authPlugins = [authOpenId] authPlugins _ = [authOpenId]
authHttpManager = httpManager
instance RenderMessage BID FormMessage where instance RenderMessage BID FormMessage where
renderMessage _ _ = defaultFormMessage renderMessage _ _ = defaultFormMessage
main :: IO () main :: IO ()
main = toWaiApp BID >>= run 3000 main = do
m <- newManager def
toWaiApp (BID m) >>= run 3000

2
yesod-auth/yesod-auth.cabal
View File

@ -42,7 +42,7 @@ library
, persistent >= 0.8 && < 0.9 , persistent >= 0.8 && < 0.9
, persistent-template >= 0.8 && < 0.9 , persistent-template >= 0.8 && < 0.9
, SHA >= 1.4.1.3 && < 1.6 , SHA >= 1.4.1.3 && < 1.6
, http-conduit >= 1.2 && < 1.3 , http-conduit >= 1.2.5 && < 1.3
, aeson >= 0.5 , aeson >= 0.5
, pwstore-fast >= 2.2 && < 3 , pwstore-fast >= 2.2 && < 3
, lifted-base >= 0.1 && < 0.2 , lifted-base >= 0.1 && < 0.2

69
yesod-core/Yesod/Internal/Core.hs
View File

@ -414,7 +414,7 @@ defaultYesodRunner handler master sub murl toMasterRoute mkey req = do
hs' = hs' =
case mkey of case mkey of
Nothing -> hs Nothing -> hs
Just _ -> AddCookie SetCookie Just _ -> AddCookie def
{ setCookieName = sessionName { setCookieName = sessionName
, setCookieValue = sessionVal , setCookieValue = sessionVal
, setCookiePath = Just (cookiePath master) , setCookiePath = Just (cookiePath master)
@ -527,8 +527,8 @@ widgetToPageContent w = do
master <- getYesod master <- getYesod
((), GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- unGWidget w ((), GWData (Body body) (Last mTitle) scripts' stylesheets' style jscript (Head head')) <- unGWidget w
let title = maybe mempty unTitle mTitle let title = maybe mempty unTitle mTitle
let scripts = runUniqueList scripts' scripts = runUniqueList scripts'
let stylesheets = runUniqueList stylesheets' stylesheets = runUniqueList stylesheets'
render <- getUrlRenderParams render <- getUrlRenderParams
let renderLoc x = let renderLoc x =
@ -552,22 +552,11 @@ widgetToPageContent w = do
$ encodeUtf8 $ renderJavascriptUrl render s $ encodeUtf8 $ renderJavascriptUrl render s
return $ renderLoc x return $ renderLoc x
let addAttr x (y, z) = x ! customAttribute (textTag y) (toValue z) -- modernizr should be at the end of the <head> http://www.modernizr.com/docs/#installing
let renderLoc' render' (Local url) = render' url [] -- the asynchronous loader means your page doesn't have to wait for all the js to load
renderLoc' _ (Remote s) = s let (mcomplete, ynscripts) = ynHelper render scripts jscript jsLoc
let mkScriptTag (Script loc attrs) render' = headAll = [HAMLET|
foldl' addAttr TBH.script (("src", renderLoc' render' loc) : attrs) $ return () \^{head'}
let mkLinkTag (Stylesheet loc attrs) render' =
foldl' addAttr TBH.link
( ("rel", "stylesheet")
: ("href", renderLoc' render' loc)
: attrs
)
let left (Left x) = Just x
left _ = Nothing
right (Right x) = Just x
right _ = Nothing
let head'' = [HAMLET|
$forall s <- stylesheets $forall s <- stylesheets
^{mkLinkTag s} ^{mkLinkTag s}
$forall s <- css $forall s <- css
@ -581,20 +570,6 @@ $forall s <- css
<style media=#{media}>#{content} <style media=#{media}>#{content}
$nothing $nothing
<style>#{content} <style>#{content}
$maybe _ <- yepnopeJs master
$nothing
$forall s <- scripts
^{mkScriptTag s}
$maybe j <- jscript
$maybe s <- jsLoc
<script src="#{s}">
$nothing
<script>^{jelper j}
\^{head'}
|]
let (mcomplete, ynscripts) = ynHelper render scripts jscript jsLoc
let bodyYN = [HAMLET|
^{body}
$maybe eyn <- yepnopeJs master $maybe eyn <- yepnopeJs master
$maybe yn <- left eyn $maybe yn <- left eyn
<script src=#{yn}> <script src=#{yn}>
@ -604,8 +579,34 @@ $maybe eyn <- yepnopeJs master
<script>yepnope({load:#{ynscripts},complete:function(){^{complete}}}) <script>yepnope({load:#{ynscripts},complete:function(){^{complete}}})
$nothing $nothing
<script>yepnope({load:#{ynscripts}}) <script>yepnope({load:#{ynscripts}})
$nothing
$forall s <- scripts
^{mkScriptTag s}
$maybe j <- jscript
$maybe s <- jsLoc
<script src="#{s}">
$nothing
<script>^{jelper j}
|] |]
return $ PageContent title head'' bodyYN return $ PageContent title headAll body
where
left (Left x) = Just x
left _ = Nothing
right (Right x) = Just x
right _ = Nothing
renderLoc' render' (Local url) = render' url []
renderLoc' _ (Remote s) = s
addAttr x (y, z) = x ! customAttribute (textTag y) (toValue z)
mkScriptTag (Script loc attrs) render' =
foldl' addAttr TBH.script (("src", renderLoc' render' loc) : attrs) $ return ()
mkLinkTag (Stylesheet loc attrs) render' =
foldl' addAttr TBH.link
( ("rel", "stylesheet")
: ("href", renderLoc' render' loc)
: attrs
)
ynHelper :: (url -> [x] -> Text) ynHelper :: (url -> [x] -> Text)
-> [Script (url)] -> [Script (url)]

2
yesod-core/yesod-core.cabal
View File

@ -69,7 +69,7 @@ library
, containers >= 0.2 && < 0.5 , containers >= 0.2 && < 0.5
, monad-control >= 0.3 && < 0.4 , monad-control >= 0.3 && < 0.4
, transformers-base >= 0.4 , transformers-base >= 0.4
, cookie >= 0.3 && < 0.4 , cookie >= 0.4 && < 0.5
, blaze-html >= 0.4.1.3 && < 0.5 , blaze-html >= 0.4.1.3 && < 0.5
, http-types >= 0.6.5 && < 0.7 , http-types >= 0.6.5 && < 0.7
, case-insensitive >= 0.2 , case-insensitive >= 0.2

4
yesod/scaffold/Settings.hs.cg
View File

@ -45,7 +45,7 @@ staticDir = "static"
-- have to make a corresponding change here. -- have to make a corresponding change here.
-- --
-- To see how this value is used, see urlRenderOverride in Foundation.hs -- To see how this value is used, see urlRenderOverride in Foundation.hs
staticRoot :: AppConfig DefaultEnv x -> Text staticRoot :: AppConfig DefaultEnv x -> Text
staticRoot conf = [~qq~st|#{appRoot conf}/static|] staticRoot conf = [~qq~st|#{appRoot conf}/static|]
@ -62,7 +62,7 @@ widgetFile = Yesod.Default.Util.widgetFileNoReload
data Extra = Extra data Extra = Extra
{ extraCopyright :: Text { extraCopyright :: Text
, extraAnalytics :: Maybe Text -- ^ Google Analytics , extraAnalytics :: Maybe Text -- ^ Google Analytics
} } deriving Show
parseExtra :: DefaultEnv -> Object -> Parser Extra parseExtra :: DefaultEnv -> Object -> Parser Extra
parseExtra _ o = Extra parseExtra _ o = Extra