Util.hs

module Web.Framework.Plzwrk.Util
  ( (<.>)
  , wStyle
  , wStyle'
  , wStyles
  , wStyles'
  , wClass
  , wClass'
  , wClasses
  , wClasses'
  , wOnClick
  , wOnClick'
  , wId
  , wId'
  , wOnInput
  , wOnInput'
  , wAttr
  , wAttr'
  , wAttrs
  , wAttrs'
  , eventTargetValue
  , eventPreventDefault
  , eventTargetBlur
  , elementSetAttribute
  , elementTagName
  , eventTargetAddEventListener
  , eventTargetRemoveEventListener
  , getPropertyAsBool
  , getPropertyAsDouble
  , getPropertyAsInt
  , getPropertyAsString
  , htmlElemenetClick
  , consoleLogS
  , nodeAppendChild
  , nodeChildNodes
  , nodeInsertBefore
  , nodeRemoveChild
  , nodeTextContent
  )
where

import           Control.Monad
import           Data.HashMap.Strict           as HM
import           Data.Set                      as S
import           Web.Framework.Plzwrk.Base      ( dats
                                                , dats'
                                                , Attributes(..)
                                                )
import           Web.Framework.Plzwrk.Browserful

merge :: Attributes s opq -> Attributes s opq -> Attributes s opq
merge a b = MkAttributes { _style    = HM.union (_style a) (_style b)
                         , _class    = S.union (_class a) (_class b)
                         , _simple   = HM.union (_simple a) (_simple b)
                         , _handlers = HM.union (_handlers a) (_handlers b)
                         }

-- |Merges two 'Attributes'
(<.>)
  :: (s -> Attributes s opq)
  -> (s -> Attributes s opq)
  -> (s -> Attributes s opq)
a <.> b = (\s -> merge (a s) (b s))

