jmacro-rpc-snap (empty) → 0.1
raw patch · 4 files changed
+146/−0 lines, 4 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, containers, jmacro, jmacro-rpc, mtl, snap-core
Files
- LICENSE +30/−0
- Network/JMacroRPC/Snap.hs +91/−0
- Setup.hs +2/−0
- jmacro-rpc-snap.cabal +23/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2011, Gershom Bazerman++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Gershom Bazerman nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/JMacroRPC/Snap.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE ScopedTypeVariables, QuasiQuotes, FlexibleInstances, MultiParamTypeClasses #-}++{- |+Module : Network.JMacroRPC.Snap+Copyright : (c) Gershom Bazerman, 2012+License : BSD 3 Clause+Maintainer : gershomb@gmail.com+Stability : experimental++Snap backend for JMacro-RPC.++Example usage:++> {-# LANGUAGE QuasiQuotes #-}+> module Main where+> import Network.JMacroRPC.Snap+> import Snap.Http.Server+> import Snap.Core+> import Language.Javascript.JMacro+> import Control.Concurrent+> import Control.Monad.Trans+> import Network.JMacroRPC.Base+> import Text.XHtml hiding(dir)+> import qualified Data.Text as T+> +> jsScript f = script (primHtml f) ! [thetype "text/javascript"]+> jsScript' = jsScript . show . renderJs+> +> testPage = mkConversationPageNoCulling pageFun (newMVar (1::Int)) jRpcs+> where pageFun :: JStat -> Snap ()+> pageFun js = writeText $ T.pack $ show $ +> (header << [script ! [src "https://ajax.googleapis.com/ajax/libs/jquery/1.6.2/jquery.min.js"] << noHtml]) ++++> jsScript' js ++++> jsScript' ([jmacro|$(\ +> { +> var b = $("<button>click me!</button>");+> $("body").append(b);+> b.click(\ {+> var c = getCounter();+> alert ("counter is: " + c);+> });+> });+> |]);+> jRpcs = [getCounterRPC]+> getCounterRPC = +> toJsonConvRPC "getCounter" $ \s -> (liftIO $ retRight =<< modifyMVar s (\i -> return (i+1,i)) :: Snap (Either String Int))+> +> retRight :: a -> IO (Either String a)+> retRight = return . Right+> +> main = quickHttpServe =<< testPage++Every invocation of this page (including from the same browser) will have a distinct, stateful, counter, stored server-side.++-}+++module Network.JMacroRPC.Snap where+ +import Prelude hiding (tail, init, head, last, minimum, maximum, foldr1, foldl1, (!!), read)+import Control.Applicative+import Network.JMacroRPC.Base+import Data.Aeson+import Language.Javascript.JMacro+import qualified Data.ByteString.Char8 as B+import Data.IntMap(IntMap)+import Snap.Core++instance (ToJSON b) => ToJsonRPC (Snap (Either String b)) Snap where+ toJsonRPC_ f = \ _ -> fmap (fmap toJSON) $ f ++-- | Provide a set of json rpcs.+serveRpcs :: MonadSnap m => (Int -> m s) -> [JsonRPC m s] -> m ()+serveRpcs stateFun rpcs = do+ rq <- readRequestBody maxBound+ modifyResponse $ setContentType (B.pack "application/json")+ writeLBS =<< handleRpcs stateFun rpcs rq++-- | This general handler allows explicit culling of conversation state.+mkConversationPage :: (MonadSnap m) => + IO timestamp -- ^ Get an abstract timestamp + -> (IntMap (timestamp,s) -> IO (IntMap (timestamp,s))) -- ^ Cull a map of conversations based on a timestamp+ -> (JStat -> m ()) -- ^ 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+ -> IO (m ())+mkConversationPage getStamp cullMap pageFun emptyState rpcs = (\(rpcPage, mainPage) -> dir (B.pack "jrpcs") rpcPage <|> mainPage) <$> mkConversationPageGen getStamp cullMap serveRpcs pageFun emptyState rpcs++-- | This simple handler allows conversation state to grow without bounds.+mkConversationPageNoCulling :: (MonadSnap m) => (JStat -> m ()) -> IO s -> [JsonRPC m s] -> IO (m ())+mkConversationPageNoCulling pageFun emptyState rpcs = mkConversationPage (return ()) return pageFun emptyState rpcs
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ jmacro-rpc-snap.cabal view
@@ -0,0 +1,23 @@+Name: jmacro-rpc-snap+Version: 0.1+Homepage: http://patch-tag.com/r/gershomb/jmacro-rpc+License: BSD3+License-file: LICENSE+Author: Gershom Bazerman+Maintainer: gershomb@gmail.com+Category: Network+Build-type: Simple+Cabal-version: >=1.6+Synopsis: Snap backend for jmacro-rpc+Description: Provides functions for serving jmacro-rpc json rpcs from Snap.++Library+ Exposed-modules: Network.JMacroRPC.Snap+ + Build-depends: base >= 4, base < 7, bytestring > 0.9, jmacro > 0.5, jmacro-rpc >= 0.1, mtl >= 2, containers >= 0.4, snap-core >= 0.8, aeson >= 0.5++ ghc-options: -Wall + +source-repository head+ type: darcs+ location: http://patch-tag.com/r/gershomb/jmacro-rpc