ghcjs-perch (empty) → 0.3.2
raw patch · 8 files changed
+837/−0 lines, 8 filesdep +basedep +ghcjs-basedep +transformerssetup-changed
Dependencies added: base, ghcjs-base, transformers
Files
- LICENSE +19/−0
- Setup.hs +2/−0
- ghcjs-perch.cabal +57/−0
- src/GHCJS/Perch.hs +31/−0
- src/Internal/API.hs +165/−0
- src/Internal/FFI.hs +75/−0
- src/Internal/Perch.hs +394/−0
- src/Internal/Type.hs +94/−0
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright © 2015-2016 Arthur S. Fayzrakhmanov <https://github.com/geraldus>+ 2014-2016 Alberto G. Corona <https://github.com/agocorona>++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of+the Software, and to permit persons to whom the Software is furnished to do so,+subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS+FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR+COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER+IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN+CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ghcjs-perch.cabal view
@@ -0,0 +1,57 @@+name: ghcjs-perch++-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.3.2++synopsis: GHCJS version of Perch library.++description: This package makes the creation of DOM elements easy+ with a syntax similar to other Haskell HTML generators+ such as `blaze-html`, using monoids and monads.++license: MIT++license-file: LICENSE++author: Arthur S. Fayzrakhmanov++maintainer: heraldhoi@gmail.com++copyright: Copyright © 2015 Arthut S. Fayzrakhmanov. All rights reserved.++category: Web++build-type: Simple++-- Extra files to be distributed with the package, such as examples or a+-- README.+-- extra-source-files:++-- Constraint on the version of Cabal needed to build this package.+cabal-version: >=1.10+++library+ exposed-modules: GHCJS.Perch++ other-modules: Internal.API+ Internal.FFI+ Internal.Perch+ Internal.Type++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:++ build-depends: base >= 4.7 && < 4.9,+ transformers >= 0.4.2.0 && < 0.5++ hs-source-dirs: src++ default-language: Haskell2010++ ghc-options: -Wall -fno-warn-unused-do-bind++ if impl(ghcjs >= 0.1)+ build-depends: ghcjs-base
+ src/GHCJS/Perch.hs view
@@ -0,0 +1,31 @@+{-|+Module : GHCJS.Perch+Description : Monadic DOM builder+Copyright : (c) Athur S. Fayzrakhmanov, 2015+ Alberto G. Corona, 2015+License : GPL-3+Maintainer : heraldhoi@gmail.com+Stability : experimental+Portability : Any++Monad and Monoid instances for a builder that hang DOM elements from the+current parent element.++-}++module GHCJS.Perch+ ( -- * Perch DOM Builder+ module Internal.Perch+ -- * Types+ , Elem+ , PropId+ , Attribute+ , NamedEvent (..)+ , JsEvent (..)+ -- * Internal API+ , module Internal.API )+ where++import Internal.API+import Internal.Perch hiding (withPerch, withPerchBuild)+import Internal.Type
+ src/Internal/API.hs view
@@ -0,0 +1,165 @@+{-# LANGUAGE CPP #-}+module Internal.API where++import Internal.FFI+import Internal.Type++#ifdef ghcjs_HOST_OS+import Data.JSString+import GHCJS.Foreign.Callback (Callback, asyncCallback1)+import GHCJS.Marshal (FromJSVal (..))+import GHCJS.Types (JSVal)+#else+data Callback a = Callback a+#endif+--------------------------------------------------------------------------------+++--------------------------------------------------------------------------------+#ifndef ghcjs_HOST_OS+notImplemented :: a+notImplemented = error "Client side call not implemented on server side."+#endif++getDocument :: IO Elem+#ifdef ghcjs_HOST_OS+getDocument = Elem <$> js_document+#else+getDocument = notImplemented+#endif++getBody :: IO Elem+#ifdef ghcjs_HOST_OS+getBody = Elem <$> js_documentBody+#else+getBody = notImplemented+#endif++newElem :: JSString -> IO Elem+#ifdef ghcjs_HOST_OS+newElem = (Elem <$>) . js_documentCreateNode+#else+newElem = notImplemented+#endif++newTextElem :: JSString -> IO Elem+#ifdef ghcjs_HOST_OS+newTextElem = (Elem <$>) . js_createTextNode+#else+newTextElem = notImplemented+#endif++parent :: Elem -> IO Elem+#ifdef ghcjs_HOST_OS+parent (Elem c) = Elem <$> js_parentNode c+#else+parent = notImplemented+#endif++-- | Appends one element to another.+addChild :: Elem -- ^ child element to append+ -> Elem -- ^ parent element+ -> IO ()+#ifdef ghcjs_HOST_OS+addChild (Elem c) (Elem p) = js_appendChild p c+#else+addChild = notImplemented+#endif++-- | Remove child from parent.+removeChild :: Elem -- ^ child to remove+ -> Elem -- ^ parent node+ -> IO ()+#ifdef ghcjs_HOST_OS+removeChild (Elem c) (Elem p) = js_removeChild p c+#else+removeChild = notImplemented+#endif++clearChildren :: Elem -> IO ()+#ifdef ghcjs_HOST_OS+clearChildren (Elem e) = js_clearChildren e+#else+clearChildren = notImplemented+#endif++replace :: Elem -> Elem -> IO Elem+#ifdef ghcjs_HOST_OS+replace oe@(Elem o) (Elem n) =+ do (Elem par) <- parent oe+ js_replaceChild par o n+ return (Elem n)+#else+replace = notImplemented+#endif++setAttr :: Elem -> PropId -> JSString -> IO ()+#ifdef ghcjs_HOST_OS+setAttr (Elem e) p = js_setAttribute e p+#else+setAttr = notImplemented+#endif++setInnerHTML :: Elem -> JSString -> IO ()+#ifdef ghcjs_HOST_OS+setInnerHTML (Elem e) = js_setInnerHtml e+#else+setInnerHTML = notImplemented+#endif++getElemById :: JSString -> IO Elem+#ifdef ghcjs_HOST_OS+getElemById = (Elem <$>) . js_getElementById+#else+getElemById = notImplemented+#endif++queryAll :: JSString -> IO [Elem]+#ifdef ghcjs_HOST_OS+queryAll query =+ do res <- js_querySelectorAll query+ fromJSValUncheckedListOf res+#else+queryAll = notImplemented+#endif++-- | Attach an event listener to element.+--+-- Returns an action removing listener, though you still have to release+-- callback manually.+--+-- If you are sure that you do not want to remove handler consider using+-- 'onEvent''.+onEvent :: NamedEvent e => Elem -> e -> Callback (JSVal -> IO()) -> IO (IO ())++-- | Attach endless event listener to element.+--+-- Use this function to attach event handlers which supposed not to be removed+-- during application run.+onEvent' :: NamedEvent e => Elem -> e -> (JSVal -> IO()) -> IO ()++-- | Remove attached event listener.+--+-- Normally you can use action returned by 'onEvent' to detach event listener,+-- however you can also use this function directly.+removeEvent :: NamedEvent e => Elem -> e -> Callback (JSVal -> IO ()) -> IO ()+#ifdef ghcjs_HOST_OS+onEvent el'@(Elem el) et cb =+ do js_addEventListener el e cb+ return $ removeEvent el' e cb+ where+ e = pack (eventName et)++onEvent' (Elem el) et hnd =+ do cb <- asyncCallback1 hnd+ js_addEventListener el e cb+ where+ e = pack (eventName et)++removeEvent (Elem el) et cb = js_removeEventListener el (pack (eventName et)) cb+#else+onEvent = notImplemented+onEvent' = notImplemented+removeEvent = notImplemented+#endif+--------------------------------------------------------------------------------
+ src/Internal/FFI.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE CPP #-}+module Internal.FFI where++#ifdef ghcjs_HOST_OS+import Data.JSString (JSString)+import GHCJS.Foreign.Callback (Callback)+import GHCJS.Types (JSVal)+--------------------------------------------------------------------------------+++--------------------------------------------------------------------------------+-- | GHCJS' callback taking one argument.+-- Handy synonym to simplify type signatures.+type Callback1 = Callback (JSVal -> IO ())++foreign import javascript unsafe "$r = document;"+ js_document :: IO JSVal++foreign import javascript unsafe "document.body"+ js_documentBody :: IO JSVal++foreign import javascript unsafe "document.getElementById($1)"+ js_getElementById :: JSString -> IO JSVal++foreign import javascript unsafe "document.querySelectorAll($1)"+ js_querySelectorAll :: JSString -> IO JSVal++foreign import javascript unsafe "document.createElement($1)"+ js_documentCreateNode :: JSString -> IO JSVal++foreign import javascript unsafe "document.createTextNode($1)"+ js_createTextNode :: JSString -> IO JSVal++-- | Check if object is an HTML Element of current DOM. Works with HTML+-- elements and text nodes.+-- http://stackoverflow.com/a/20476546/1749901+foreign import javascript unsafe+ "$1 !== null && !(!$1.ownerDocument) && (window === ($1.ownerDocument.defaultView || $1.ownerDocument.parentWindow))"+ js_isInCurrentDOM :: JSVal -> IO Bool+++foreign import javascript unsafe "$1.parentNode()"+ js_parentNode :: JSVal -> IO JSVal++foreign import javascript unsafe "$1.appendChild($2)"+ js_appendChild :: JSVal -> JSVal -> IO ()++foreign import javascript unsafe "$1.replaceChild($2,$3)"+ js_replaceChild :: JSVal -> JSVal -> JSVal -> IO ()++foreign import javascript unsafe "$1.removeChild($2)"+ js_removeChild :: JSVal -> JSVal -> IO ()++foreign import javascript unsafe+ "while ($1.hasChildNodes()) $1.removeChild($1.lastChild)"+ js_clearChildren :: JSVal -> IO ()+++foreign import javascript unsafe "$1.setAttribute($2, $3)"+ js_setAttribute :: JSVal -> JSString -> JSString -> IO ()++foreign import javascript unsafe "$1.innerHTML = $2"+ js_setInnerHtml :: JSVal -> JSString -> IO ()+++foreign import javascript unsafe+ "$1.addEventListener($2, $3);"+ js_addEventListener :: JSVal -> JSString -> Callback1 -> IO ()++-- | Remove event listener from element.+foreign import javascript unsafe+ "$1.removeEventListener($2, $3);"+ js_removeEventListener :: JSVal -> JSString -> Callback1 -> IO ()+--------------------------------------------------------------------------------+#endif
+ src/Internal/Perch.hs view
@@ -0,0 +1,394 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}+module Internal.Perch where++import Internal.API+import Internal.Type++#ifdef ghcjs_HOST_OS+import Data.JSString (JSString, pack)+import GHCJS.Foreign.Callback (Callback)+import GHCJS.Types (JSVal)+#endif++import Control.Monad.IO.Class (MonadIO (..))+import Data.String (IsString (..))+import Data.Typeable (Typeable)+import Unsafe.Coerce (unsafeCoerce)+--------------------------------------------------------------------------------+++--------------------------------------------------------------------------------+#ifndef ghcjs_HOST_OS+pack = undefined+#endif++newtype PerchM a =+ Perch { build :: Elem -> IO Elem }+ deriving Typeable++type Perch = PerchM ()+++class ToElem a where+ toElem :: a -> Perch+++class Attributable h where+ (!) :: h -> Attribute -> h+--------------------------------------------------------------------------------+++--------------------------------------------------------------------------------+instance Monoid (PerchM a) where+ mappend mx my = Perch . withPerch $ \e ->+ do build mx e+ build my 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 io = Perch . withPerch $ const io++instance ToElem (PerchM a) where+ toElem = unsafeCoerce++instance IsString Perch where+ fromString = toElem++instance Attributable Perch where+ (!) pe (aname, aval) = pe `attr` (aname, aval)++instance ToElem a => Attributable (a -> Perch) where+ (!) pe (aname, aval) = \e -> pe e `attr` (aname, aval)+++instance {-# OVERLAPPABLE #-} Show a => ToElem a where+ toElem = toElem . show++instance ToElem JSString where+ toElem s = Perch $ \x ->+ do e <- newTextElem s+ addChild e x+ return e++#ifdef ghcjs_HOST_OS+instance ToElem String where+ toElem = toElem . pack+#endif+--------------------------------------------------------------------------------+++--------------------------------------------------------------------------------+-- * DOM Tree Building++attr :: forall a. PerchM a -> (PropId, JSString) -> PerchM a+attr tag (n, v) = Perch $ withPerchBuild tag (\t -> setAttr t n v)++nelem :: JSString -> Perch+nelem s = Perch $ \x ->+ do e <- newElem s+ addChild e x+ return e++-- | Build an element as child of another one. Child element becomes new+-- continuation for monadic expression.+child :: ToElem a+ => Perch -- ^ parent+ -> a -- ^ child+ -> Perch+child me ch = Perch . withPerchBuild me $ build (toElem ch)++setHtml :: Perch -> JSString -> Perch+setHtml me text = Perch . withPerchBuild me $ flip setInnerHTML text++-- | Build perch and attach an event handler to its element.+--+-- Event handler should be an IO action wrapped by GHCJS' 'Callback' taking one+-- argument, that is an actual JavaScript event object baked in @JSVal@.+addEvent :: (NamedEvent e) => Perch -> e -> Callback (JSVal -> IO ()) -> Perch+addEvent pe event action = Perch . withPerchBuild pe $ \e ->+ onEvent e event action++-- | Build perch and attach an event handler to its element. Use this function+-- only when you are sure that you won't detach handler during application run.+addEvent' :: (NamedEvent e) => Perch -> e -> (JSVal -> IO ()) -> Perch+addEvent' pe event action = Perch . withPerchBuild pe $ \e ->+ onEvent' e event action++-- | Build perch and remove an event handler from it.+--+-- Note, you still have to release callback manually.+remEvent :: (NamedEvent e) => Perch -> e -> Callback (JSVal -> IO ()) -> Perch+remEvent pe event action = Perch . withPerchBuild pe $ \e ->+ removeEvent e event action++-- ** Leaf DOM Nodes+area, base, br, col, embed, hr, img, input, keygen, link, menuitem :: Perch+meta, param, source, track, wbr :: Perch++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, abbr, address, article, aside, audio, b, bdo, blockquote, body, button,+ canvas, caption, center, cite, code, colgroup, command, datalist, dd, del,+ details, dfn, div, dl, dt, em, fieldset, figcaption, figure, footer, form, h1,+ h2, h3, h4, h5, h6, head, header, hgroup, html, i, iframe, ins, kbd, label,+ legend, li, map, mark, menu, meter, nav, noscript, object, ol, optgroup,+ option, output, p, pre, progress, q, rp, rt, ruby, samp, script, section,+ select, small, span, strong, sub, summary, sup, table, tbody, td, textarea,+ tfoot, th, thead, time, title, tr, ul, var, video :: ToElem a => a -> Perch++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+audio 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 :: (ToElem b) => JSString -> b -> Perch+ctag tag cont = nelem tag `child` cont++-- ** HTML4 Support+center cont = nelem "center" `child` cont++noHtml :: Perch+noHtml = mempty+++-- * DOM Tree Navigation & Manipulation++-- ** Attributes++atr :: String -> JSString -> Attribute+atr n v = (pack n, v)++id, height, href, src, style, width :: JSString -> Attribute++id = atr "id"+height = atr "height"+href = atr "href"+src = atr "src"+style = atr "style"+width = atr "width"++-- ** Traversal++-- | Return the current node.+this :: Perch+this = Perch return++-- | Goes to the parent node of the first and execute the second.+goParent :: Perch -> Perch -> Perch+goParent ch pe = Perch $ \e ->+ do fs <- build ch e+ pr <- parent fs+ build pe pr++-- ** Manipulation++-- | Delete the current node and return the parent.+delete :: Perch+delete = Perch $ \e ->+ do par <- parent e+ removeChild e par+ return par++-- | Delete all children of the current node.+clear :: Perch+clear = Perch . withPerch $ clearChildren++-- | Replace the current node with a new one+outer :: Perch -> Perch -> Perch+outer olde newe = Perch $ \e ->+ do o <- build olde e+ n <- build newe e+ replace o n+++-- | JQuery-like DOM manipulation. It applies the Perch DOM manipulation for+-- each found element using @querySelectorAll@ function.+forElems :: JSString -> Perch -> Perch+forElems query action = Perch . withPerch . const $+ do els <- queryAll query+ mapM_ (build action) els++-- | Like 'forElems', but works in IO monad.+-- Example:+--+-- @+-- import GHCJS.Foreign.Callback (asyncCallback1)+--+-- main = do+-- body <- getBody+-- makeRed \<- asyncCallback1 (\\ _ -\> do+-- forElems_ ".changeable" $+-- this ! style "color:red")+-- (flip build) body . div $ do+-- div ! atr "class" "changeable" $ \"Changeable\"+-- div \"Static\"+-- div ! atr "class" "changeable" $ \"Changeable\"+-- addEvent this Click makeRed+-- @+forElems_ :: JSString -> Perch -> IO ()+forElems_ els action =+ do build (forElems els action) undefined+ return ()++-- | Decalarative synonym for @flip forElems@.+--+-- Examples:+--+-- @+-- doAction \``withElems`\` ".item"+-- `forElems` ".item" doAction+-- @+withElems :: Perch -> JSString -> Perch+withElems = flip forElems++-- | A declarative synonym of @flip forElements@.+withElems_ :: Perch -> JSString -> IO ()+withElems_ = flip forElems_++-- | Apply action to perch with given identifier.+forElemId :: JSString -> Perch -> Perch+forElemId eid act = Perch . withPerch . const $+ do el <- getElemById eid+ build act el++-- | IO version of 'forElemId_'.+forElemId_ :: JSString -> Perch -> IO ()+forElemId_ act eid =+ do flip build undefined (forElemId act eid)+ return ()++-- | A synonym to @flip forElemId@.+withElemId :: Perch -> JSString -> Perch+withElemId = flip forElemId++-- | A synonym to @flip forElemId_@.+withElemId_ :: Perch -> JSString -> IO ()+withElemId_ = flip forElemId_+++withPerch :: (Elem -> IO a) -> Elem -> IO Elem+withPerch act e = act e >> return e++withPerchBuild :: PerchM a -> (Elem -> IO b) -> Elem -> IO Elem+withPerchBuild p act e =+ do x <- build p e+ act x+ return x
+ src/Internal/Type.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}+module Internal.Type where++#ifdef ghcjs_HOST_OS+import Data.JSString+import GHCJS.Marshal (FromJSVal (..), ToJSVal (..))+import GHCJS.Types (JSVal)+import Internal.FFI (js_isInCurrentDOM)+#endif+--------------------------------------------------------------------------------+++--------------------------------------------------------------------------------+#ifndef ghcjs_HOST_OS+type JSVal = ()+type JSString = String+unpack = undefined+#endif++newtype Elem = Elem JSVal++type PropId = JSString++type Attribute = (JSString, JSString)+++class NamedEvent a where+ eventName :: a -> String++data JsEvent = Blur+ | Change+ | Click+ | DblClick+ | Focus+ | KeyPress+ | KeyUp+ | KeyDown+ | Load+ | MouseDown+ | MouseMove+ | MouseOut+ | MouseOver+ | MouseUp+ | Submit+ | Unload+ | Wheel+++#ifdef ghcjs_HOST_OS+instance FromJSVal Elem where+ fromJSVal v =+ do isElem <- js_isInCurrentDOM v+ return $+ if isElem+ then Just (Elem v)+ else Nothing++instance ToJSVal Elem where+ toJSVal (Elem val) = return val+#endif++#ifdef ghcjs_HOST_OS+instance NamedEvent String where+ eventName = Prelude.id+#endif++instance {-# OVERLAPPABLE #-} Show a => NamedEvent a where+ eventName = eventName . show++instance NamedEvent JSString where+ eventName x = eventName (unpack x :: String)++instance Show JsEvent where+ show Blur = "blur"+ show Change = "change"+ show Click = "click"+ show DblClick = "dblclick"+ show Focus = "focus"+ show KeyDown = "keydown"+ show KeyPress = "keypress"+ show KeyUp = "keyup"+ show Load = "load"+ show MouseDown = "mousedown"+ show MouseMove = "mousemove"+ show MouseOut = "mouseout"+ show MouseOver = "mouseover"+ show MouseUp = "mouseup"+ show Submit = "submit"+ show Unload = "unload"+ show Wheel = "wheel"+--------------------------------------------------------------------------------