fay-hsx (empty) → 0.1.0
raw patch · 4 files changed
+170/−0 lines, 4 filesdep +fay-basedep +fay-jquerysetup-changed
Dependencies added: fay-base, fay-jquery
Files
- LICENSE +30/−0
- Setup.hs +3/−0
- fay-hsx.cabal +23/−0
- src/HTML.hs +114/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, SeeReason Partners LLC++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 SeeReason Partners LLC 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.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ fay-hsx.cabal view
@@ -0,0 +1,23 @@+name: fay-hsx+version: 0.1.0+synopsis: Clientside HTML generation for fay.+description: This library allows you to write fay code that generates HTML in the browser. It is compatible with the code generated by hsx2hs.+homepage: http://www.happstack.com/+license: BSD3+license-file: LICENSE+copyright: 2013, SeeReason Partners LLC+author: Jeremy Shaw+maintainer: jeremy@n-heptane.com+category: Happstack+build-type: Simple+cabal-version: >=1.8++data-files:+ src/HTML.hs++library+ hs-source-dirs: src+ exposed-modules: HTML++ build-depends: fay-base == 0.14.*,+ fay-jquery == 0.3.*
+ src/HTML.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE NoImplicitPrelude, FlexibleInstances #-}+{- |++A simple library for client-side HTML generation. Compatible with hsx2hs.++-}+module HTML where++import Prelude+import JQuery+import FFI++type Text = String++data Attr a b = a := b+++-- | type class for embedding values as HTML children+--+-- since Fay does not yet support type-class methods we have to fake it via the ffi+class AsChild a -- where asChild :: a -> Fay HTML+instance AsChild [Char] -- where asChild s = return (CDATA True s)+instance AsChild (Fay HTML) -- where asChild = id++-- and here is the scary ffi code.+asChild :: (AsChild a) => a -> Fay HTML+asChild =+ ffi "(function () { if (%1 instanceof Fay$$Cons) { return { 'instance' : 'CDATA', slot1 : true, slot2 : Fay$$fayToJs_string(%1) }; } else { var monad = Fay$$_(%1, true); return monad.value; }})()"++class AsAttr a -- where asAttr :: a -> Fay (String, String)+instance AsAttr (Attr String String) -- where asAttr (a := b) = return (a, b)++asAttr :: (Attr String String) -> Fay (String, String)+asAttr ((:=) a b) = return (a, b)++-- | 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 :: (Maybe String, 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+renderHTML (CDATA True str) =+ selectElement =<< createTextNode str+renderHTML (CDATA False str) =+ do alert "Unsure how to insert pre-escaped text into the generated HTML."+ selectElement =<< createTextNode str++-- | Alert using window.alert.+alert :: String -> Fay ()+alert = ffi "window.alert(%1)"++------------------------------------------------------------------------------+-- HTML Combinators++-- | \<tr\>+tr :: [Fay (String, String)] -- ^ attributes+ -> [Fay HTML] -- ^ children+ -> Fay HTML+tr ats chd = genElement (Nothing, "tr") ats chd++-- | \<td\>+td :: [Fay (String, String)] -- ^ attributes+ -> [Fay HTML] -- ^ children+ -> Fay HTML+td = genElement (Nothing, "td")++-- | \<span\>+span_ :: [Fay (String, String)] -- ^ attributes+ -> [Fay HTML] -- ^ children+ -> Fay HTML+span_ = genElement (Nothing, "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)"++-- | create a new text node+--+-- NOTE: this doesn't really return an Element. It returns a TextNode+-- or something. But fay-jquery only supports the Element type...+createTextNode :: String -- ^ text to insert in the node+ -> Fay Element+createTextNode = ffi "document.createTextNode(%1)"