happstack-fay (empty) → 0.1.0.0
raw patch · 6 files changed
+299/−0 lines, 6 filesdep +aesondep +basedep +faysetup-changed
Dependencies added: aeson, base, fay, fay-jquery, happstack-server
Files
- Happstack/Fay.hs +81/−0
- LICENSE +30/−0
- Language/Fay/AJAX.hs +82/−0
- Language/Fay/HTML.hs +75/−0
- Setup.hs +2/−0
- happstack-fay.cabal +29/−0
+ Happstack/Fay.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}+{- |++The server-side half of a typed AJAX communication channel.++To use this library, you could start by defining a type in a file that+can be shared between the Haskell Server and Fay client. For example:++@+ data Command+ = SendGuess Guess (ResponseType (Maybe Row))+ | FetchBoard (ResponseType (Maybe Board))+ deriving (Read, Show, Data, Typeable)+ instance Foreign Command+@++The 'ResponseType' argument specifies what type each command should+return. Using GADTs would be cleaner, but Fay does not support GADTs+yet.++In the server, you would then have a route that handles ajax requests such as:++@+ , dir "ajax" $ handleCommand (commandR acid)+@++@commandR@ would then call functions to handle the various requests:++@+-- | handle an AJAX request+commandR :: AcidState Games+ -> Command+ -> ServerPart Response+commandR acid cmd =+ case cmd of+ (SendGuess guess rt) -> fayResponse rt $ sendGuessC acid guess+ (FetchBoard rt) -> fayResponse rt $ fetchBoardC acid+@++@commandR@ uses 'fayResponse' to convert the value returned by each+command handler to a valid Fay value. Note that it takes+'ResponseType' argument and passes it to 'fayResponse'. This is how we+ensure that each commend handler is returning the right type.++See also "Language.Fay.AJAX".++-}+module Happstack.Fay where++import Data.Aeson+import Data.Data+import Happstack.Server+import Language.Fay.AJAX+import Language.Fay.Convert++-- | decode the 'cmd' and call the response handler.+--+-- See also: 'fayResponse'+handleCommand :: (Data cmd, Show cmd, Happstack m) =>+ (cmd -> m Response)+ -> m Response+handleCommand handler =+ do json <- lookBS "json"+ let val = (decode' json)+ mCmd = readFromFay =<< val+ case mCmd of+ Nothing -> badRequest $ toResponse ("Failed to turn this into a command: " ++ show (val))+ (Just cmd) -> handler cmd++-- | convert the return value to a fay response.+--+fayResponse :: (Happstack m, Show a) =>+ ResponseType a -- ^ used to help the type-checker enforce type safety+ -> m a -- ^ handler that calculates a response+ -> m Response+fayResponse _rt m =+ do a <- m+ case showToFay a of+ Nothing -> internalServerError $ toResponse ("showToFay failed to convert response." :: String)+ (Just json) ->+ ok $ toResponseBS "application/json;charset=UTF-8" $ encode json
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2012, Jeremy Shaw++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 Jeremy Shaw 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.
+ Language/Fay/AJAX.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE DeriveDataTypeable, NoImplicitPrelude #-}+{- |++client-side half of a typed AJAX communication channel.++To use this library, you could start by defining a type in a file that+can be shared between the Haskell Server and Fay client. For example:++@+ data Command+ = SendGuess Guess (ResponseType (Maybe Row))+ | FetchBoard (ResponseType (Maybe Board))+ deriving (Read, Show, Data, Typeable)+ instance Foreign Command+@++The 'ResponseType' argument specifies what type each command should+return. Using GADTs would be cleaner, but Fay does not support GADTs+yet.++To execute a remote function we use the 'call' function:++@+ call "/ajax" FetchBoard $ \mboard -> ...+@++Due to the single-threaded nature of Javascript, we do not want to+block until the 'call' returns a value, so we perform the AJAX request+asynchronously. The third argument to 'call' is the callback function+to run when the response is received.++See also: "Happstack.Fay"++-}+module Language.Fay.AJAX where++import Language.Fay.FFI+import Language.Fay.Prelude++-- | 'ResponseType' is used in lieu of `GADTs` as a mechanism for+-- specifying the expected return type of remote AJAX calls.+data ResponseType a = ResponseType+ deriving (Eq, Read, Show, Data, Typeable)+instance Foreign (ResponseType a)++-- | Asynchronously call a command+--+-- Note: if the server returns 404 or some other non-success exit+-- code, the callback function will never be run.+--+-- This function is just a wrapper around 'ajaxCommand' which uses the+-- 'ResponseType res' phantom-typed parameter for added type safety.+call :: (Foreign cmd, Foreign res) =>+ String -- ^ URL to 'POST' AJAX request to+ -> (ResponseType res -> cmd) -- ^ AJAX command to send to server+ -> (res -> Fay ()) -- ^ callback function to handle response+ -> Fay ()+call uri f g =+ ajaxCommand uri (f ResponseType) g++-- | Run the AJAX command. (internal)+--+-- You probably want to use 'call' which provides additional+-- type-safety.+--+-- Note: if the server returns 404 or some other non-success exit+-- code, the callback function will never be run.+--+-- see also: 'call'+ajaxCommand :: (Foreign cmd, Foreign res) =>+ String+ -> cmd+ -> (res -> Fay ())+ -> Fay ()+ajaxCommand =+ ffi "jQuery['ajax']({\+ \ \"url\": %1, \+ \ \"type\": 'POST', \+ \ \"data\": { \"json\": JSON.stringify(%2) }, \+ \ \"dataType\": 'json', \+ \ \"success\" : %3 \+ \})"
+ Language/Fay/HTML.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE NoImplicitPrelude #-}+{- |++A simple library for client-side HTML generation.++-}+module Language.Fay.HTML where++import Language.Fay.FFI+import Language.Fay.Prelude+import Language.Fay.JQuery+++-- | ADT for 'HTML'+data HTML+ = Element String [(String, String)] [HTML] -- ^ Element name attributes children+ | CDATA Bool String -- ^ CDATA needEscaping value++-- | generate an HTML element+genElement :: String -- ^ Element name+ -> [Fay (String, String)] -- ^ list of attributes+ -> [Fay HTML] -- ^ list of children+ -> Fay HTML+genElement n genAttrs genChildren =+ do attrs <- sequence $ genAttrs+ children <- sequence $ genChildren+ return (Element n attrs children)++-- | render the 'HTML' into a JQuery DOM tree. You still need to+-- append the result somewhere.+--+-- NOTE: This function requires 'jQuery'+renderHTML :: HTML+ -> Fay JQuery+renderHTML (Element n attrs children) =+ do elem <- selectElement =<< createElement n+ mapM_ (\(n, v) -> setAttr n v elem) attrs+ mapM_ (\child ->+ do cElem <- renderHTML child+ append cElem elem) children+ return elem++------------------------------------------------------------------------------+-- HTML Combinators++-- | \<tr\>+tr :: [Fay (String, String)] -- ^ attributes+ -> [Fay HTML] -- ^ children+ -> Fay HTML+tr = genElement "tr"++-- | \<td\>+td :: [Fay (String, String)] -- ^ attributes+ -> [Fay HTML] -- ^ children+ -> Fay HTML+td = genElement "td"++-- | \<span\>+span :: [Fay (String, String)] -- ^ attributes+ -> [Fay HTML] -- ^ children+ -> Fay HTML+span = genElement "span"++-- | create a text node from the 'String'. The 'String' will be+-- automatically escaped.+pcdata :: String -> Fay HTML+pcdata = return . CDATA True++------------------------------------------------------------------------------+-- HTML Combinators++-- | create a new 'Element'+createElement :: String -- ^ name of the element+ -> Fay Element+createElement = ffi "document.createElement(%1)"
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ happstack-fay.cabal view
@@ -0,0 +1,29 @@+name: happstack-fay+version: 0.1.0.0+synopsis: Support for using Fay with Happstack+description: Fay is strict subset of Happstack which can be compiled+ to Javascript. This library provides some utilities for client-server+ communication, client-side HTML generation, and more.+homepage: http://www.happstack.com/+license: BSD3+license-file: LICENSE+author: Jeremy Shaw+maintainer: jeremy@n-heptane.com+category: Happstack+build-type: Simple+cabal-version: >=1.8++data-files:+ Language/Fay/AJAX.hs,+ Language/Fay/HTML.hs++library+ exposed-modules: Language.Fay.AJAX,+ Language.Fay.HTML,+ Happstack.Fay,+ Paths_happstack_fay+ build-depends: base > 4 && <5,+ fay == 0.9.*,+ fay-jquery == 0.1.*,+ aeson == 0.6.*,+ happstack-server >= 7.0 && <7.2