{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
module Graphics.UI.Threepenny.Core (
    -- * Synopsis
    -- | Core functionality of the Threepenny GUI library.

    -- * Server
    -- $server
    Config(..), defaultConfig, startGUI,
    loadFile, loadDirectory,

    -- * UI monad
    -- $ui
    UI, runUI, MonadUI(..), askWindow, liftIOLater,
    module Control.Monad.IO.Class,
    module Control.Monad.Fix,

    -- * Browser Window
    Window, title,

    -- * DOM elements
    -- | Create and manipulate DOM elements.
    Element, getWindow, mkElement, mkElementNamespace, delete,
        string,
        getHead, getBody,
        (#+), children, text, html, attr, style, value,
    getElementsByTagName, getElementById, getElementsByClassName,

    -- * Layout
    -- | Combinators for quickly creating layouts.
    -- They can be adjusted with CSS later on.
    grid, row, column,

    -- * Events
    -- | For a list of predefined events, see "Graphics.UI.Threepenny.Events".
    EventData, domEvent, unsafeFromJSON, disconnect, on, onEvent, onChanges,
    module Reactive.Threepenny,

    -- * Attributes
    -- | For a list of predefined attributes, see "Graphics.UI.Threepenny.Attributes".
    (#), (#.),
    Attr, WriteAttr, ReadAttr, ReadWriteAttr(..),
    set, sink, get, mkReadWriteAttr, mkWriteAttr, mkReadAttr,
    bimapAttr, fromObjectProperty,

    -- * Widgets
    Widget(..), element, widget,

    -- * JavaScript FFI
    -- | Direct interface to JavaScript in the browser window.
    debug, timestamp,
    ToJS, FFI,
    JSFunction, ffi, runFunction, callFunction,
    CallBufferMode(..), setCallBufferMode, flushCallBuffer,
    ffiExport,
    -- ** Internals
    toJSObject, liftJSWindow,
    -- * Internal and oddball functions
    fromJQueryProp,

    ) where

import Control.Monad          (forM_, forM, void)
import Control.Monad.Fix
import Control.Monad.IO.Class

import qualified Control.Monad.Catch             as E
import qualified Data.Aeson                      as JSON
import qualified Foreign.JavaScript              as JS
import qualified Graphics.UI.Threepenny.Internal as Core
import qualified Reactive.Threepenny             as Reactive

-- exports
import Foreign.JavaScript                   (Config(..), defaultConfig)
import Graphics.UI.Threepenny.Internal
import Reactive.Threepenny                  hiding (onChange)


{-----------------------------------------------------------------------------
    Server
------------------------------------------------------------------------------}
{- $server

To display the user interface, you have to start a server using 'startGUI'.
Then, visit the URL <http://localhost:8023/> in your browser
(assuming that you use the default server configuration 'defaultConfig',
or have set the port number to @jsPort=Just 8023@.)

The server is multithreaded.
FFI calls can be made concurrently, but events are handled sequentially.

FFI calls can be __buffered__,
so in some circumstances, it may happen that you manipulate the browser window,
but the effect is not immediately visible.
See 'CallBufferMode' for more information.

-}

{-----------------------------------------------------------------------------
    Browser window
------------------------------------------------------------------------------}
-- | Title of the client window.
title :: WriteAttr Window String
title :: WriteAttr Window String
title = forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr forall a b. (a -> b) -> a -> b
$ \String
s Window
_ ->
    JSFunction () -> UI ()
runFunction forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"document.title = %1;" String
s

{-----------------------------------------------------------------------------
    DOM Elements
------------------------------------------------------------------------------}
-- | Append DOM elements as children to a given element.
(#+) :: UI Element -> [UI Element] -> UI Element
#+ :: UI Element -> [UI Element] -> UI Element
(#+) UI Element
mx [UI Element]
mys = do
    Element
x  <- UI Element
mx
    [Element]
ys <- forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence [UI Element]
mys
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Element -> Element -> UI ()
Core.appendChild Element
x) [Element]
ys
    forall (m :: * -> *) a. Monad m => a -> m a
return Element
x

-- | Child elements of a given element.
children :: WriteAttr Element [Element]
children :: WriteAttr Element [Element]
children = forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr forall {t :: * -> *}. Foldable t => t Element -> Element -> UI ()
set
    where
    set :: t Element -> Element -> UI ()
set t Element
xs Element
x = do
        Element -> UI ()
Core.clearChildren Element
x
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Element -> Element -> UI ()
Core.appendChild Element
x) t Element
xs

-- | Child elements of a given element as a HTML string.
html :: WriteAttr Element String
html :: WriteAttr Element String
html = forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr forall a b. (a -> b) -> a -> b
$ \String
s Element
el ->
    JSFunction () -> UI ()
runFunction forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"$(%1).html(%2)" Element
el String
s

-- | HTML attributes of an element.
attr :: String -> WriteAttr Element String
attr :: String -> WriteAttr Element String
attr String
name = forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr forall a b. (a -> b) -> a -> b
$ \String
s Element
el ->
    JSFunction () -> UI ()
runFunction forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"$(%1).attr(%2,%3)" Element
el String
name String
s

-- | Set CSS style of an Element
style :: WriteAttr Element [(String,String)]
style :: WriteAttr Element [(String, String)]
style = forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr forall a b. (a -> b) -> a -> b
$ \[(String, String)]
xs Element
el -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
xs forall a b. (a -> b) -> a -> b
$ \(String
name,String
val) -> 
    JSFunction () -> UI ()
runFunction forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"%1.style[%2] = %3" Element
el String
name String
val

-- | Value attribute of an element.
-- Particularly relevant for control widgets like 'input'.
value :: Attr Element String
value :: Attr Element String
value = forall x o i.
(x -> UI o) -> (i -> x -> UI ()) -> ReadWriteAttr x i o
mkReadWriteAttr forall {t} {a}. (ToJS t, FromJS a) => t -> UI a
get forall {t} {t}. (ToJS t, ToJS t) => t -> t -> UI ()
set
    where
    get :: t -> UI a
get   t
el = forall a. JSFunction a -> UI a
callFunction forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"$(%1).val()" t
el
    set :: t -> t -> UI ()
set t
v t
el = JSFunction () -> UI ()
runFunction  forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"$(%1).val(%2)" t
el t
v

-- | Text content of an element.
text :: WriteAttr Element String
text :: WriteAttr Element String
text = forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr forall a b. (a -> b) -> a -> b
$ \String
s Element
el ->
    JSFunction () -> UI ()
runFunction forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"$(%1).text(%2)" Element
el String
s

-- | Make a @span@ element with a given text content.
string :: String -> UI Element
string :: String -> UI Element
string String
s = String -> UI Element
mkElement String
"span" forall a b. a -> (a -> b) -> b
# forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set WriteAttr Element String
text String
s

-- | Get the head of the page.
getHead :: Window -> UI Element
getHead :: Window -> UI Element
getHead Window
_ = JSObject -> UI Element
fromJSObject forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. JSFunction a -> UI a
callFunction (forall a. FFI a => String -> a
ffi String
"document.head")

-- | Get the body of the page.
getBody :: Window -> UI Element
getBody :: Window -> UI Element
getBody Window
_ = JSObject -> UI Element
fromJSObject forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. JSFunction a -> UI a
callFunction (forall a. FFI a => String -> a
ffi String
"document.body")

-- | Get all elements of the given tag name.
getElementsByTagName
    :: Window        -- ^ Browser window
    -> String        -- ^ The tag name.
    -> UI [Element]  -- ^ All elements with that tag name.
getElementsByTagName :: Window -> String -> UI [Element]
getElementsByTagName Window
_ String
tag =
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JSObject -> UI Element
fromJSObject forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. JSFunction a -> UI a
callFunction (forall a. FFI a => String -> a
ffi String
"document.getElementsByTagName(%1)" String
tag)

-- | Get an element by a particular ID.
getElementById
    :: Window              -- ^ Browser window
    -> String              -- ^ The ID string.
    -> UI (Maybe Element)  -- ^ Element (if any) with given ID.
getElementById :: Window -> String -> UI (Maybe Element)
getElementById Window
_ String
id =
    forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle (\(JavaScriptException
e :: JS.JavaScriptException) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSObject -> UI Element
fromJSObject forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. JSFunction a -> UI a
callFunction (forall a. FFI a => String -> a
ffi String
"document.getElementById(%1)" String
id)

-- | Get a list of elements by particular class.
getElementsByClassName
    :: Window        -- ^ Browser window
    -> String        -- ^ The class string.
    -> UI [Element]  -- ^ Elements with given class.
getElementsByClassName :: Window -> String -> UI [Element]
getElementsByClassName Window
window String
s =
    forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM JSObject -> UI Element
fromJSObject forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. JSFunction a -> UI a
callFunction (forall a. FFI a => String -> a
ffi String
"document.getElementsByClassName(%1)" String
s)

{-----------------------------------------------------------------------------
    Layout
------------------------------------------------------------------------------}
-- | Align given elements in a row. Special case of 'grid'.
row :: [UI Element] -> UI Element
row :: [UI Element] -> UI Element
row [UI Element]
xs = [[UI Element]] -> UI Element
grid [[UI Element]
xs]

-- | Align given elements in a column. Special case of 'grid'.
column :: [UI Element] -> UI Element
column :: [UI Element] -> UI Element
column = [[UI Element]] -> UI Element
grid forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[])

-- | Align given elements in a rectangular grid.
--
-- Layout is achieved by using the CSS @display:table@ property.
-- The following element tree will be generated
--
-- >  <div class="table">
-- >    <div class="table-row">
-- >      <div class="table-cell"> ... </div>
-- >      <div class="table-cell"> ... </div>
-- >    </div>
-- >    <div class="table-row">
-- >      ...
-- >    </div>
-- >   ...
-- >   </div>
--
-- You can customatize the actual layout by assigning an @id@ to the element
-- and changing the @.table@, @.table-row@ and @table-column@
-- classes in a custom CSS file.
grid    :: [[UI Element]] -> UI Element
grid :: [[UI Element]] -> UI Element
grid [[UI Element]]
mrows = do
        [[Element]]
rows0 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence) [[UI Element]]
mrows

        [Element]
rows  <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Element]]
rows0 forall a b. (a -> b) -> a -> b
$ \[Element]
row0 -> do
            [Element]
