{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS_GHC -F -pgmFtrhsx #-}
module Main where
import Control.Applicative
import Control.Concurrent (forkIO, killThread)
import Control.Monad (MonadPlus(mzero), msum)
import Control.Monad.Trans (lift, MonadIO(liftIO))
import Happstack.State (waitForTermination)
import Happstack.Server
import HSP
import qualified HSX.XMLGenerator as HSX
import Happstack.Facebook.Application
import Happstack.Facebook.Common
import Happstack.Facebook.FacebookT
import qualified Happstack.Facebook.Feed as Feed
-- import Config (facebookConfig) -- you need to edit Config.hs first and add your app information
import HacketeriaConfig
import Text.RJson (fromJsonString)
conf :: Conf
conf = nullConf { port = 8000 }
main :: IO ()
main =
do tid <- forkIO $ simpleHTTP conf (impl facebookConfig)
putStrLn "running..."
waitForTermination
killThread tid
impl :: FacebookConfig -> ServerPartT IO Response
impl fbConfig = msum
[ withRequest $ \rq -> liftIO (print rq) >> mzero -- prints out the requests for debug purposes
, ok =<< toResponse <$> facebook fbConfig
{-
withUser $
withSession hello
-}
{-
, withFacebook fbConfig $ ok . toResponse =<< unXMLGenT hello
-- anyRequest $ ok . toResponse =<< unXMLGenT hello
-- , debug404
-}
]
facebook :: FacebookConfig -> ServerPartT IO FbXML
facebook fbConfig =
withFacebook fbConfig (lift user)
-- user :: (HasFacebookConfig m, HasFacebookData m) => m (IO FbXML)
user :: FacebookT FacebookState IO FbXML
user =
do mRes <- withUser $ session
case mRes of
(Just part) ->
do res <- liftIO part
return res
session :: FacebookT FacebookStateU IO FbXML
session =
do mRes <- withSession hello
case mRes of
(Just part) ->
do res <- liftIO part
return res
-- hello :: Facebook XML
-- hello :: (HasSessionKey m, MonadIO m, HasFacebookConfig m, XMLGenerator m) => XMLGenT m (HSX.XML m)
hello :: FacebookT FacebookStateS IO FbXML --
hello = FbXML <$> (unXMLGenT $
do res <- lift (callMethodE (Feed.PublishUserAction (bundles!!0) Nothing []))
{-
You <% fb_sig_added >>= \r -> return (if r then " have " else " have not ") %> added my app.
Your name is .
You look like this:
Your session key is <% fb_sig_session_key >>= return . show %>
Please let us set your status! Please!!
-}
-- Updating your status returned: <% callMethod (StatusSet"is hoping this works.") %>
Publishing a one-lines story returned. <% show res %>
-- <% friendPics %>
)
-- friendPics :: (Monad m) => FacebookT FacebookState (XMLGenT m [XML]
friendPics :: (MonadIO m, HasFacebookConfig m, XMLGenerator m) => XMLGenT m [HSX.XML m]
friendPics =
do res <- lift $ execRequest =<< buildRequestM [ ("method", "friends.get") ]
let (Right uids) = fromJsonString (undefined :: [Integer]) res
mapM (\uid -> ) uids