haste-perch 0.1.0.4 → 0.1.0.5

raw patch · 4 files changed

+431/−42 lines, 4 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• Haste/App/Perch.hs +334/−0
• Haste/Perch.hs +37/−4
• README.md +27/−5
• haste-perch.cabal +33/−33

@@ -0,0 +1,334 @@+-----------------------------------------------------------------------------
+--
+-- Module      :  Builder
+-- Copyright   :
+-- License     :  BSD3
+--
+-- Maintainer  :  agocorona@gmail.com
+-- Stability   :  experimental
+-- Portability :
+--
+-- | Monad and Monoid instances for a builder that hang DOM elements from the
+-- current parent element. It uses Haste.DOM from the haste-compiler
+-- This is the version for the Client Monad
+--
+-----------------------------------------------------------------------------
+{-#LANGUAGE CPP, ForeignFunctionInterface, TypeSynonymInstances, FlexibleInstances
+             , DeriveDataTypeable, UndecidableInstances
+            , OverlappingInstances #-}
+module Haste.App.Perch where
+import Data.Typeable
+import Haste.App
+import Haste.Foreign
+import Data.Maybe
+import Data.Monoid
+import Unsafe.Coerce
+import Data.String
+import Control.Monad.IO.Class
+import Control.Applicative
+
+
+newtype PerchM a= Perch{build :: Elem -> Client Elem} deriving Typeable
+
+type Perch = PerchM ()
+
+instance Monoid (PerchM a) where
+    mappend mx my= Perch $ \e -> do
+         build mx e
+         build my e
+         return e
+    mempty  = Perch return
+
+instance Functor PerchM
+instance Applicative PerchM
+
+instance Monad PerchM where
+   (>>) x y= mappend (unsafeCoerce x) y
+   (>>=) = error "bind (>>=) invocation in the Perch monad creating DOM elements"
+   return  = mempty
+
+instance MonadIO PerchM where
+  liftIO mx= Perch $ \e ->  liftIO mx >> return e
+
+instance IsString Perch where
+  fromString= toElem
+
+class ToElem a where
+  toElem :: a -> Perch
+
+instance ToElem String where
+   toElem s= Perch $ \e -> do
+        e' <- newTextElem s
+        addChild e' e
+        return e'
+
+instance Show a => ToElem a where toElem = toElem . show
+
+instance ToElem (PerchM a) where toElem e = unsafeCoerce e
+
+attr tag (n, v)=Perch $ \e -> do
+        tag' <- build tag e
+        setAttr tag' n v
+        return tag'
+
+nelem :: String -> Perch
+nelem s= Perch $ \e ->do
+        e' <- newElem s
+        addChild e' e
+        return e'
+
+child :: ToElem a => Perch -> a -> Perch
+child me ch= Perch $ \e' -> do
+        e <- build me e'
+        let t = toElem ch
+        r <- build t e
+        return e
+
+setHtml :: Perch -> String -> Perch
+setHtml me text= Perch $ \e' -> do
+    e <- build me e'
+    inner e text
+    return e'
+  where
+  inner :: Elem -> String -> Client ()
+  inner e txt = setProp e "innerHTML" txt
+
+-- | create an element and add a Haste event handler to it.
+addEvent :: ClientCallback a => Perch -> Event Client a -> a -> Perch
+addEvent be event action= Perch $ \e -> do
+     e' <- build be e
+     let atr= evtName event
+     has <- getAttr e'  atr
+     case has of
+       "true" -> return e'
+       _ -> do
+        onEvent e' event  action
+        setAttr e' atr "true"
+        return e'
+
+
+
+instance JSType JSString where
+  toJSString x= x
+  fromJSString x= Just x
+
+
+
+
+
+-- Leaf DOM nodes
+--
+area = nelem "area"
+base = nelem "base"
+br = nelem "br"
+col = nelem "col"
+embed = nelem "embed"
+hr = nelem "hr"
+img = nelem "img"
+input = nelem "input"
+keygen = nelem "keygen"
+link = nelem "link"
+menuitem = nelem "menuitem"
+meta = nelem "meta"
+param = nelem "param"
+source = nelem "source"
+track = nelem "track"
+wbr = nelem "wbr"
+
+-- Parent DOM nodes
+--
+
+a cont = nelem  "a" `child` cont
+abbr cont = nelem  "abbr" `child` cont
+address cont = nelem  "address" `child` cont
+article cont = nelem  "article" `child` cont
+aside cont = nelem  "aside" `child` cont
+audClient cont = nelem  "audio" `child` cont
+b cont = nelem  "b" `child` cont
+bdo cont = nelem  "bdo" `child` cont
+blockquote cont = nelem  "blockquote" `child` cont
+body cont = nelem  "body" `child` cont
+button cont = nelem  "button" `child` cont
+canvas cont = nelem  "canvas" `child` cont
+caption cont = nelem  "caption" `child` cont
+cite cont = nelem  "cite" `child` cont
+code cont = nelem  "code" `child` cont
+colgroup cont = nelem  "colgroup" `child` cont
+command cont = nelem  "command" `child` cont
+datalist cont = nelem  "datalist" `child` cont
+dd cont = nelem  "dd" `child` cont
+del cont = nelem  "del" `child` cont
+details cont = nelem  "details" `child` cont
+dfn cont = nelem  "dfn" `child` cont
+div cont = nelem  "div" `child` cont
+dl cont = nelem  "dl" `child` cont
+dt cont = nelem  "dt" `child` cont
+em cont = nelem  "em" `child` cont
+fieldset cont = nelem  "fieldset" `child` cont
+figcaption cont = nelem  "figcaption" `child` cont
+figure cont = nelem  "figure" `child` cont
+footer cont = nelem  "footer" `child` cont
+form cont = nelem  "form" `child` cont
+h1 cont = nelem  "h1" `child` cont
+h2 cont = nelem  "h2" `child` cont
+h3 cont = nelem  "h3" `child` cont
+h4 cont = nelem  "h4" `child` cont
+h5 cont = nelem  "h5" `child` cont
+h6 cont = nelem  "h6" `child` cont
+head cont = nelem  "head" `child` cont
+header cont = nelem  "header" `child` cont
+hgroup cont = nelem  "hgroup" `child` cont
+html cont = nelem  "html" `child` cont
+i cont = nelem  "i" `child` cont
+iframe cont = nelem  "iframe" `child` cont
+ins cont = nelem  "ins" `child` cont
+kbd cont = nelem  "kbd" `child` cont
+label cont = nelem  "label" `child` cont
+legend cont = nelem  "legend" `child` cont
+li cont = nelem  "li" `child` cont
+map cont = nelem  "map" `child` cont
+mark cont = nelem  "mark" `child` cont
+menu cont = nelem  "menu" `child` cont
+meter cont = nelem  "meter" `child` cont
+nav cont = nelem  "nav" `child` cont
+noscript cont = nelem  "noscript" `child` cont
+object cont = nelem  "object" `child` cont
+ol cont = nelem  "ol" `child` cont
+optgroup cont = nelem  "optgroup" `child` cont
+option cont = nelem  "option" `child` cont
+output cont = nelem  "output" `child` cont
+p cont = nelem  "p" `child` cont
+pre cont = nelem  "pre" `child` cont
+progress cont = nelem  "progress" `child` cont
+q cont = nelem  "q" `child` cont
+rp cont = nelem  "rp" `child` cont
+rt cont = nelem  "rt" `child` cont
+ruby cont = nelem  "ruby" `child` cont
+samp cont = nelem  "samp" `child` cont
+script cont = nelem  "script" `child` cont
+section cont = nelem  "section" `child` cont
+select cont = nelem  "select" `child` cont
+small cont = nelem  "small" `child` cont
+span cont = nelem  "span" `child` cont
+strong cont = nelem  "strong" `child` cont
+{-style cont = nelem  "style" `child` cont-}
+sub cont = nelem  "sub" `child` cont
+summary cont = nelem  "summary" `child` cont
+sup cont = nelem  "sup" `child` cont
+table cont = nelem  "table" `child` cont
+tbody cont = nelem  "tbody" `child` cont
+td cont = nelem  "td" `child` cont
+textarea cont = nelem  "textarea" `child` cont
+tfoot cont = nelem  "tfoot" `child` cont
+th cont = nelem  "th" `child` cont
+thead cont = nelem  "thead" `child` cont
+time cont = nelem  "time" `child` cont
+title cont = nelem  "title" `child` cont
+tr cont = nelem  "tr" `child` cont
+ul cont = nelem  "ul" `child` cont
+var cont = nelem  "var" `child` cont
+video cont = nelem  "video" `child` cont
+
+
+ctag tag cont= nelem tag `child` cont
+
+-- HTML4 support
+center cont= nelem "center" `child` cont
+
+noHtml= mempty :: Perch
+
+type Attribute = (String,String)
+
+class Attributable h where
+ (!) :: h -> Attribute -> h
+
+instance ToElem a => Attributable (a -> Perch) where
+ (!) pe atrib = \e -> pe e `attr` atrib
+
+instance Attributable Perch where
+ (!) = attr
+
+
+atr n v= (n,v)
+
+style= atr "style"
+
+id = atr "id"
+
+width= atr "width"
+
+height= atr "height"
+
+href= atr "href"
+
+src= atr "src"
+
+
+---------------- DOM Tree navigation
+
+-- | return the current node
+this :: Perch
+this= Perch $ \e -> return e
+
+-- | goes to the parent node of the first and execute the second
+goParent :: Perch -> Perch -> Perch
+goParent pe pe'= Perch $ \e' -> do
+  e <- build pe e'
+  p <- liftIO  $ parent e
+  e2 <- build pe' p
+  return e2
+
+-- | delete the current node. Return the parent
+delete :: Perch
+delete= Perch $ \e -> do
+             p <- liftIO $ parent e
+             removeChild e p
+             return p
+
+-- | delete the children of the current node.
+clear :: Perch
+clear= Perch $ \e -> clearChildren e >> return e
+
+
+parent :: Elem -> IO Elem
+parent= ffi $ toJSString "(function(e){return e.parentNode;})"
+
+
+getBody :: IO Elem
+getBody= ffi $ toJSString "(function(){return document.body;})"
+
+getDocument :: IO Elem
+getDocument= ffi $ toJSString  "(function(){return document;})"
+
+
+
+-- ! JQuery-like DOM manipulation: using a selector for querySelectorAll,
+-- it apply the Perch DOM manipulation of the second parameter for each of the matches
+--
+-- Example
+--
+-- > main= do
+-- >  body <- getBody
+-- >  (flip build) body $ pre $ do
+-- >      div ! atr "class" "modify" $ "click"
+-- >      div $ "not changed"
+-- >      div ! atr "class" "modify" $ "here"
+-- >
+-- >      addEvent this OnClick $ \_ _ -> do
+-- >          forElems' ".modify" $  this ! style "color:red"
+forElems' :: String -> Perch -> Client ()
+forElems' for doit= do
+    (flip build) undefined (forElems for doit)
+    return ()
+
+-- ! JQuery-like DOM manipulation: using a selector for querySelectorAll,
+-- it apply the Perch DOM manipulation of the second parameter for each of the matches
+forElems :: String -> Perch -> Perch
+forElems selectors dosomething= Perch $ \e -> do
+    es <- liftIO $ queryAll  selectors
+    mapM (build dosomething) es
+    return e
+    where
+    queryAll ::  String -> IO  [Elem]
+    queryAll = ffi $ toJSString "(function(sel){return document.querySelectorAll(sel);})"
+

@@ -12,7 +12,7 @@ -- current parent element. It uses Haste.DOM from the haste-compiler
 --
 -----------------------------------------------------------------------------
-{-#LANGUAGE TypeSynonymInstances, FlexibleInstances
+{-#LANGUAGE CPP, ForeignFunctionInterface, TypeSynonymInstances, FlexibleInstances
             , OverloadedStrings, DeriveDataTypeable, UndecidableInstances
             , OverlappingInstances #-}
 module Haste.Perch where
@@ -25,7 +25,7 @@ import Unsafe.Coerce
 import Data.String
 import Control.Monad.IO.Class
-
+import Control.Applicative
 
 
 newtype PerchM a= Perch{build :: Elem -> IO Elem} deriving Typeable
@@ -39,9 +39,12 @@          return e
     mempty  = Perch return
 
+instance Functor PerchM
+instance Applicative PerchM
+
 instance Monad PerchM where
    (>>) x y= mappend (unsafeCoerce x) y
-   (>>=) = error "bind (>>=) invocation creating DOM elements"
+   (>>=) = error "bind (>>=) invocation in the Perch monad creating DOM elements"
    return  = mempty
 
 instance MonadIO PerchM where
@@ -90,7 +93,7 @@   inner :: Elem -> String -> IO ()
   inner e txt = setProp e "innerHTML" txt
 
-
+-- | create an element and add a Haste event handler to it.
 addEvent :: Perch -> Event IO a -> a -> Perch
 addEvent be event action= Perch $ \e -> do
      e' <- build be e
@@ -103,8 +106,35 @@         setAttr e' atr "true"
         return e'
 
+-- | create an element and add any event handler to it.
+addEvent' :: Perch -> String -> a -> Perch
+addEvent' be event action= Perch $ \e -> do
+     e' <- build be e
+     has <- getAttr e'  event
+     case has of
+       "true" -> return e'
+       _ -> do
+        listen e'  event  action
+        setAttr e' event "true"
+        return e'
 
+instance JSType JSString where
+  toJSString x= x
+  fromJSString x= Just x
 
+listen :: JSType event => Elem -> event -> a -> IO Bool
+listen e event f= jsSetCB e (toJSString event) (mkCallback $! f)
+
+#ifdef __HASTE__
+foreign import ccall jsSetCB :: Elem -> JSString -> JSFun a -> IO Bool
+
+#else
+jsSetCB :: Elem -> JSString -> JSFun a -> IO Bool
+jsSetCB = error "Tried to use jsSetCB on server side!"
+
+#endif
+
+
 -- Leaf DOM nodes
 --
 area = nelem "area"
@@ -285,6 +315,9 @@ 
 getBody :: IO Elem
 getBody= ffi "(function(){return document.body;})"
+
+getDocument :: IO Elem
+getDocument= ffi  "(function(){return document;})"
 
 
 

@@ -16,6 +16,10 @@ This is an example. `withElem`  is a Haste.DOM call that give the DOM object whose id is "idelem", that has been created "by hand" in Main.hs. The program takes this element and add content to it:
 
 ```haskell
+import Haste.Perch
+import Haste
+import Prelude hiding (div)
+
 main :: IO ()
 main = do
   withElem "idelem" $ build $ do
@@ -40,6 +44,24 @@ </div>
 ```
 
+This other example modifies the previosly created elements when the event is raised using jQuery-like wildcards to modify all the elements of the class ".modify":
+
+```haskell
+import Haste.Perch
+import Haste
+import Prelude hiding (div)
+
+main= do
+  body <- getBody
+  (flip build) body $ do
+      div ! atr "class" "modify" $ "click"
+      div $ "not changed"
+      div ! atr "class" "modify" $ "here"
+      
+      addEvent this OnClick $ \_ _ -> do
+          forElems' ".modify" $ this ! style "color:red" `child` " modified"
+```
+
 The  monoid expression can also be used, by concatenating elements with the operator <>
 
         ... term1 <> term2 ...
@@ -91,8 +113,8 @@ the call `nelem` (new element) is a perch that creates a single tag element. Upon created, it  is added to the parent and return itself as parent of the next elements that can be hooked. To append two elements, both are added to the parent.
 
 The Monad instance is there in order to use the do notation, that add a new level of syntax, in the style of the package blaze-html. This monad invokes the same appending mechanism.
--A perch is a generalization of a list and it is handled in the same way;-while a list is an unary tree, perch create n-ary trees. While in a list the monoid instance add child nodes-down in the only direction that it can grow, the perch monoid add childs at the same level, horizontally.-Is the `child` primitive the one that creates branches down.+
+A perch is a generalization of a list and it is handled in the same way;
+while a list is an unary tree, perch create n-ary trees. While in a list the monoid instance add child nodes
+down in the only direction that it can grow, the perch monoid add childs at the same level, horizontally.
+Is the `child` primitive the one that creates branches down.

@@ -1,43 +1,43 @@-name:                haste-perch
-version:             0.1.0.4
-synopsis:            Create, navigate and modify the DOM tree with composable syntax, with the haste compiler
-description:         see the description at the homepage.
-                     This version add JQuery-like DOM manipulation
-
-homepage:            https://github.com/agocorona/haste-perch
-license:             GPL-3
-license-file:        LICENSE
-author:              Alberto G. Corona
-maintainer:          agocorona@gmail.com
-bug-reports:         https://github.com/agocorona/haste-perch/issues
-category:            Web
-build-type:          Simple
-extra-source-files:  README.md, Main.hs
-cabal-version:       >=1.10
-
-extra-source-files: Main.hs, Main.html
+name: haste-perch
+version: 0.1.0.5
+cabal-version: >=1.10
+build-type: Simple
+license: GPL-3
+license-file: LICENSE
+maintainer: agocorona@gmail.com
+homepage: https://github.com/agocorona/haste-perch
+bug-reports: https://github.com/agocorona/haste-perch/issues
+synopsis: Create, navigate and modify the DOM tree with composable syntax, with the haste compiler
+description: see the description at the homepage.
+             This version add support for the Client Monad (Module Haste.App.Perch)
+category: Web
+author: Alberto G. Corona
+data-dir: ""
+extra-source-files: README.md Main.hs Main.hs Main.html
 
 source-repository head
     type: git
     location: http://github.com/agocorona/haste-perch
 
-Flag Haste-inst
-  Description: either if it is being compiled with haste-inst or with cabal
-  Default: False
+flag haste-inst
+    Description:  either if it is being compiled with haste-inst or with cabal
+    Default: False
 
 library
 
-  exposed-modules:      Haste.Perch
-
- if flag(haste-inst)
-  build-depends:        base >4.0 && <5,
-                        transformers,
-                        haste-lib
- else
-  build-depends:        base >4.0 && <5,
-                        transformers,
-                        haste-compiler
+    if flag(haste-inst)
+        build-depends: base >4.0 && <5, transformers -any, haste-lib -any
+        exposed: True
+        buildable: True
+    else
+        build-depends: base >4.0 && <5, transformers -any,
+                       haste-compiler -any
+        exposed: True
+        buildable: True
+        default-language: Haskell2010
+    exposed-modules: Haste.Perch Haste.App.Perch
+    exposed: True
+    buildable: True
+    other-modules:
 
-  -- hs-source-dirs:
-  default-language:    Haskell2010