happstack-facebook 0.16 → 0.21
raw patch · 4 files changed
+36/−15 lines, 4 filesdep +textdep +web-routesdep +web-routes-mtldep −URLT
Dependencies added: text, web-routes, web-routes-mtl
Dependencies removed: URLT
Files
- Happstack/Facebook/Common.hs +7/−6
- Happstack/Facebook/FacebookT.hs +24/−3
- Happstack/Facebook/Formlets.hs +3/−4
- happstack-facebook.cabal +2/−2
Happstack/Facebook/Common.hs view
@@ -33,7 +33,8 @@ import Network.URI import System.Time (ClockTime(TOD),getClockTime) import Text.RJson -- FIXME: use different JSON library?-import URLT(URLT)+import Web.Routes.RouteT(RouteT)+import Web.Routes.MTL data FacebookConfig = FacebookConfig { apiKey :: ApiKey@@ -194,18 +195,18 @@ instance (HasSessionKey m) => HasSessionKey (ServerPartT m) where askSessionKey = lift askSessionKey --- ** URLT+-- ** RouteT -instance (HasFacebookData d m) => HasFacebookData d (URLT u m) where+instance (HasFacebookData d m) => HasFacebookData d (RouteT u m) where askFacebookData = lift askFacebookData -instance (HasFacebookConfig m) => HasFacebookConfig (URLT url m) where+instance (HasFacebookConfig m) => HasFacebookConfig (RouteT url m) where askFacebookConfig = lift askFacebookConfig -instance (HasUser m) => HasUser (URLT url m) where+instance (HasUser m) => HasUser (RouteT url m) where askUser = lift askUser -instance (HasSessionKey m) => HasSessionKey (URLT url m) where+instance (HasSessionKey m) => HasSessionKey (RouteT url m) where askSessionKey = lift askSessionKey assocToJSON :: [(String, String)] -> JsonData
Happstack/Facebook/FacebookT.hs view
@@ -3,15 +3,19 @@ module Happstack.Facebook.FacebookT where import HSP+import HSP.XML.PCDATA(escaper)+import HSP.HTML (htmlEscapeChars) import Control.Applicative (Applicative((<*>), pure), Alternative((<|>), empty), WrappedMonad(WrapMonad, unwrapMonad), (<$>)) import Control.Monad.Identity import Control.Monad.Reader import Control.Monad.Writer import Control.Monad.State import Data.List (intersperse)+import qualified Data.Text as T+import qualified Data.Text.Lazy as TL import qualified HSX.XMLGenerator as HSX import Happstack.Server (ServerMonad(askRq, localRq), ServerPartT, FilterMonad(setFilter,composeFilter,getFilter), WebMonad(finishWith), mapServerPartT)-import URLT (ShowURL(showURL), URL)+import Web.Routes.RouteT (ShowURL(showURL), URL) newtype FacebookT s m a = FacebookT { unFacebookT :: ReaderT s m a }@@ -100,7 +104,12 @@ (CDATA e1 s1, CDATA e2 s2) | e1 == e2 -> flP (CDATA e1 (s1++s2) : xs) bs _ -> flP (y:xs) (x:bs) +instance (Monad m, Functor m) => IsAttrValue (FacebookT s m) T.Text where+ toAttrValue = toAttrValue . T.unpack +instance (Monad m, Functor m) => IsAttrValue (FacebookT s m) TL.Text where+ toAttrValue = toAttrValue . TL.unpack+ instance (Monad m) => HSX.EmbedAsAttr (FacebookT s m) Attribute where asAttr = return . (:[]) . FAttr @@ -120,12 +129,24 @@ instance (Monad m) => HSX.EmbedAsAttr (FacebookT s m) (Attr String Int) where asAttr (n := i) = asAttr $ MkAttr (toName n, pAttrVal (show i)) +instance (Monad m, Functor m, IsName n) => (EmbedAsAttr (FacebookT s m) (Attr n TL.Text)) where+ asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal $ TL.unpack a)++instance (Monad m, Functor m, IsName n) => (EmbedAsAttr (FacebookT s m) (Attr n T.Text)) where+ asAttr (n := a) = asAttr $ MkAttr (toName n, pAttrVal $ T.unpack a)+ instance (Monad m) => EmbedAsChild (FacebookT s m) Char where asChild = XMLGenT . return . (:[]) . FChild . pcdata . (:[]) instance (Monad m) => EmbedAsChild (FacebookT s m) String where asChild = XMLGenT . return . (:[]) . FChild . pcdata +instance (Monad m, Functor m) => (EmbedAsChild (FacebookT s m) TL.Text) where+ asChild = asChild . TL.unpack++instance (Monad m, Functor m) => (EmbedAsChild (FacebookT s m) T.Text) where+ asChild = asChild . T.unpack+ instance (Monad m) => EmbedAsChild (FacebookT s m) XML where asChild = XMLGenT . return . (:[]) . FChild @@ -161,7 +182,7 @@ data TagType = Open | Close | Single renderAsFBML' :: Int -> XML -> ShowS-renderAsFBML' _ (CDATA needsEscape cd) = showString (if needsEscape then escape cd else cd)+renderAsFBML' _ (CDATA needsEscape cd) = showString (if needsEscape then (escaper htmlEscapeChars cd) else cd) -- renderAsFBML' n (Element name attrs []) = renderTag Single n name attrs renderAsFBML' n elm@(Element name@(Nothing, nm) attrs children) | nm == "area" = renderTagEmpty children@@ -211,7 +232,7 @@ renderAttr :: Attribute -> ShowS- renderAttr (MkAttr (nam, (Value needsEscape val))) = showName nam . showChar '=' . renderAttrVal (if needsEscape then escape val else val)+ renderAttr (MkAttr (nam, (Value needsEscape val))) = showName nam . showChar '=' . renderAttrVal (if needsEscape then (escaper htmlEscapeChars val) else val) renderAttrVal :: String -> ShowS renderAttrVal s = showChar '\"' . showString s . showChar '\"'
Happstack/Facebook/Formlets.hs view
@@ -22,15 +22,14 @@ -- ^ turn a formlet into XML+ServerPartT which can be embedded in a larger document formletPart :: (EmbedAsChild m xml, EmbedAsAttr m (Attr String String), MonadIO m, Functor m, ToMessage b, FilterMonad Response m, WebMonad Response m, MonadPlus m, ServerMonad m) - => String -- ^ prefix used to ensure field names are unique- -> String -- ^ url to POST form results to+ => String -- ^ url to POST form results to -> (a -> XMLGenT m b) -- ^ handler used when form validates -> ([ErrorMsg] -> [XMLGenT m (HSX.XML m)] -> XMLGenT m b) -- ^ handler used when form does not validate -> Form xml IO a -- ^ the formlet -> XMLGenT m (HSX.XML m)-formletPart prefix action handleSuccess handleFailure form = +formletPart action handleSuccess handleFailure form = withDataFn lookPairs $ \env ->- let (collector, formXML,_) = runFormState (map (second Left) env) prefix form+ let (collector, formXML,_) = runFormState (map (second Left) env) form in msum [ dir "submit" $ methodSP POST $ XMLGenT $ Happstack.escape . fmap toResponse $ unXMLGenT $ do res <- liftIO collector
happstack-facebook.cabal view
@@ -1,5 +1,5 @@ Name: happstack-facebook-Version: 0.16+Version: 0.21 License: BSD3 License-file: debian/copyright Author: jeremy@seereason.com@@ -20,7 +20,7 @@ Default: False Library- Build-Depends: base, hsp >= 0.4.4, harp >= 0.4, happstack-ixset, happstack-data, happstack-util, mtl, random, happstack-state, html, happstack-server, hsx >= 0.4.4, applicative-extras >= 0.1.3, utf8-string, bytestring, RJson, old-time, network, HTTP >= 4000, time, containers, happstack, json, URLT >= 0.10, filepath+ Build-Depends: base, hsp >= 0.4.4, harp >= 0.4, happstack-ixset, happstack-data, happstack-util, mtl, random, happstack-state, html, happstack-server, hsx >= 0.4.4, applicative-extras >= 0.1.3, utf8-string, bytestring, RJson, old-time, network, HTTP >= 4000, time, containers, happstack, json, web-routes >= 0.20, web-routes-mtl, filepath, text if flag(base4) Build-Depends: base >= 4 && < 5, syb Extensions: MultiParamTypeClasses,