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

    -- * Server
    -- $server
    Config(..), ConfigSSL (..), 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(..), ConfigSSL (..), 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 = (String -> Window -> UI ()) -> WriteAttr Window String
forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr ((String -> Window -> UI ()) -> WriteAttr Window String)
-> (String -> Window -> UI ()) -> WriteAttr Window String
forall a b. (a -> b) -> a -> b
$ \String
s Window
_ ->
    JSFunction () -> UI ()
runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> String -> JSFunction ()
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 <- [UI Element] -> UI [Element]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [UI Element]
mys
    (Element -> UI ()) -> [Element] -> UI ()
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
    Element -> UI Element
forall a. a -> UI a
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 = ([Element] -> Element -> UI ()) -> WriteAttr Element [Element]
forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr [Element] -> Element -> UI ()
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
        (Element -> UI ()) -> t Element -> UI ()
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 = (String -> Element -> UI ()) -> WriteAttr Element String
forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr ((String -> Element -> UI ()) -> WriteAttr Element String)
-> (String -> Element -> UI ()) -> WriteAttr Element String
forall a b. (a -> b) -> a -> b
$ \String
s Element
el ->
    JSFunction () -> UI ()
runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Element -> String -> JSFunction ()
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 = (String -> Element -> UI ()) -> WriteAttr Element String
forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr ((String -> Element -> UI ()) -> WriteAttr Element String)
-> (String -> Element -> UI ()) -> WriteAttr Element String
forall a b. (a -> b) -> a -> b
$ \String
s Element
el ->
    JSFunction () -> UI ()
runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Element -> String -> String -> JSFunction ()
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 = ([(String, String)] -> Element -> UI ())
-> WriteAttr Element [(String, String)]
forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr (([(String, String)] -> Element -> UI ())
 -> WriteAttr Element [(String, String)])
-> ([(String, String)] -> Element -> UI ())
-> WriteAttr Element [(String, String)]
forall a b. (a -> b) -> a -> b
$ \[(String, String)]
xs Element
el -> [(String, String)] -> ((String, String) -> UI ()) -> UI ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, String)]
xs (((String, String) -> UI ()) -> UI ())
-> ((String, String) -> UI ()) -> UI ()
forall a b. (a -> b) -> a -> b
$ \(String
name,String
val) ->
    JSFunction () -> UI ()
runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Element -> String -> String -> JSFunction ()
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 = (Element -> UI String)
-> (String -> Element -> UI ()) -> Attr Element String
forall x o i.
(x -> UI o) -> (i -> x -> UI ()) -> ReadWriteAttr x i o
mkReadWriteAttr Element -> UI String
forall {t} {a}. (ToJS t, FromJS a) => t -> UI a
get String -> Element -> UI ()
forall {t} {t}. (ToJS t, ToJS t) => t -> t -> UI ()
set
    where
    get :: t -> UI a
get   t
el = JSFunction a -> UI a
forall a. JSFunction a -> UI a
callFunction (JSFunction a -> UI a) -> JSFunction a -> UI a
forall a b. (a -> b) -> a -> b
$ String -> t -> JSFunction a
forall a. FFI a => String -> a
ffi String
"$(%1).val()" t
el
    set :: t -> t -> UI ()