-- |Constrcts a stateful 'Attributes' applicative functor from a single style.
wStyle :: String -> String -> (s -> Attributes s opq)
wStyle k v = (\s -> dats' { _style = HM.singleton k v })

-- |Constrcts an 'Attributes' from a single style.
wStyle' :: String -> String -> Attributes s opq
wStyle' k v = dats' { _style = HM.singleton k v }

-- |Constrcts a stateful 'Attributes' applicative functor from a list of styles.
wStyles :: [(String, String)] -> (s -> Attributes s opq)
wStyles kvs = (\s -> dats' { _style = HM.fromList kvs })

-- |Constrcts an 'Attributes' from a list of styles.
wStyles' :: [(String, String)] -> Attributes s opq
wStyles' kvs = dats' { _style = HM.fromList kvs }

-- |Constrcts a stateful 'Attributes' applicative functor from a single class.
wClass :: String -> (s -> Attributes s opq)
wClass k = (\s -> dats' { _class = S.singleton k })

-- |Constrcts an 'Attributes' from a single class.
wClass' :: String -> Attributes s opq
wClass' k = dats' { _class = S.singleton k }

-- |Constrcts a stateful 'Attributes' applicative functor from a list of clases.
wClasses :: [String] -> (s -> Attributes s opq)
wClasses ks = (\s -> dats' { _class = S.fromList ks })

-- |Constrcts an 'Attributes' from a list of classes.
wClasses' :: [String] -> Attributes s opq
wClasses' ks = dats' { _class = S.fromList ks }

-- |Constrcts a stateful 'Attributes' applicative functor with a given id.
wId :: String -> (s -> Attributes s opq)
wId v = (\s -> dats' { _simple = HM.singleton "id" v })

-- |Constrcts an 'Attributes' with a given id.
wId' :: String -> Attributes s opq
wId' v = dats' { _simple = HM.singleton "id" v }

-- |Constrcts a stateful 'Attributes' applicative functor from an @onClick@ callback.
wOnClick :: (opq -> s -> IO s) -> (s -> Attributes s opq)
wOnClick v = (\s -> dats' { _handlers = HM.singleton "click" v })

-- |Constrcts an 'Attributes' from an @onClick@ callback.
wOnClick' :: (opq -> s -> IO s) -> Attributes s opq
wOnClick' v = dats' { _handlers = HM.singleton "click" v }

-- |Constrcts a stateful 'Attributes' applicative functor from an @onInput@ callback.
wOnInput :: (opq -> s -> IO s) -> (s -> Attributes s opq)
wOnInput v = (\s -> dats' { _handlers = HM.singleton "input" v })

-- |Constrcts an 'Attributes' from an @onInput@ callback.
wOnInput' :: (opq -> s -> IO s) -> Attributes s opq
wOnInput' v = dats' { _handlers = HM.singleton "input" v }

-- |Constrcts a stateful 'Attributes' applicative functor from a single attribute.
wAttr :: String -> String -> (s -> Attributes s opq)
wAttr k v = (\s -> dats' { _simple = HM.singleton k v })

-- |Constrcts an 'Attributes' from a single attribute.
wAttr' :: String -> String -> Attributes s opq
wAttr' k v = dats' { _simple = HM.singleton k v }

-- |Constrcts a stateful 'Attributes' applicative functor from a list of attributes.
wAttrs :: [(String, String)] -> (s -> Attributes s opq)
wAttrs kvs = (\s -> dats' { _simple = HM.fromList kvs })

-- |Constrcts an 'Attributes' from a list of attributes.
wAttrs' :: [(String, String)] -> Attributes s opq
wAttrs' kvs = dats' { _simple = HM.fromList kvs }

-----------------------------
---- events

-- |From an event, gets the target's value.
eventTargetValue
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the event
  -> IO (Maybe String) -- ^ the target value, or nothing if it doesn't exist
eventTargetValue browser e = do
  opq <- (getPropertyAsOpaque browser) e "target"
  maybe (pure Nothing) (\y -> (getPropertyAsString browser) y "value") opq

-- |From an event, takes the target and blurs it.
eventTargetBlur
  :: Browserful jsval -- ^ the browser
  -> jsval  -- ^ the event
  -> IO () -- ^ returns nothing
eventTargetBlur browser e = do
  opq <- (getPropertyAsOpaque browser) e "target"
  maybe (pure ()) (\y -> void $ (invokeOn0 browser) y "blur") opq

-- |Take an event and prevent the default.
eventPreventDefault
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the event
  -> IO () -- ^ returns nothing
eventPreventDefault browser e = do
  void $ (invokeOn0 browser) e "preventDefault"

-----------

-- | Sets on an element an attribute. See [Element.setAttribute](https://developer.mozilla.org/en-US/docs/Web/API/Element/setAttribute)
elementSetAttribute
  :: Browserful jsval -- ^ The browser
  -> jsval -- ^ the node
  -> String -- ^ the attribute name
  -> String -- ^ the attribute
  -> IO () -- ^ returns nothing
elementSetAttribute b e k v = do
  _k <- (jsValFromString b) k
  _v <- (jsValFromString b) v
  void $ (invokeOn2 b) e "setAttribute" _k _v

-- | Gets the tag name of an element.  See [Element.tagName](https://developer.mozilla.org/en-US/docs/Web/API/Element/tagName)
elementTagName
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the element
  -> IO (Maybe String) -- ^ Returns the tag name
elementTagName b v = do
  _o <- (getPropertyAsOpaque b) v "tagName"
  maybe (pure Nothing) (\x -> (castToString b) x) _o

-- | Takes a target and an event name and adds a listener. See [EventTarget.addEventListener](https://developer.mozilla.org/en-US/docs/Web/API/EventTarget/addEventListener)
eventTargetAddEventListener
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the element
  -> String -- ^ the listener name. note that this should be "click" or "input", not "onclick" nor "oninput"
  -> jsval -- ^ the listener
  -> IO () -- ^ returns nothing
eventTargetAddEventListener b e k v = do
  _k <- (jsValFromString b) k
  void $ (invokeOn2 b) e "addEventListener" _k v

-- | Takes a target and an event name and removes a listener. See [EventTarget.removeEventListener](https://developer.mozilla.org/en-US/docs/Web/API/EventTarget/removeEventListener)
eventTargetRemoveEventListener
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the element
  -> String -- ^ the listener name. note that this should be "click" or "input", not "onclick" nor "oninput"
  -> jsval -- ^ the listener
  -> IO () -- ^ returns nothing
eventTargetRemoveEventListener b e k v = do
  _k <- (jsValFromString b) k
  void $ (invokeOn2 b) e "removeEventListener" _k v

-- | Gets a JavaScript property as a bool, returning @Nothing@ if the object being called is null or undefined or the property cannot be cast to a bool.
getPropertyAsBool
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the object containing the property
  -> String -- ^ the property name
  -> IO (Maybe Bool) -- ^ the response if the property is a bool, else Nothing
getPropertyAsBool b o k = do
  _v <- (getPropertyAsOpaque b) o k
  maybe (pure Nothing) (\x -> (castToBool b) x) _v

-- | Gets a JavaScript property as a double, returning @Nothing@ if the object being called is null or undefined or the property cannot be cast to a double.
getPropertyAsDouble
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the object containing the property
  -> String -- ^ the property name
  -> IO (Maybe Double) -- ^ the response if the property is a double, else Nothing
getPropertyAsDouble b o k = do
  _v <- (getPropertyAsOpaque b) o k
  maybe (pure Nothing) (\x -> (castToDouble b) x) _v

-- | Gets a JavaScript property as an int, returning @Nothing@ if the object being called is null or undefined or the property cannot be cast to an int.
getPropertyAsInt
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the object containing the property
  -> String -- ^ the property name
  -> IO (Maybe Int) -- ^ the response if the property is an int, else Nothing
getPropertyAsInt b o k = do
  _v <- (getPropertyAsOpaque b) o k
  maybe (pure Nothing) (\x -> (castToInt b) x) _v

-- | Gets a JavaScript property as an string, returning @Nothing@ if the object being called is null or undefined.
getPropertyAsString
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the object containing the property
  -> String -- ^ the property name
  -> IO (Maybe String) -- ^ the response
getPropertyAsString b o k = do
  _v <- (getPropertyAsOpaque b) o k
  maybe (pure Nothing) (\x -> (castToString b) x) _v

-- | Takes an element and clicks it. Useful for testing. See [HTMLElement.click](https://developer.mozilla.org/en-US/docs/Web/API/HTMLElement/click)
htmlElemenetClick :: Browserful jsval -> jsval -> IO ()
htmlElemenetClick b e = void $ (invokeOn0 b) e "click"

-- | Logs a string. See [Console.log](https://developer.mozilla.org/en-US/docs/Web/API/Console/log)
consoleLogS :: Browserful jsval -> String -> IO ()
consoleLogS b s = do
  _s <- (jsValFromString b) s
  (consoleLog b) _s

-- | Takes a node and appends a child. See [Node.appendChild](https://developer.mozilla.org/en-US/docs/Web/API/Node/appendChild)
nodeAppendChild
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the node
  -> jsval -- ^ the child to append
  -> IO () -- ^ returns nothing
nodeAppendChild b e v = void $ (invokeOn1 b) e "appendChild" v

-- | Get the children of a node. See [Node.childNodes](https://developer.mozilla.org/en-US/docs/Web/API/Node/childNodes)
nodeChildNodes
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the node
  -> IO (Maybe [jsval])
nodeChildNodes b v = do
  _cn <- (getPropertyAsOpaque b) v "childNodes"
  maybe (pure Nothing) (\x -> (castToArray b) x) _cn

-- | Inserts a node into an element before another node.  See [Node.insertBefore](https://developer.mozilla.org/en-US/docs/Web/API/Node/insertBefore)
nodeInsertBefore
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the parent element
  -> jsval -- ^ the new node
  -> jsval -- ^ the pre-existing node
  -> IO () -- ^ returns nothing
nodeInsertBefore b e k v = void $ (invokeOn2 b) e "insertBefore" k v

-- | Removes a child from a parent node.  See [Node.removeChild](https://developer.mozilla.org/en-US/docs/Web/API/Node/removeChild)
nodeRemoveChild
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the parent element
  -> jsval -- ^ the child to remove
  -> IO () -- ^ returns nothing
nodeRemoveChild b e v = void $ (invokeOn1 b) e "removeChild" v

-- | Gets the text content of a node. See [Node.textContent](https://developer.mozilla.org/en-US/docs/Web/API/Node/textContent)
nodeTextContent
  :: Browserful jsval -- ^ the browser
  -> jsval -- ^ the node
  -> IO (Maybe String) -- ^ the text content as a string
nodeTextContent b e = do
  _tc <- (getPropertyAsOpaque b) e "textContent"
  maybe (pure Nothing) (\x -> (castToString b) x) _tc