row <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Element]
row0 forall a b. (a -> b) -> a -> b
$ \Element
entry ->
                forall {a}. Widget a => String -> [a] -> UI Element
wrap String
"table-cell" [Element
entry]
            forall {a}. Widget a => String -> [a] -> UI Element
wrap String
"table-row" [Element]
row
        forall {a}. Widget a => String -> [a] -> UI Element
wrap String
"table" [Element]
rows

    where
    wrap :: String -> [a] -> UI Element
wrap String
c [a]
xs = String -> UI Element
mkElement String
"div" forall a b. a -> (a -> b) -> b
# forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set (String -> WriteAttr Element String
attr String
"class") String
c UI Element -> [UI Element] -> UI Element
#+ forall a b. (a -> b) -> [a] -> [b]
map forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element [a]
xs

{-----------------------------------------------------------------------------
    Events
------------------------------------------------------------------------------}
-- | Convenience function to register 'Event's for 'Element's.
--
-- Example usage.
--
-- > on click element $ \_ -> ...
on :: (element -> Event a) -> element -> (a -> UI void) -> UI ()
on :: forall element a void.
(element -> Event a) -> element -> (a -> UI void) -> UI ()
on element -> Event a
f element
x = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a void. Event a -> (a -> UI void) -> UI (UI ())
onEvent (element -> Event a
f element
x)

