module Haste.DOM.JSString (
AttrName (..), Attribute, IsElem (..), Elem,
attribute, set, with, children,
click, focus, blur, document, documentBody, appendChild, addChild,
addChildBefore, insertChildBefore, getFirstChild, getLastChild, getChildren,
setChildren, clearChildren, deleteChild, removeChild,
PropID, ElemID, QuerySelector, ElemClass, AttrValue,
prop, style, attr, (=:),
newElem, newTextElem,
elemById, elemsByQS, elemsByClass,
setProp, getProp, setAttr, getAttr, getValue,
withElem , withElems, withElemsQS, mapQS, mapQS_,
getStyle, setStyle,
getFileData, getFileName,
setClass, toggleClass, hasClass
) where
import Haste.Prim
import Haste.Prim.JSType
import Haste.DOM.Core
import Data.Maybe (isNothing, fromJust)
import Control.Monad.IO.Class
import Haste.Foreign
import Haste.Binary.Types
type PropID = JSString
type ElemID = JSString
type QuerySelector = JSString
type ElemClass = JSString
type AttrValue = JSString
jsGet :: Elem -> JSString -> IO JSString
jsGet = ffi "(function(e,p){return e[p].toString();})"
jsGetAttr :: Elem -> JSString -> IO JSString
jsGetAttr = ffi "(function(e,p){\
\return e.hasAttribute(p) ? e.getAttribute(p) : '';})"
jsGetStyle :: Elem -> JSString -> IO JSString
jsGetStyle = ffi "(function(e,p){return e.style[p].toString();})"
jsFind :: JSString -> IO (Maybe Elem)
jsFind = ffi "(function(id){return document.getElementById(id);})"
jsQuerySelectorAll :: Elem -> JSString -> IO [Elem]
jsQuerySelectorAll = ffi "(function(e,q){\
\if(!e || typeof e.querySelectorAll !== 'function') {\
\return [];\
\} else {\
\return e.querySelectorAll(q);\
\}})"
jsElemsByClassName :: JSString -> IO [Elem]
jsElemsByClassName = ffi "(function(c){\
\return document.getElementsByClassName(e);})"
jsCreateElem :: JSString -> IO Elem
jsCreateElem = ffi "(function(t){return document.createElement(t);})"
jsCreateTextNode :: JSString -> IO Elem
jsCreateTextNode = ffi "(function(s){return document.createTextNode(s);})"
style :: JSString -> AttrName
style = StyleName
attr :: JSString -> AttrName
attr = AttrName
prop :: JSString -> AttrName
prop = PropName
infixl 4 =:
(=:) :: AttrName -> AttrValue -> Attribute
(=:) = attribute
newElem :: MonadIO m => JSString -> m Elem
newElem = liftIO . jsCreateElem
newTextElem :: MonadIO m => JSString -> m Elem
newTextElem = liftIO . jsCreateTextNode
setProp :: (IsElem e, MonadIO m) => e -> PropID -> JSString -> m ()
setProp e property val = liftIO $ jsSet (elemOf e) property val
setAttr :: (IsElem e, MonadIO m) => e -> PropID -> JSString -> m ()
setAttr e property val = liftIO $ jsSetAttr (elemOf e) property val
getValue :: (IsElem e, MonadIO m, JSType a) => e -> m (Maybe a)
getValue e = liftIO $ fromJSString `fmap` jsGet (elemOf e) "value"
getProp :: (IsElem e, MonadIO m) => e -> PropID -> m JSString
getProp e property = liftIO $ jsGet (elemOf e) property
getAttr :: (IsElem e, MonadIO m) => e -> PropID -> m JSString
getAttr e property = liftIO $ jsGetAttr (elemOf e) property
getStyle :: (IsElem e, MonadIO m) => e -> PropID -> m JSString
getStyle e property = liftIO $ jsGetStyle (elemOf e) property
setStyle :: (IsElem e, MonadIO m) => e -> PropID -> JSString -> m ()
setStyle e property val = liftIO $ jsSetStyle (elemOf e) property val
elemById :: MonadIO m => ElemID -> m (Maybe Elem)
elemById eid = liftIO $ jsFind eid
elemsByClass :: MonadIO m => ElemClass -> m [Elem]
elemsByClass cls = liftIO $ jsElemsByClassName cls
elemsByQS :: (IsElem e, MonadIO m) => e -> QuerySelector -> m [Elem]
elemsByQS el sel = liftIO $ jsQuerySelectorAll (elemOf el) sel
withElem :: MonadIO m => ElemID -> (Elem -> m a) -> m a
withElem e act = do
me' <- elemById e
case me' of
Just e' -> act e'
_ -> error $ "No element with ID " ++ fromJSStr e ++ " found!"
withElems :: MonadIO m => [ElemID] -> ([Elem] -> m a) -> m a
withElems es act = do
mes <- mapM elemById es
if any isNothing mes
then error $ "Elements with the following IDs could not be found: "
++ show (findElems es mes)
else act $ map fromJust mes
where
findElems (i:is) (Nothing:mes) = i : findElems is mes
findElems (_:is) (_:mes) = findElems is mes
findElems _ _ = []
withElemsQS :: (IsElem e, MonadIO m)
=> e
-> QuerySelector
-> ([Elem] -> m a)
-> m a
withElemsQS el sel act = elemsByQS el sel >>= act
mapQS :: (IsElem e, MonadIO m) => e -> QuerySelector -> (Elem -> m a) -> m [a]
mapQS el sel act = elemsByQS el sel >>= mapM act
mapQS_ :: (IsElem e, MonadIO m) => e -> QuerySelector -> (Elem -> m a) -> m ()
mapQS_ el sel act = elemsByQS el sel >>= mapM_ act
getFileData :: (IsElem e, MonadIO m) => e -> Int -> m (Maybe Blob)
getFileData e ix = liftIO $ do
num <- getFiles (elemOf e)
if ix < num
then Just `fmap` getFile (elemOf e) ix
else return Nothing
getFiles :: Elem -> IO Int
getFiles = ffi "(function(e){return e.files.length;})"
getFile :: Elem -> Int -> IO Blob
getFile = ffi "(function(e,ix){return e.files[ix];})"
getFileName :: (IsElem e, MonadIO m) => e -> m JSString
getFileName e = liftIO $ do
fn <- fromJSStr `fmap` getProp e "value"
return $ toJSStr $ reverse $ takeWhile (not . separator) $ reverse fn
where
separator '/' = True
separator '\\' = True
separator _ = False
setClass :: (IsElem e, MonadIO m) => e -> JSString -> Bool -> m ()
setClass e c x = liftIO $ setc (elemOf e) c x
setc :: Elem -> JSString -> Bool -> IO ()
setc = ffi "(function(e,c,x){x?e.classList.add(c):e.classList.remove(c);})"
toggleClass :: (IsElem e, MonadIO m) => e -> JSString -> m ()
toggleClass e c = liftIO $ toggc (elemOf e) c
toggc :: Elem -> JSString -> IO ()
toggc = ffi "(function(e,c) {e.classList.toggle(c);})"
hasClass :: (IsElem e, MonadIO m) => e -> JSString -> m Bool
hasClass e c = liftIO $ getc (elemOf e) c
getc :: Elem -> JSString -> IO Bool
getc = ffi "(function(e,c) {return e.classList.contains(c);})"