Happstack/Facebook/XdReceiver.hs

{-# OPTIONS_GHC -F -pgmFtrhsx #-}
module Happstack.Facebook.XdReceiver where

import Control.Applicative((<$>))
import Control.Monad (MonadPlus(..))
import Control.Monad.Trans(MonadIO(..))
import Happstack.Server (ServerMonad(..), Response, dir)
import HSP
import Happstack.Server.HSP.HTML (webHSP)
import Happstack.Facebook.Common
import qualified HSX.XMLGenerator as HSX
import Network.URI (uriPath)
import System.FilePath ((</>), splitPath)

xdReceiverPart :: (MonadIO m, MonadPlus m, ServerMonad m, HasFacebookConfig m) => m Response
xdReceiverPart =
    do config <- askFacebookConfig
       let parts = case splitPath $ uriPath (connectURL config) of
                    ("/": rest) -> rest
                    o           -> o
       dirs parts $ dir "xd_receiver.htm" $ webHSP xdReceiverXML
    where
      dirs :: (ServerMonad m, MonadPlus m) => [String] -> m a -> m a
      dirs []     m = m
      dirs (d:ds) m = dir d $ dirs ds m

--    <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
xdReceiverXML :: (XMLGenerator m) => XMLGenT m (HSX.XML m)
xdReceiverXML =
    <html>
     <body>
      <script src="http://static.ak.connect.facebook.com/js/api_lib/v0.4/XdCommReceiver.js" type="text/javascript"></script>
     </body>
    </html>

fbInit :: (XMLGenerator m, HasFacebookConfig m ) => ApiKey -> XMLGenT m (HSX.XML m)
fbInit (ApiKey apiKey) = 
    do config <- askFacebookConfig
       let path = (uriPath (connectURL config)) </> "xd_receiver.htm" 
       <script type="text/javascript">
          FB.init("<% apiKey %>", "<% path %>");
        </script>

fbFeatureLoader :: (XMLGenerator m) => XMLGenT m (HSX.XML m)
fbFeatureLoader =
    <script src="http://static.ak.connect.facebook.com/js/api_lib/v0.4/FeatureLoader.js.php/en_US" type="text/javascript"></script>