diff --git a/demos/Helper/YesodHelper.hs b/demos/Helper/YesodHelper.hs new file mode 100644 --- /dev/null +++ b/demos/Helper/YesodHelper.hs @@ -0,0 +1,84 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE OverloadedStrings #-} + +module Helper.YesodHelper( + bootstrapCDN + , bootstrapLayout + , alertMessage + , writeTokenToSession + , getTokenFromSession + , deleteTokenFromSession +) where + +import Yesod.Core (Yesod, widgetToPageContent) +import Yesod.Widget (GWidget, PageContent(..)) +import Yesod.Handler (GHandler, hamletToRepHtml, getMessage, setMessage, getMessageRender, setSessionBS, deleteSession, lookupSessionBS) +import Yesod.Content (RepHtml) +import Text.Hamlet (hamlet) +import Data.Text (Text) +import Text.Shakespeare.I18N (RenderMessage(..)) +import Web.XING +import Text.Hamlet (shamlet) +import Data.Maybe (isJust, fromJust) +import Data.Monoid (mappend) + +bootstrapCDN :: Text +bootstrapCDN = "//netdna.bootstrapcdn.com/twitter-bootstrap/2.3.0" + +bootstrapLayout + :: (Yesod a) + => GWidget sub a () + -> GHandler sub a RepHtml +bootstrapLayout widget = do + pc <- widgetToPageContent widget + mmsg <- getMessage + hamletToRepHtml [hamlet| + $doctype 5 + + + #{pageTitle pc} + ^{pageHead pc} + <body> + <div .hero-unit> + <h1>#{pageTitle pc} + $maybe msg <- mmsg + #{msg} + ^{pageBody pc} + |] + +alertMessage + :: (RenderMessage y msg) + => msg + -> GHandler sub y () +alertMessage message = do + mr <- getMessageRender + setMessage [shamlet| + <p .alert .alert-success> + <button type=button class=close data-dismiss=alert>× + #{mr message} + |] + +writeTokenToSession + :: Text + -> Credential + -> GHandler sub a () +writeTokenToSession name credential = do + setSessionBS (name `mappend` "Token") (token credential) + setSessionBS (name `mappend` "Secret") (tokenSecret credential) + +getTokenFromSession + :: Text + -> GHandler sub a (Maybe Credential) +getTokenFromSession name = do + maybeToken <- lookupSessionBS (name `mappend` "Token") + maybeSecret <- lookupSessionBS (name `mappend` "Secret") + if (isJust maybeToken && isJust maybeSecret) + then return $ Just (newCredential (fromJust maybeToken) (fromJust maybeSecret)) + else return Nothing + +deleteTokenFromSession + :: Text + -> GHandler sub a () +deleteTokenFromSession name = do + deleteSession (name `mappend` "Token") + deleteSession (name `mappend` "Secret") diff --git a/xing-api.cabal b/xing-api.cabal --- a/xing-api.cabal +++ b/xing-api.cabal @@ -1,5 +1,5 @@ name: xing-api -version: 0.1.1 +version: 0.1.2 synopsis: Wrapper for the XING API, v1. description: This package is currently under development and not considered stable. The versioning follows <http://semver.org> and the first stable version will be release as 1.0.0. @@ -37,7 +37,7 @@ library exposed-modules: Web.XING - build-depends: base == 4.5.* + build-depends: base == 4.* , containers == 0.4.* , time == 1.4.* , text == 0.11.* @@ -123,6 +123,7 @@ , warp == 1.3.* , xing-api , yesod-core == 1.1.* + other-modules: Helper.YesodHelper else buildable: False main-is: yesod-demo.hs