{-# 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 FacebookConfig (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 (do user <- askUser
appTemplate "Members Area" ()
Welcome to the Members Area
Hello, .
You look like this .
)
, 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 =
<% headers %>
<% title %>
<% fbFeatureLoader %> -- enables XFBML, Facebook Javascript calls, etc
<% body %>
<% fbInit =<< (apiKey <$> askFacebookConfig) %> -- script which causes XFBML to be rendered