jmacro-rpc-happstack 0.1 → 0.2

raw patch · 2 files changed

+32/−20 lines, 2 filesdep +aesondep +blaze-htmldep ~jmacrodep ~jmacro-rpcPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, blaze-html

Dependency ranges changed: jmacro, jmacro-rpc

API changes (from Hackage documentation)

Files

• Network/JMacroRPC/Happstack.hs +28/−16
• jmacro-rpc-happstack.cabal +4/−4

@@ -1,5 +1,6 @@-{-# LANGUAGE ScopedTypeVariables, QuasiQuotes, RankNTypes, FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables, QuasiQuotes, RankNTypes, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} + {- | Module      :  Network.JMacroRPC.Happstack Copyright   :  (c) Gershom Bazerman, 2012@@ -19,17 +20,17 @@ > import Control.Concurrent > import Network.JMacroRPC.Base > import Text.XHtml hiding(dir)-> +> > jsScript f = script (primHtml f) ! [thetype "text/javascript"] > jsScript' = jsScript . show . renderJs-> +> > testPage :: IO (ServerPartT IO Response) > testPage = mkConversationPageNoCulling pageFun (newMVar (1::Int)) jRpcs->     where pageFun js = return $ toResponse $ +>     where pageFun js = return $ toResponse $ >                        (header << [script ! [src "https://ajax.googleapis.com/ajax/libs/jquery/1.6.2/jquery.min.js"] << noHtml]) +++ >                        jsScript' js +++->                        jsScript' ([jmacro|$(\ ->                                      {  +>                        jsScript' ([jmacro|$(\+>                                      { >                                            var b = $("<button>click me!</button>"); >                                            $("body").append(b); >                                            b.click(\ {@@ -39,7 +40,7 @@ >                                      }); >                                   |]); >           jRpcs = [getCounterRPC]->           getCounterRPC = +>           getCounterRPC = >               toJsonConvRPC "getCounter" $ \s -> retRight =<< modifyMVar s (\i -> return (i+1,i)) > > retRight :: a -> IO (Either String a)@@ -52,38 +53,49 @@ -}  module Network.JMacroRPC.Happstack where-    + import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read) import Control.Applicative import Control.Monad.Trans import Data.Maybe import Data.Monoid import Network.JMacroRPC.Base+import Network.JMacroRPC.Panels import Happstack.Server import Language.Javascript.JMacro import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as BL import Data.IntMap(IntMap)+import Data.Aeson+import qualified Text.Blaze.Html as H -serveRpcs :: (MonadIO m, Functor m, Monad m) => (Int -> m s) -> [JsonRPC m s] -> ServerPartT m Response+instance (ToJSON b, Monad m, Functor m) => ToJsonRPC (ServerPartT m (Either String b)) (ServerPartT m) where+    toJsonRPC_ f = \ _ -> fmap (fmap toJSON) $ f++serveRpcs :: (MonadIO m, Functor m, Monad m) => (Int -> (ServerPartT m) s) -> [JsonRPC (ServerPartT m) s] -> ServerPartT m Response serveRpcs stateFun rpcs = do   rq <- fromMaybe (BL.empty) . fmap unBody <$> (takeRequestBody =<< askRq)-  toResponseBS (B.pack "application/json") <$> lift (handleRpcs stateFun rpcs rq)+  toResponseBS (B.pack "application/json") <$> (handleRpcs stateFun rpcs rq) -serveSimpleRpcs :: (MonadIO m, Functor m, Monad m) => [JsonRPC m ()] -> ServerPartT m Response++serveSimpleRpcs :: (MonadIO m, Functor m, Monad m) => [JsonRPC (ServerPartT m) ()] -> ServerPartT m Response serveSimpleRpcs rpcs = serveRpcs (const $ return ()) rpcs  -- | This general handler allows explicit culling of conversation state.-mkConversationPage :: forall m s timestamp. (Monad m, Functor m, MonadIO m) => -                            IO timestamp -- ^ Get an abstract timestamp +mkConversationPage :: forall m s timestamp. (Monad m, Functor m, MonadIO m) =>+                            IO timestamp -- ^ Get an abstract timestamp                             -> (IntMap (timestamp,s) -> IO (IntMap (timestamp,s))) -- ^ Cull a map of conversations based on a timestamp-                            -> (JStat -> ServerPartT m Response) -- ^ Take some JMacro Javascript and splice it into some generated page. +                            -> (JStat -> ServerPartT m Response) -- ^ Take some JMacro Javascript and splice it into some generated page.                             -> IO s -- ^ Generate an empty "initial" state for a conversation. States are responsible for using their own MVars or the like to allow sharing.-                            -> [JsonRPC m s] -- ^ JSON RPCs to serve and make available to clientside javascript+                            -> [JsonRPC (ServerPartT m) s] -- ^ JSON RPCs to serve and make available to clientside javascript                             -> IO (ServerPartT m Response) mkConversationPage getStamp cullMap pageFun emptyState rpcs = (\(rpcPage, mainPage) -> dir "jrpcs"  rpcPage `mappend` mainPage) <$> mkConversationPageGen getStamp cullMap serveRpcs pageFun emptyState rpcs  -- | This simple handler allows conversation state to grow without bounds.-mkConversationPageNoCulling :: forall m s. (Monad m, Functor m, MonadIO m) => (JStat -> ServerPartT m Response) -> IO s -> [JsonRPC m s] -> IO (ServerPartT m Response)+mkConversationPageNoCulling :: forall m s. (Monad m, Functor m, MonadIO m) => (JStat -> ServerPartT m Response) -> IO s -> [JsonRPC (ServerPartT m) s] -> IO (ServerPartT m Response) mkConversationPageNoCulling pageFun emptyState rpcs = mkConversationPage (return ()) return pageFun emptyState rpcs +-- | Render a Panel as a @ServerPartT m Response@.+panelToPage :: (Monad m, Functor m, MonadIO m) => String -> Panel (ServerPartT m) -> ServerPartT m Response+panelToPage title p = dir "jrpcs" updateHandler `mappend` drawHandler+    where (updateHandler, drawHandler) = panelToPageGen (serveRpcs $ const (return ())) (return . toResponse . H.preEscapedToHtml) title p

@@ -1,20 +1,20 @@ Name:                jmacro-rpc-happstack-Version:             0.1+Version:             0.2 Homepage:            http://patch-tag.com/r/gershomb/jmacro-rpc License:             BSD3 License-file:        LICENSE Author:              Gershom Bazerman Maintainer:          gershomb@gmail.com-Category:            Network+Category:            Network, Web Build-type:          Simple Cabal-version:       >=1.6 Synopsis:            Happstack backend for jmacro-rpc-Description:         Provides functions for serving jmacro-rpc json rpcs from Happstack.+Description:         Provides functions for serving jmacro-rpc json rpcs and panels from Happstack.  Library   Exposed-modules: Network.JMacroRPC.Happstack   -  Build-depends: base >= 4, base < 7, bytestring > 0.9, jmacro > 0.5, happstack-server > 6, jmacro-rpc >= 0.1, mtl >= 2, containers >= 0.4+  Build-depends: base >= 4, base < 7, bytestring > 0.9, jmacro > 0.6, happstack-server > 6, jmacro-rpc >= 0.2, mtl >= 2, containers >= 0.4, aeson >= 0.6, blaze-html >= 0.5    ghc-options: -Wall