[added examples/ConnectDemo.hs Jeremy Shaw **20091016190123 Ignore-this: eef1cd115aa5d8f8bf6c95ee8f0f10b0 ] addfile ./examples/ConnectDemo.hs hunk ./Happstack/Facebook/Common.hs 37 -{- --- FIXME: send to applicative-extras -instance (Monad m) => Applicative (StateT s m) where - pure = return - (<*>) = ap --} hunk ./Happstack/Facebook/Common.hs 353 -{- -withFacebook' :: (Monad m) => FacebookConfig -> d -> ServerPartT (FacebookT (FacebookState d) m) a -> ServerPartT m a -withFacebook' config facebookData sp = - mapServerPartT doFacebook sp - where - doFacebook sp = - runReaderT (unFacebookT sp) (FacebookState config facebookData) --} hunk ./Happstack/Facebook/Common.hs 364 -{- -withUser :: (HasFacebookConfig n, HasFacebookData d n) => User -> FacebookT (FacebookStateU d) m a -> n (m a) -withUser u (FacebookT action) = - do c <- askFacebookConfig - d <- askFacebookData - return $ (runReaderT action (FacebookStateU c d u)) - -withSession :: (HasUser n, HasFacebookConfig n, HasFacebookData d n) => SessionKey -> FacebookT (FacebookStateS d) m a -> n (m a) -withSession s (FacebookT action) = - do c <- askFacebookConfig - d <- askFacebookData - u <- askUser - return $ (runReaderT action (FacebookStateS c d u s)) --} - -{- -withSession :: (HasFacebookConfig n, HasUser n, HasFacebookData d n) => - SessionKey -> - FacebookT (FacebookStateS d) m a -> n (m a) --} - -- (HasFacebookConfig n, HasUser n, HasFacebookData d n) => - hunk ./examples/ConnectDemo.hs 1 +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -F -pgmFtrhsx #-} +module Main where + +import Control.Applicative +import Control.Monad +import Happstack.Server +import Happstack.Facebook.Common +import Happstack.Facebook.Connect +import Happstack.Facebook.FacebookT +import Happstack.Facebook.XdReceiver +import HSP +import FeatsOfStrengthConfig (facebookConfig) +import qualified HSX.XMLGenerator as HSX + +main :: IO () +main = simpleHTTP nullConf impl + +impl :: ServerPart Response +impl = + msum [ xdReceiverPart -- xd_receiver.htm + , withFacebookConnect facebookConfig $ + msum [ withSessionSP $ fbml (appTemplate "Members Area" ()

Welcome to the Members Area

) + , fbml (appTemplate "Login" () +
+

Connect using Facebook Connect

+ +
) + ] + ] + +fbml :: + ( Functor m + , FilterMonad Response m + , XMLGenerator m + ) + => XMLGenT m XML + -> m Response +fbml xml = toResponse . FbXML <$> (unXMLGenT xml) + +-- http://wiki.developers.facebook.com/index.php/Connect/Setting_Up_Your_Site +appTemplate :: + ( Functor m + , HasFacebookConfig m + , XMLGenerator m + , EmbedAsChild m headers + , EmbedAsChild m body +-- , EmbedAsAttr m (Attr (String, String) String) + ) + => String + -> headers + -> body + -> XMLGenT m (HSX.XML m) +appTemplate title headers body = + -- xmlns="http://www.w3.org/1999/xhtml" xmlns:fb="http://www.facebook.com/2008/fbml"> + + <% headers %> + + <% title %> + + + <% fbFeatureLoader %> -- enables XFBML, Facebook Javascript calls, etc + <% body %> + <% fbInit =<< (apiKey <$> askFacebookConfig) %> -- script which causes XFBML to be rendered + + hunk ./examples/Pushups.hs 918 - appTemplate "Create a Challenge" + appTemplate "Create a Challenge"