-- | Register an 'UI' action to be executed whenever the 'Event' happens.
--
-- FIXME: Should be unified with 'on'?
onEvent :: Event a -> (a -> UI void) -> UI (UI ())
onEvent :: forall a void. Event a -> (a -> UI void) -> UI (UI ())
onEvent Event a
e a -> UI void
h = do
    Window
window <- UI Window
askWindow
    let flush :: UI ()
flush = forall a. (Window -> IO a) -> UI a
liftJSWindow forall a b. (a -> b) -> a -> b
$ \Window
w -> do
            CallBufferMode
mode <- Window -> IO CallBufferMode
JS.getCallBufferMode Window
w
            case CallBufferMode
mode of
                CallBufferMode
FlushOften -> Window -> IO ()
JS.flushCallBuffer Window
w
                CallBufferMode
_          -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    IO ()
unregister <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Event a -> Handler a -> IO (IO ())
register Event a
e (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Window -> UI a -> IO a
runUI Window
window forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UI ()
flush) forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UI void
h)
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
unregister)

-- | Execute a 'UI' action whenever a 'Behavior' changes.
-- Use sparingly, it is recommended that you use 'sink' instead.
onChanges :: Behavior a -> (a -> UI void) -> UI ()
onChanges :: forall a void. Behavior a -> (a -> UI void) -> UI ()
onChanges Behavior a
b a -> UI void
f = do
    Window
window <- UI Window
askWindow
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Behavior a -> Handler a -> IO ()
Reactive.onChange Behavior a
b (forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Window -> UI a -> IO a
runUI Window
window forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UI void
f)

{-----------------------------------------------------------------------------
    Attributes
------------------------------------------------------------------------------}
infixl 8 #
infixl 8 #+
infixl 8 #.