set t
v t
el = JSFunction () -> UI ()
runFunction  (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> t -> t -> JSFunction ()
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 = (String -> Element -> UI ()) -> WriteAttr Element String
forall i x. (i -> x -> UI ()) -> WriteAttr x i
mkWriteAttr ((String -> Element -> UI ()) -> WriteAttr Element String)
-> (String -> Element -> UI ()) -> WriteAttr Element String
forall a b. (a -> b) -> a -> b
$ \String
s Element
el ->
    JSFunction () -> UI ()
runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> Element -> String -> JSFunction ()
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" UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# WriteAttr Element String -> String -> UI Element -> UI Element
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 (JSObject -> UI Element) -> UI JSObject -> UI Element
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSFunction JSObject -> UI JSObject
forall a. JSFunction a -> UI a
callFunction (String -> JSFunction JSObject
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 (JSObject -> UI Element) -> UI JSObject -> UI Element
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSFunction JSObject -> UI JSObject
forall a. JSFunction a -> UI a
callFunction (String -> JSFunction JSObject
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 =
    (JSObject -> UI Element) -> [JSObject] -> UI [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM JSObject -> UI Element
fromJSObject ([JSObject] -> UI [Element]) -> UI [JSObject] -> UI [Element]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSFunction [JSObject] -> UI [JSObject]
forall a. JSFunction a -> UI a
callFunction (String -> String -> JSFunction [JSObject]
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
ident =
    (JavaScriptException -> UI (Maybe Element))
-> UI (Maybe Element) -> UI (Maybe Element)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
E.handle (\(JavaScriptException
_ :: JS.JavaScriptException) -> Maybe Element -> UI (Maybe Element)
forall a. a -> UI a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Element
forall a. Maybe a
Nothing) (UI (Maybe Element) -> UI (Maybe Element))
-> UI (Maybe Element) -> UI (Maybe Element)
forall a b. (a -> b) -> a -> b
$
        (Element -> Maybe Element) -> UI Element -> UI (Maybe Element)
forall a b. (a -> b) -> UI a -> UI b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Element -> Maybe Element
forall a. a -> Maybe a
Just (UI Element -> UI (Maybe Element))
-> (JSObject -> UI Element) -> JSObject -> UI (Maybe Element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSObject -> UI Element
fromJSObject
            (JSObject -> UI (Maybe Element))
-> UI JSObject -> UI (Maybe Element)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSFunction JSObject -> UI JSObject
forall a. JSFunction a -> UI a
callFunction (String -> String -> JSFunction JSObject
forall a. FFI a => String -> a
ffi String
"document.getElementById(%1)" String
ident)

-- | 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
_ String
s =
    (JSObject -> UI Element) -> [JSObject] -> UI [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM JSObject -> UI Element
fromJSObject
        ([JSObject] -> UI [Element]) -> UI [JSObject] -> UI [Element]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< JSFunction [JSObject] -> UI [JSObject]
forall a. JSFunction a -> UI a
callFunction (String -> String -> JSFunction [JSObject]
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 ([[UI Element]] -> UI Element)
-> ([UI Element] -> [[UI Element]]) -> [UI Element] -> UI Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UI Element -> [UI Element]) -> [UI Element] -> [[UI Element]]
forall a b. (a -> b) -> [a] -> [b]
map (UI Element -> [UI Element] -> [UI Element]
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 <- ([UI Element] -> UI [Element]) -> [[UI Element]] -> UI [[Element]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ([UI Element] -> UI [Element]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence) [[UI Element]]
mrows

        [Element]
rows  <- [[Element]] -> ([Element] -> UI Element) -> UI [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [[Element]]
rows0 (([Element] -> UI Element) -> UI [Element])
-> ([Element] -> UI Element) -> UI [Element]
forall a b. (a -> b) -> a -> b
$ \[Element]
row0 -> do
            [Element]
row1 <- [Element] -> (Element -> UI Element) -> UI [Element]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Element]
row0 ((Element -> UI Element) -> UI [Element])
-> (Element -> UI Element) -> UI [Element]
forall a b. (a -> b) -> a -> b
$ \Element
entry ->
                String -> [Element] -> UI Element
forall {a}. Widget a => String -> [a] -> UI Element
wrap String
"table-cell" [Element
entry]
            String -> [Element] -> UI Element
forall {a}. Widget a => String -> [a] -> UI Element
wrap String
"table-row" [Element]
row1
        String -> [Element] -> UI Element
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" UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# WriteAttr Element String -> String -> UI Element -> UI Element
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
#+ (a -> UI Element) -> [a] -> [UI Element]
forall a b. (a -> b) -> [a] -> [b]
map a -> UI Element
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 = UI (UI ()) -> UI ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (UI (UI ()) -> UI ())
-> ((a -> UI void) -> UI (UI ())) -> (a -> UI void) -> UI ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> (a -> UI void) -> UI (UI ())
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 = (Window -> IO ()) -> UI ()
forall a. (Window -> IO a) -> UI a
liftJSWindow ((Window -> IO ()) -> UI ()) -> (Window -> IO ()) -> UI ()
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
_          -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    IO ()
unregister <- IO (IO ()) -> UI (IO ())
forall a. IO a -> UI a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IO ()) -> UI (IO ())) -> IO (IO ()) -> UI (IO ())
forall a b. (a -> b) -> a -> b
$ Event a -> Handler a -> IO (IO ())
forall a. Event a -> Handler a -> IO (IO ())
register Event a
e (IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO ()) -> Handler a -> Handler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> UI () -> IO ()
forall a. Window -> UI a -> IO a
runUI Window
window (UI () -> IO ()) -> (a -> UI ()) -> Handler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UI void -> UI () -> UI ()
forall a b. UI a -> UI b -> UI b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> UI ()
flush) (UI void -> UI ()) -> (a -> UI void) -> a -> UI ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> UI void
h)
    UI () -> UI (UI ())
forall a. a -> UI a
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> UI ()
forall a. IO a -> UI a
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
    IO () -> UI ()
forall a. IO a -> UI a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> UI ()) -> IO () -> UI ()
forall a b. (a -> b) -> a -> b
$ Behavior a -> Handler a -> IO ()
forall a. Behavior a -> Handler a -> IO ()
Reactive.onChange Behavior a
b (IO void -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO void -> IO ()) -> (a -> IO void) -> Handler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> UI void -> IO void
forall a. Window -> UI a -> IO a
runUI Window
window (UI void -> IO void) -> (a -> UI void) -> a -> IO void
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
(#) = ((a -> b) -> a -> b) -> a -> (a -> b) -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> a -> b
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 UI Element -> (UI Element -> UI Element) -> UI Element
forall a b. a -> (a -> b) -> b
# WriteAttr Element String -> String -> UI Element -> UI Element
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 = (i -> i) -> (a -> b) -> ReadWriteAttr x i a -> ReadWriteAttr x i b
forall i' i o o' x.
(i' -> i)
-> (o -> o') -> ReadWriteAttr x i o -> ReadWriteAttr x i' o'
bimapAttr i -> i
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
attribute = ReadWriteAttr x i o
attribute
    { get' = fmap to . get' attribute
    , set' = \i'
i' -> ReadWriteAttr x i o -> i -> x -> UI ()
forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' ReadWriteAttr x i o
attribute (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; ReadWriteAttr x i o -> i -> x -> UI ()
forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' ReadWriteAttr x i o
attr i
i x
x; x -> UI x
forall a. a -> UI a
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
attribute Behavior i
bi UI x
mx = do
    x
x <- UI x
mx
    Window
window <- UI Window
askWindow
    IO () -> UI ()
liftIOLater (IO () -> UI ()) -> IO () -> UI ()
forall a b. (a -> b) -> a -> b
$ do
        i
i0 <- Behavior i -> IO i
forall (m :: * -> *) a. MonadIO m => Behavior a -> m a
currentValue Behavior i
bi
        Window -> UI () -> IO ()
forall a. Window -> UI a -> IO a
runUI Window
window (UI () -> IO ()) -> UI () -> IO ()
forall a b. (a -> b) -> a -> b
$ ReadWriteAttr x i o -> i -> x -> UI ()
forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' ReadWriteAttr x i o
attribute i
i0 x
x
        Behavior i -> Handler i -> IO ()
forall a. Behavior a -> Handler a -> IO ()
Reactive.onChange Behavior i
bi  (Handler i -> IO ()) -> Handler i -> IO ()
forall a b. (a -> b) -> a -> b
$ \i
i -> Window -> UI () -> IO ()
forall a. Window -> UI a -> IO a
runUI Window
window (UI () -> IO ()) -> UI () -> IO ()
forall a b. (a -> b) -> a -> b
$ ReadWriteAttr x i o -> i -> x -> UI ()
forall x i o. ReadWriteAttr x i o -> i -> x -> UI ()
set' ReadWriteAttr x i o
attribute i
i x
x
    x -> UI x
forall a. a -> UI a
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
attribute = ReadWriteAttr x i o -> x -> UI o
forall x i o. ReadWriteAttr x i o -> x -> UI o
get' ReadWriteAttr x i o
attribute

-- | 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
geti i -> x -> UI ()
seto = ReadWriteAttr { get' :: x -> UI o
get' = x -> UI o
geti, set' :: i -> x -> UI ()
set' = i -> x -> UI ()
seto }

-- | 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
geti = (x -> UI o) -> (() -> x -> UI ()) -> ReadWriteAttr x () o
forall x o i.
(x -> UI o) -> (i -> x -> UI ()) -> ReadWriteAttr x i o
mkReadWriteAttr x -> UI o
geti (\()
_ x
_ -> () -> UI ()
forall a. a -> UI a
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 ()
seto = (x -> UI ()) -> (i -> x -> UI ()) -> ReadWriteAttr x i ()
forall x o i.
(x -> UI o) -> (i -> x -> UI ()) -> ReadWriteAttr x i o
mkReadWriteAttr (\x
_ -> () -> UI ()
forall a. a -> UI a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) i -> x -> UI ()
seto

-- | 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 = (Element -> UI a)
-> (a -> Element -> UI ()) -> ReadWriteAttr Element a a
forall x o i.
(x -> UI o) -> (i -> x -> UI ()) -> ReadWriteAttr x i o
mkReadWriteAttr Element -> UI a
forall {t}. ToJS t => t -> UI a
geti a -> Element -> UI ()
forall {t}. ToJS t => a -> t -> UI ()
seto
    where
    seto :: a -> t -> UI ()
seto a
v t
el = JSFunction () -> UI ()
runFunction (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> t -> String -> Value -> JSFunction ()
forall a. FFI a => String -> a
ffi String
"$(%1).prop(%2,%3)" t
el String
name (a -> Value
to a
v)
    geti :: t -> UI a
geti   t
el = (Value -> a) -> UI Value -> UI a
forall a b. (a -> b) -> UI a -> UI b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> a
from (UI Value -> UI a) -> UI Value -> UI a
forall a b. (a -> b) -> a -> b
$ JSFunction Value -> UI Value
forall a. JSFunction a -> UI a
callFunction (JSFunction Value -> UI Value) -> JSFunction Value -> UI Value
forall a b. (a -> b) -> a -> b
$ String -> t -> String -> JSFunction Value
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 = (Element -> UI a)
-> (a -> Element -> UI ()) -> ReadWriteAttr Element a a
forall x o i.
(x -> UI o) -> (i -> x -> UI ()) -> ReadWriteAttr x i o
mkReadWriteAttr Element -> UI a
forall {t} {a}. (ToJS t, FromJS a) => t -> UI a
geti a -> Element -> UI ()
forall {t} {t}. (ToJS t, ToJS t) => t -> t -> UI ()
seto
    where
    seto :: t -> t -> UI ()
seto t
v t
el = JSFunction () -> UI ()
runFunction  (JSFunction () -> UI ()) -> JSFunction () -> UI ()
forall a b. (a -> b) -> a -> b
$ String -> t -> t -> JSFunction ()
forall a. FFI a => String -> a
ffi (String
"%1." String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = %2") t
el t
v
    geti :: t -> UI a
geti   t
el = JSFunction a -> UI a
forall a. JSFunction a -> UI a
callFunction (JSFunction a -> UI a) -> JSFunction a -> UI a
forall a b. (a -> b) -> a -> b
$ String -> t -> JSFunction a
forall a. FFI a => String -> a
ffi (String
"%1." String -> String -> String
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 = Element -> Element
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 = Element -> m Element
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Element -> m Element) -> (w -> Element) -> w -> m Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> Element
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  = w -> UI w
forall a. a -> UI a
forall (m :: * -> *) a. Monad m => a -> m a
return