{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}
module Happstack.Facebook.Feed {-# DEPRECATED "Facebook has deprecated this API http://www.insidefacebook.com/2009/10/23/facebook-changing-feed-story-image-specs-deprecating-some-feed-apis/" #-} where

import Data.Generics (Data, Typeable)
import Data.Ix (Ix)
import qualified Data.Map as Map
import Data.Maybe (catMaybes)
import Happstack.Facebook.Common
import Text.RJson

-- ** Feed

newtype BundleId
    = BundleId { unBundledId :: Integer }
      deriving (Data, Typeable, Eq, Ord, Read, Show, Ix)

instance ToJson BundleId where
    toJson (BundleId bid) = toJson bid

data StorySize
    = OneLine
    | Short
      deriving (Data, Typeable, Read, Show, Eq, Ord, Ix)

instance Enum StorySize where
    succ OneLine = Short
    succ Short = error "tried to take `succ' of maxBound" 
    pred OneLine = error "tried to take `pred` of minBound"
    pred Short = OneLine
    toEnum 1 = OneLine
    toEnum 2 = Short
    fromEnum OneLine = 1
    fromEnum Short   = 2

    enumFrom OneLine = [OneLine, Short]
    enumFrom Short =   [Short]

    enumFromTo from to = takeWhile (<= to) $ enumFrom from

-- |Deactivates a previously registered template bundle
data DeactivateTemplateBundleById
    = DeactivateTemplateBundleById BundleId
      deriving (Data, Typeable, Read, Show, Eq, Ord, Ix)

instance (Monad m) => FacebookMethod m DeactivateTemplateBundleById where
    type FacebookResponse DeactivateTemplateBundleById = Bool
    parseResponse _ = parseResponseBool
    toParams (DeactivateTemplateBundleById (BundleId bid)) =
        return [ ("method","Feed.deactivateTemplateBundleById")
               , ("template_bundle_id", toJsonString bid)
               ]

-- data FeedGetRegisteredTemplateBundles
--    = FeedGetRegisteredTemplateBundles

-- instance FacebookMethod FeedGetRegisteredTemplateBundles where
--    type FacebookResponse FeedGetRegisteredTemplateBundles = [TemplateBundle]

data PublishUserAction 
    = PublishUserAction BundleId (Maybe StorySize) Parameters 
      deriving (Data, Typeable, Read, Show, Eq, Ord)

instance RequiresSession PublishUserAction

instance (HasSessionKey m) => FacebookMethod m PublishUserAction where
    type FacebookResponse PublishUserAction = String
    parseResponse _ = Right . id
    toParams (PublishUserAction (BundleId bid) mStorySize templateData) =
        do sessionKey <- askSessionKey
           return $ catMaybes $
               [ Just ("method", "Feed.publishUserAction")
               , Just ("template_bundle_id", show bid)
               , Just ("template_data", show $ assocToJSON templateData)
               , Just ("session_key", sessionKey)
               , fmap (\size -> ("story_size", show $ fromEnum size)) mStorySize
               ]

-- |FeedData is used to supply data for the feedStory/multiFeedStory callback
-- <http://wiki.developers.facebook.com/index.php/Feed_Forms>
data FeedData 
    = FeedData 
       { target        :: Target 
       , template_id   :: BundleId
       , template_data :: [(String, String)]
       , next          :: String
       }
      deriving (Eq, Ord, Read, Show, Typeable, Data)

data Target = SingleFeed | MultiFeed
      deriving (Eq, Ord, Read, Show, Typeable, Data)

instance ToJson FeedData where
    toJson feedData =
        JDObject $ Map.fromList
                     [ ("method",  toJson (case target feedData of SingleFeed -> "feedStory" ; MultiFeed -> "multiFeedStory")) 
                     , ("content", JDObject $ Map.fromList
                                     [("feed", JDObject $ Map.fromList
                                                 [ ("template_id", toJson (template_id feedData))
                                                 , ("template_data", assocToJSON (template_data feedData))
                                                 ])
                                     , ("next", toJson (next feedData))
                                     ])
                     ]

-- NOTE: there is little reason to supply more than one story per size these days
data TemplateBundle 
    = TemplateBundle
      { oneLineTemplateBundle :: [String]
      , shortTemplateBundle   :: [(Maybe String, String)]
      , actionLinks           :: [ActionLink]
      }
      deriving (Eq, Ord, Read, Show, Typeable, Data)

data RegisterTemplateBundle
    = RegisterTemplateBundle TemplateBundle
      deriving (Eq, Ord, Read, Show, Typeable, Data)

instance (Monad m) => FacebookMethod m RegisterTemplateBundle where
    type FacebookResponse RegisterTemplateBundle = BundleId
    parseResponse _ str = 
        case fromJsonString (undefined :: Integer) str of
          Right bid -> Right (BundleId bid)
          (Left e) -> Left $ "Failed to parse BundleId JSON object: " ++ str
    toParams (RegisterTemplateBundle templateBundle) =
        return $ catMaybes $
           [ Just ("method","Feed.registerTemplateBundle")
           , Just ("one_line_story_templates", toJsonString (oneLineTemplateBundle templateBundle))
           , Just ("short_story_templates", show $ JDArray (flip map (shortTemplateBundle templateBundle) $ 
                                                                 \(mTitle, body) ->
                                                                     JDObject $ Map.fromList $ catMaybes $
                                                                                [ fmap (\title -> ("template_title", toJson title)) mTitle
                                                                                , Just ("template_body", toJson body)
                                                                                ]))
           , if (null $ actionLinks templateBundle) 
              then Nothing 
              else Just ("action_links", show $ JDArray (map actionLinkToJSON $ actionLinks templateBundle))
           ]