{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -F -pgmFtrhsx #-} module Main where import Control.Applicative((<$>)) import Control.Monad(mzero, msum) import Control.Monad.Trans(MonadIO(..), lift) import Happstack.Facebook.Connect import Happstack.Facebook.Common import Happstack.Facebook.XdReceiver import qualified Happstack.Facebook.Friends as Friends import Happstack.Server import Happstack.Facebook.FacebookT import HacketeriaConfig import HSP import qualified HSX.XMLGenerator as HSX import System.Environment (getProgName) import System.FilePath (()) import System.IO (stdout) import System.Log.Logger import System.Log.Handler.Simple -- TODO: expired session key main :: IO () main = do progName <- getProgName setupLogger progName "." Development -- (logs appConf) (logMode appConf) simpleHTTP nullConf impl impl :: ServerPartT IO Response impl = msum [ dir "fbconnect" $ -- FIXME: should come from config msum [ xdReceiverPart , toResponse . FbXML <$> withFacebookConnect facebookConfig (msum [ dir "members" $ do mUser <- fb_user case mUser of Nothing -> mzero (Just user) -> withUser user $ do mSession <- fb_sig_session_key case mSession of Nothing -> mzero (Just sessionKey) -> withSession sessionKey members , homepage ]) ] ] homepage :: (HasFacebookData FacebookConnectData (FacebookT s m), HasFacebookConfig (FacebookT s m), ServerMonad m) => FacebookT s m (HSX.XML (FacebookT s m)) homepage = do config <- askFacebookConfig mUser <- fb_user unXMLGenT $ Welcome to Hacketeria <% case mUser of Nothing -> [ ] (Just u) -> [ ,
, , ] %> members :: (MonadIO m, ServerMonad m) => FacebookT (FacebookStateS FacebookConnectData) m (HSX.XML (FacebookT s m)) members = do config <- askFacebookConfig user <- askUser res <- callMethod (Friends.Get Nothing) case res of (Right friends) -> do friendly <- callMethod (Friends.AreFriends [(user, head friends)]) appUsers <- callMethod Friends.GetAppUsers lists <- callMethod Friends.GetLists pageTemplate
<% mapM (\friend -> ) (take 10 friends) %>
<% show friendly %>

App Users

<% show appUsers %>

Lists

<% show lists %>
(Left e) -> pageTemplate (show e) pageTemplate body = do config <- askFacebookConfig unXMLGenT $ Welcome to Hacketeria <% body %> data LogMode = Production | Development deriving (Read, Show, Eq, Ord, Enum, Bounded) setupLogger :: String -> FilePath -> LogMode -> IO () setupLogger progName logDir logMode = do appLog <- fileHandler (logDir (progName ++ "_root.log")) DEBUG accessLog <- fileHandler (logDir (progName ++ "_access.log")) INFO stdoutLog <- streamHandler stdout DEBUG case logMode of Development -> do -- Root Log updateGlobalLogger rootLoggerName (setLevel DEBUG . setHandlers [appLog, stdoutLog]) -- Access Log updateGlobalLogger "Happstack.Server.AccessLog.Combined" (setLevel INFO . setHandlers [accessLog]) Production -> do -- Root Log updateGlobalLogger rootLoggerName (setLevel INFO . setHandlers [appLog]) -- Access Log updateGlobalLogger "Happstack.Server.AccessLog.Combined" (setLevel INFO . setHandlers [accessLog])