-- | Reverse function application.
-- Allows convenient notation for setting properties.
--
-- Example usage.
--
-- > mkElement "div"
-- >     # set style     [("color","#CCAABB")]
-- >     # set draggable True
-- >     # set children  otherElements
(#) :: a -> (a -> b) -> b
# :: forall a b. a -> (a -> b) -> b
(#) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> a -> b
($)

-- | Convenient combinator for setting the CSS class on element creation.
(#.) :: UI Element -> String -> UI Element
#. :: UI Element -> String -> UI Element
(#.) UI Element
mx String
s = UI Element
mx forall a b. a -> (a -> b) -> b
# forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set (String -> WriteAttr Element String
attr String
"class") String
s

-- | Attributes can be 'set' and 'get'.
type Attr x a = ReadWriteAttr x a a

-- | Attribute that only supports the 'get' operation.
type ReadAttr x o = ReadWriteAttr x () o

-- | Attribute that only supports the 'set' operation.
type WriteAttr x i = ReadWriteAttr x i ()

-- | Generalized attribute with different types for getting and setting.
data ReadWriteAttr x i o = ReadWriteAttr
    { forall x i o. ReadWriteAttr x i o -> x -> UI o
get' :: x -> UI o
    , forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' :: i -> x -> UI ()
    }

instance Functor (ReadWriteAttr x i) where
    fmap :: forall a b. (a -> b) -> ReadWriteAttr x i a -> ReadWriteAttr x i b
fmap a -> b
f = forall i' i o o' x.
(i' -> i)
-> (o -> o') -> ReadWriteAttr x i o -> ReadWriteAttr x i' o'
bimapAttr forall a. a -> a
id a -> b
f

-- | Map input and output type of an attribute.
bimapAttr :: (i' -> i) -> (o -> o')
          -> ReadWriteAttr x i o -> ReadWriteAttr x i' o'
bimapAttr :: forall i' i o o' x.
(i' -> i)
-> (o -> o') -> ReadWriteAttr x i o -> ReadWriteAttr x i' o'
bimapAttr i' -> i
from o -> o'
to ReadWriteAttr x i o
attr = ReadWriteAttr x i o
attr
    { get' :: x -> UI o'
get' = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap o -> o'
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x i o. ReadWriteAttr x i o -> x -> UI o
get' ReadWriteAttr x i o
attr
    , set' :: i' -> x -> UI ()
set' = \i'
i' -> forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' ReadWriteAttr x i o
attr (i' -> i
from i'
i')
    }

-- | Set value of an attribute in the 'UI' monad.
-- Best used in conjunction with '#'.
set :: ReadWriteAttr x i o -> i -> UI x -> UI x
set :: forall x i o. ReadWriteAttr x i o -> i -> UI x -> UI x
set ReadWriteAttr x i o
attr i
i UI x
mx = do { x
x <- UI x
mx; forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' ReadWriteAttr x i o
attr i
i x
x; forall (m :: * -> *) a. Monad m => a -> m a
return x
x; }

-- | Set the value of an attribute to a 'Behavior', that is a time-varying value.
--
-- Note: For reasons of efficiency, the attribute is only
-- updated when the value changes.
sink :: ReadWriteAttr x i o -> Behavior i -> UI x -> UI x
sink :: forall x i o. ReadWriteAttr x i o -> Behavior i -> UI x -> UI x
sink ReadWriteAttr x i o
attr Behavior i
bi UI x
mx = do
    x
x <- UI x
mx
    Window
window <- UI Window
askWindow
    IO () -> UI ()
liftIOLater forall a b. (a -> b) -> a -> b
$ do
        i
i <- forall (m :: * -> *) a. MonadIO m => Behavior a -> m a
currentValue Behavior i
bi
        forall a. Window -> UI a -> IO a
runUI Window
window forall a b. (a -> b) -> a -> b
$ forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' ReadWriteAttr x i o
attr i
i x
x
        forall a. Behavior a -> Handler a -> IO ()
Reactive.onChange Behavior i
bi  forall a b. (a -> b) -> a -> b
$ \i
i -> forall a. Window -> UI a -> IO a
runUI Window
window forall a b. (a -> b) -> a -> b
$ forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' ReadWriteAttr x i o
attr i
i x
x
    forall (m :: * -> *) a. Monad m => a -> m a
return x
x

-- | Get attribute value.
get :: ReadWriteAttr x i o -> x -> UI o
get :: forall x i o. ReadWriteAttr x i o -> x -> UI o
get ReadWriteAttr x i o
attr = forall x i o. ReadWriteAttr x i o -> x -> UI o
get' ReadWriteAttr x i o
attr

-- | Build an attribute from a getter and a setter.
mkReadWriteAttr
    :: (x -> UI o)          -- ^ Getter.
    -> (i -> x -> UI ())    -- ^ Setter.
    -> ReadWriteAttr x i o
mkReadWriteAttr :: forall x o i.
(x -> UI o) -> (i -> x -> UI ()) -> ReadWriteAttr x i o
mkReadWriteAttr x -> UI o
get i -> x -> UI ()
set = ReadWriteAttr { get' :: x -> UI o
get' = x -> UI o
get, set' :: i -> x -> UI ()
set' = i -> x -> UI ()
set }

-- | Build attribute from a getter.
mkReadAttr :: (x -> UI o) -> ReadAttr x o
mkReadAttr :: forall x o. (x -> UI o) -> ReadAttr x o
mkReadAttr x -> UI o
get = forall x o i.
(x -> UI o) -> (i -> x -> UI ()) -> ReadWriteAttr x i o
mkReadWriteAttr x -> UI o
get (\()
_ x
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Build attribute from a setter.
mkWriteAttr :: (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr :: forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr i -> x -> UI ()
set = forall x o i.
(x -> UI o) -> (i -> x -> UI ()) -> ReadWriteAttr x i o
mkReadWriteAttr (\x
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()) i -> x -> UI ()
set

-- | Turn a jQuery property @.prop()@ into an attribute.
fromJQueryProp :: String -> (JSON.Value -> a) -> (a -> JSON.Value) -> Attr Element a
fromJQueryProp :: forall a. String -> (Value -> a) -> (a -> Value) -> Attr Element a
fromJQueryProp String
name Value -> a
from a -> Value
to = forall x o i.
(x -> UI o) -> (i -> x -> UI ()) -> ReadWriteAttr x i o
mkReadWriteAttr forall {t}. ToJS t => t -> UI a
get forall {t}. ToJS t => a -> t -> UI ()
set
    where
    set :: a -> t -> UI ()
set a
v t
el = JSFunction () -> UI ()
runFunction forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"$(%1).prop(%2,%3)" t
el String
name (a -> Value
to a
v)
    get :: t -> UI a
get   t
el = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> a
from forall a b. (a -> b) -> a -> b
$ forall a. JSFunction a -> UI a
callFunction forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi String
"$(%1).prop(%2)" t
el String
name

-- | Turn a JavaScript object property @.prop = ...@ into an attribute.
fromObjectProperty :: (FromJS a, ToJS a) => String -> Attr Element a
fromObjectProperty :: forall a. (FromJS a, ToJS a) => String -> Attr Element a
fromObjectProperty String
name = forall x o i.
(x -> UI o) -> (i -> x -> UI ()) -> ReadWriteAttr x i o
mkReadWriteAttr forall {t} {a}. (ToJS t, FromJS a) => t -> UI a
get forall {t} {t}. (ToJS t, ToJS t) => t -> t -> UI ()
set
    where
    set :: t -> t -> UI ()
set t
v t
el = JSFunction () -> UI ()
runFunction  forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi (String
"%1." forall a. [a] -> [a] -> [a]
++ String
name forall a. [a] -> [a] -> [a]
++ String
" = %2") t
el t
v    
    get :: t -> UI a
get   t
el = forall a. JSFunction a -> UI a
callFunction forall a b. (a -> b) -> a -> b
$ forall a. FFI a => String -> a
ffi (String
"%1." forall a. [a] -> [a] -> [a]
++ String
name) t
el

{-----------------------------------------------------------------------------
    Widget class
------------------------------------------------------------------------------}
-- | Widgets are data types that have a visual representation.
class Widget w where
    getElement :: w -> Element

instance Widget Element where
    getElement :: Element -> Element
getElement = forall a. a -> a
id

-- | Convenience synonym for 'return' to make elements work well with 'set'.
-- Also works on 'Widget's.
--
-- Example usage.
--
-- > e <- mkElement "button"
-- > element e # set text "Ok"
element :: MonadIO m => Widget w => w -> m Element
element :: forall (m :: * -> *) w. (MonadIO m, Widget w) => w -> m Element
element = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w. Widget w => w -> Element
getElement

-- | Convenience synonym for 'return' to make widgets work well with 'set'.
widget  :: Widget w => w -> UI w
widget :: forall w. Widget w => w -> UI w
widget  = forall (m :: * -> *) a. Monad m => a -> m a
return