{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
module Reflex.Dom.Widget.Basic
  (
  -- * Displaying Values
    text
  , dynText
  , comment
  , dynComment
  , display
  , button
  , dyn
  , dyn_
  , widgetHold
  , widgetHold_

  -- * Creating DOM Elements
  , el
  , elAttr
  , elClass
  , elDynAttr
  , elDynClass
  , elDynAttrNS

  -- ** With Element Results
  , el'
  , elAttr'
  , elClass'
  , elDynAttr'
  , elDynClass'
  , elDynAttrNS'
  , dynamicAttributesToModifyAttributes
  , dynamicAttributesToModifyAttributesWithInitial

  -- * Specific DOM Elements
  , Link (..)
  , linkClass
  , link
  , divClass
  , dtdd
  , blank

  -- * Tables and Lists
  , tableDynAttr
  , tabDisplay

  , HasAttributes (..)
  , module Data.Map.Misc
  , module Reflex.Collection
  , module Reflex.Workflow
  , partitionMapBySetLT
  ) where

import Reflex.Adjustable.Class
import Reflex.Class
import Reflex.Collection
import Reflex.Dom.Builder.Class
import Reflex.Dom.Class
import Reflex.Dynamic
import Reflex.Network
import Reflex.PostBuild.Class
import Reflex.Workflow

import Control.Lens hiding (children, element)
import Control.Monad.Fix
import Data.Align
import Data.Default
import Data.Functor (void)
import Data.Kind (Type)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Map.Misc
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import Data.These

-- | Breaks the given Map into pieces based on the given Set.  Each piece will contain only keys that are less than the key of the piece, and greater than or equal to the key of the piece with the next-smaller key.  There will be one additional piece containing all keys from the original Map that are larger or equal to the largest key in the Set.
-- Either k () is used instead of Maybe k so that the resulting map of pieces is sorted so that the additional piece has the largest key.
-- No empty pieces will be included in the output.

--TODO: This can probably be done more efficiently by dividing and conquering, re-using the structure of the Set instead of going through the Set linearally
{-# DEPRECATED partitionMapBySetLT "This will be removed in future releases." #-}
partitionMapBySetLT :: forall k v. Ord k => Set k -> Map k v -> Map (Either k ()) (Map k v)
partitionMapBySetLT :: forall k v.
Ord k =>
Set k -> Map k v -> Map (Either k ()) (Map k v)
partitionMapBySetLT Set k
s Map k v
m0 = [(Either k (), Map k v)] -> Map (Either k ()) (Map k v)
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(Either k (), Map k v)] -> Map (Either k ()) (Map k v))
-> [(Either k (), Map k v)] -> Map (Either k ()) (Map k v)
forall a b. (a -> b) -> a -> b
$ [k] -> Map k v -> [(Either k (), Map k v)]
go (Set k -> [k]
forall a. Set a -> [a]
Set.toAscList Set k
s) Map k v
m0
  where go :: [k] -> Map k v -> [(Either k (), Map k v)]
        go :: [k] -> Map k v -> [(Either k (), Map k v)]
go [] Map k v
m = if Map k v -> Bool
forall k a. Map k a -> Bool
Map.null Map k v
m
                  then []
                  else [(() -> Either k ()
forall a b. b -> Either a b
Right (), Map k v
m)]
        go (k
h:[k]
t) Map k v
m = let (Map k v
lt, Maybe v
eq, Map k v
gt) = k -> Map k v -> (Map k v, Maybe v, Map k v)
forall k a. Ord k => k -> Map k a -> (Map k a, Maybe a, Map k a)
Map.splitLookup k
h Map k v
m
                         geq :: Map k v
geq = (Map k v -> Map k v)
-> (v -> Map k v -> Map k v) -> Maybe v -> Map k v -> Map k v
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Map k v -> Map k v
forall a. a -> a
id (k -> v -> Map k v -> Map k v
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
h) Maybe v
eq Map k v
gt
                     in if Map k v -> Bool
forall k a. Map k a -> Bool
Map.null Map k v
lt
                        then [k] -> Map k v -> [(Either k (), Map k v)]
go [k]
t Map k v
geq
                        else (k -> Either k ()
forall a b. a -> Either a b
Left k
h, Map k v
lt) (Either k (), Map k v)
-> [(Either k (), Map k v)] -> [(Either k (), Map k v)]
forall a. a -> [a] -> [a]
: [k] -> Map k v -> [(Either k (), Map k v)]
go [k]
t Map k v
geq

{-# INLINABLE text #-}
text :: DomBuilder t m => Text -> m ()
text :: forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
t = m (TextNode (DomBuilderSpace m) t) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (TextNode (DomBuilderSpace m) t) -> m ())
-> m (TextNode (DomBuilderSpace m) t) -> m ()
forall a b. (a -> b) -> a -> b
$ TextNodeConfig t -> m (TextNode (DomBuilderSpace m) t)
forall t (m :: * -> *).
DomBuilder t m =>
TextNodeConfig t -> m (TextNode (DomBuilderSpace m) t)
textNode (TextNodeConfig t -> m (TextNode (DomBuilderSpace m) t))
-> TextNodeConfig t -> m (TextNode (DomBuilderSpace m) t)
forall a b. (a -> b) -> a -> b
$ TextNodeConfig t
forall a. Default a => a
def TextNodeConfig t
-> (TextNodeConfig t -> TextNodeConfig t) -> TextNodeConfig t
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> TextNodeConfig t -> Identity (TextNodeConfig t)
forall k (t :: k) (f :: * -> *).
Functor f =>
(Text -> f Text) -> TextNodeConfig t -> f (TextNodeConfig t)
textNodeConfig_initialContents ((Text -> Identity Text)
 -> TextNodeConfig t -> Identity (TextNodeConfig t))
-> Text -> TextNodeConfig t -> TextNodeConfig t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
t

{-# INLINABLE dynText #-}
dynText :: forall t m. (PostBuild t m, DomBuilder t m) => Dynamic t Text -> m ()
dynText :: forall t (m :: * -> *).
(PostBuild t m, DomBuilder t m) =>
Dynamic t Text -> m ()
dynText Dynamic t Text
t = do
  postBuild <- m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
  void $ textNode $ (def :: TextNodeConfig t) & textNodeConfig_setContents .~ leftmost
    [ updated t
    , tag (current t) postBuild
    ]
  notReadyUntil postBuild

comment :: DomBuilder t m => Text -> m ()
comment :: forall t (m :: * -> *). DomBuilder t m => Text -> m ()
comment Text
t = m (CommentNode (DomBuilderSpace m) t) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (CommentNode (DomBuilderSpace m) t) -> m ())
-> m (CommentNode (DomBuilderSpace m) t) -> m ()
forall a b. (a -> b) -> a -> b
$ CommentNodeConfig t -> m (CommentNode (DomBuilderSpace m) t)
forall t (m :: * -> *).
DomBuilder t m =>
CommentNodeConfig t -> m (CommentNode (DomBuilderSpace m) t)
commentNode (CommentNodeConfig t -> m (CommentNode (DomBuilderSpace m) t))
-> CommentNodeConfig t -> m (CommentNode (DomBuilderSpace m) t)
forall a b. (a -> b) -> a -> b
$ CommentNodeConfig t
forall a. Default a => a
def CommentNodeConfig t
-> (CommentNodeConfig t -> CommentNodeConfig t)
-> CommentNodeConfig t
forall a b. a -> (a -> b) -> b
& (Text -> Identity Text)
-> CommentNodeConfig t -> Identity (CommentNodeConfig t)
forall k (t :: k) (f :: * -> *).
Functor f =>
(Text -> f Text) -> CommentNodeConfig t -> f (CommentNodeConfig t)
commentNodeConfig_initialContents ((Text -> Identity Text)
 -> CommentNodeConfig t -> Identity (CommentNodeConfig t))
-> Text -> CommentNodeConfig t -> CommentNodeConfig t
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
t

{-# INLINABLE dynComment #-}
dynComment :: forall t m. (PostBuild t m, DomBuilder t m) => Dynamic t Text -> m ()
dynComment :: forall t (m :: * -> *).
(PostBuild t m, DomBuilder t m) =>
Dynamic t Text -> m ()
dynComment Dynamic t Text
t = do
  postBuild <- m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
  void $ commentNode $ (def :: CommentNodeConfig t) & commentNodeConfig_setContents .~ leftmost
    [ updated t
    , tag (current t) postBuild
    ]
  notReadyUntil postBuild

display :: (PostBuild t m, DomBuilder t m, Show a) => Dynamic t a -> m ()
display :: forall t (m :: * -> *) a.
(PostBuild t m, DomBuilder t m, Show a) =>
Dynamic t a -> m ()
display = Dynamic t Text -> m ()
forall t (m :: * -> *).
(PostBuild t m, DomBuilder t m) =>
Dynamic t Text -> m ()
dynText (Dynamic t Text -> m ())
-> (Dynamic t a -> Dynamic t Text) -> Dynamic t a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Text) -> Dynamic t a -> Dynamic t Text
forall a b. (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show)

button :: DomBuilder t m => Text -> m (Event t ())
button :: forall t (m :: * -> *). DomBuilder t m => Text -> m (Event t ())
button Text
t = do
  (e, _) <- Text
-> ElementConfig EventResult t (DomBuilderSpace m)
-> m ()
-> m (Element EventResult (DomBuilderSpace m) t, ())
forall t (m :: * -> *) (er :: EventTag -> *) a.
DomBuilder t m =>
Text
-> ElementConfig er t (DomBuilderSpace m)
-> m a
-> m (Element er (DomBuilderSpace m) t, a)
forall (er :: EventTag -> *) a.
Text
-> ElementConfig er t (DomBuilderSpace m)
-> m a
-> m (Element er (DomBuilderSpace m) t, a)
element Text
"button" ElementConfig EventResult t (DomBuilderSpace m)
forall a. Default a => a
def (m () -> m (Element EventResult (DomBuilderSpace m) t, ()))
-> m () -> m (Element EventResult (DomBuilderSpace m) t, ())
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
t
  return $ domEvent Click e

--TODO: Should this be renamed to 'widgetView' for consistency with 'widgetHold'?
-- | Given a Dynamic of widget-creating actions, create a widget that is recreated whenever the Dynamic updates.
--   The returned Event occurs whenever the child widget is updated, which is
--   at post-build in addition to the times at which the input Dynamic is
--   updated, and its value is the result of running the widget.
--   Note:  Often, the type @a@ is an 'Event', in which case the return value is an Event-of-Events that would typically be flattened (via 'switchHold').
dyn :: (Adjustable t m, NotReady t m, PostBuild t m) => Dynamic t (m a) -> m (Event t a)
dyn :: forall t (m :: * -> *) a.
(Adjustable t m, NotReady t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
dyn = Dynamic t (m a) -> m (Event t a)
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView

-- | Like 'dyn' but discards result.
dyn_ :: (Adjustable t m, NotReady t m, PostBuild t m) => Dynamic t (m a) -> m ()
dyn_ :: forall t (m :: * -> *) a.
(Adjustable t m, NotReady t m, PostBuild t m) =>
Dynamic t (m a) -> m ()
dyn_ = m (Event t a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Event t a) -> m ())
-> (Dynamic t (m a) -> m (Event t a)) -> Dynamic t (m a) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic t (m a) -> m (Event t a)
forall t (m :: * -> *) a.
(Adjustable t m, NotReady t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
dyn

-- | Given an initial widget and an Event of widget-creating actions, create a widget that is recreated whenever the Event fires.
--   The returned Dynamic of widget results occurs when the Event does.
--   Note:  Often, the type 'a' is an Event, in which case the return value is a Dynamic-of-Events that would typically be flattened (via 'switchDyn').
widgetHold :: (Adjustable t m, MonadHold t m) => m a -> Event t (m a) -> m (Dynamic t a)
widgetHold :: forall t (m :: * -> *) a.
(Adjustable t m, MonadHold t m) =>
m a -> Event t (m a) -> m (Dynamic t a)
widgetHold = m a -> Event t (m a) -> m (Dynamic t a)
forall t (m :: * -> *) a.
(Adjustable t m, MonadHold t m) =>
m a -> Event t (m a) -> m (Dynamic t a)
networkHold

-- | Like 'widgetHold' but discards result.
widgetHold_ :: (Adjustable t m, MonadHold t m) => m a -> Event t (m a) -> m ()
widgetHold_ :: forall t (m :: * -> *) a.
(Adjustable t m, MonadHold t m) =>
m a -> Event t (m a) -> m ()
widgetHold_ m a
z = m (Dynamic t a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Dynamic t a) -> m ())
-> (Event t (m a) -> m (Dynamic t a)) -> Event t (m a) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> Event t (m a) -> m (Dynamic t a)
forall t (m :: * -> *) a.
(Adjustable t m, MonadHold t m) =>
m a -> Event t (m a) -> m (Dynamic t a)
widgetHold m a
z

-- | Create a DOM element
--
-- >>> el "div" (text "Hello World")
-- <div>Hello World</div>
{-# INLINABLE el #-}
el :: forall t m a. DomBuilder t m => Text -> m a -> m a
el :: forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
elementTag m a
child = (Element EventResult (DomBuilderSpace m) t, a) -> a
forall a b. (a, b) -> b
snd ((Element EventResult (DomBuilderSpace m) t, a) -> a)
-> m (Element EventResult (DomBuilderSpace m) t, a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
el' Text
elementTag m a
child

-- | Create a DOM element with attributes
--
-- >>> elAttr "a" ("href" =: "https://reflex-frp.org") (text "Reflex-FRP!")
-- <a href="https://reflex-frp.org">Reflex-FRP!</a>
{-# INLINABLE elAttr #-}
elAttr :: forall t m a. DomBuilder t m => Text -> Map Text Text -> m a -> m a
elAttr :: forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr Text
elementTag Map Text Text
attrs m a
child = (Element EventResult (DomBuilderSpace m) t, a) -> a
forall a b. (a, b) -> b
snd ((Element EventResult (DomBuilderSpace m) t, a) -> a)
-> m (Element EventResult (DomBuilderSpace m) t, a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Map Text Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) a.
DomBuilder t m =>
Text
-> Map Text Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elAttr' Text
elementTag Map Text Text
attrs m a
child

-- | Create a DOM element with classes
--
-- >>> elClass "div" "row" (return ())
-- <div class="row"></div>
{-# INLINABLE elClass #-}
elClass :: forall t m a. DomBuilder t m => Text -> Text -> m a -> m a
elClass :: forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Text -> m a -> m a
elClass Text
elementTag Text
c m a
child = (Element EventResult (DomBuilderSpace m) t, a) -> a
forall a b. (a, b) -> b
snd ((Element EventResult (DomBuilderSpace m) t, a) -> a)
-> m (Element EventResult (DomBuilderSpace m) t, a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) a.
DomBuilder t m =>
Text
-> Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
elClass' Text
elementTag Text
c m a
child

-- | Create a DOM element with Dynamic Attributes
--
-- >>> elClass "div" (constDyn ("class" =: "row")) (return ())
-- <div class="row"></div>
{-# INLINABLE elDynAttr #-}
elDynAttr :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t (Map Text Text) -> m a -> m a
elDynAttr :: forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text -> Dynamic t (Map Text Text) -> m a -> m a
elDynAttr Text
elementTag Dynamic t (Map Text Text)
attrs m a
child = (Element EventResult (DomBuilderSpace m) t, a) -> a
forall a b. (a, b) -> b
snd ((Element EventResult (DomBuilderSpace m) t, a) -> a)
-> m (Element EventResult (DomBuilderSpace m) t, a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elDynAttr' Text
elementTag Dynamic t (Map Text Text)
attrs m a
child

-- | Create a DOM element with a Dynamic Class
--
-- >>> elDynClass "div" (constDyn "row") (return ())
-- <div class="row"></div>
{-# INLINABLE elDynClass #-}
elDynClass :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t Text -> m a -> m a
elDynClass :: forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text -> Dynamic t Text -> m a -> m a
elDynClass Text
elementTag Dynamic t Text
c m a
child = (Element EventResult (DomBuilderSpace m) t, a) -> a
forall a b. (a, b) -> b
snd ((Element EventResult (DomBuilderSpace m) t, a) -> a)
-> m (Element EventResult (DomBuilderSpace m) t, a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> Dynamic t Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text
-> Dynamic t Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elDynClass' Text
elementTag Dynamic t Text
c m a
child

-- | Create a DOM element and return the element
--
-- @
--  do (e, _) <- el' "div" (text "Click")
--     return $ domEvent Click e
-- @
{-# INLINABLE el' #-}
el' :: forall t m a. DomBuilder t m => Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
el' :: forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
el' Text
elementTag = Text
-> ElementConfig EventResult t (DomBuilderSpace m)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) (er :: EventTag -> *) a.
DomBuilder t m =>
Text
-> ElementConfig er t (DomBuilderSpace m)
-> m a
-> m (Element er (DomBuilderSpace m) t, a)
forall (er :: EventTag -> *) a.
Text
-> ElementConfig er t (DomBuilderSpace m)
-> m a
-> m (Element er (DomBuilderSpace m) t, a)
element Text
elementTag ElementConfig EventResult t (DomBuilderSpace m)
forall a. Default a => a
def

-- | Create a DOM element with attributes and return the element
{-# INLINABLE elAttr' #-}
elAttr' :: forall t m a. DomBuilder t m => Text -> Map Text Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
elAttr' :: forall t (m :: * -> *) a.
DomBuilder t m =>
Text
-> Map Text Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elAttr' Text
elementTag Map Text Text
attrs = Text
-> ElementConfig EventResult t (DomBuilderSpace m)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) (er :: EventTag -> *) a.
DomBuilder t m =>
Text
-> ElementConfig er t (DomBuilderSpace m)
-> m a
-> m (Element er (DomBuilderSpace m) t, a)
forall (er :: EventTag -> *) a.
Text
-> ElementConfig er t (DomBuilderSpace m)
-> m a
-> m (Element er (DomBuilderSpace m) t, a)
element Text
elementTag (ElementConfig EventResult t (DomBuilderSpace m)
 -> m a -> m (Element EventResult (DomBuilderSpace m) t, a))
-> ElementConfig EventResult t (DomBuilderSpace m)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
forall a b. (a -> b) -> a -> b
$ ElementConfig EventResult t (DomBuilderSpace m)
forall a. Default a => a
def
  ElementConfig EventResult t (DomBuilderSpace m)
-> (ElementConfig EventResult t (DomBuilderSpace m)
    -> ElementConfig EventResult t (DomBuilderSpace m))
-> ElementConfig EventResult t (DomBuilderSpace m)
forall a b. a -> (a -> b) -> b
& (Map AttributeName Text -> Identity (Map AttributeName Text))
-> ElementConfig EventResult t (DomBuilderSpace m)
-> Identity (ElementConfig EventResult t (DomBuilderSpace m))
forall a. InitialAttributes a => Lens' a (Map AttributeName Text)
Lens'
  (ElementConfig EventResult t (DomBuilderSpace m))
  (Map AttributeName Text)
initialAttributes ((Map AttributeName Text -> Identity (Map AttributeName Text))
 -> ElementConfig EventResult t (DomBuilderSpace m)
 -> Identity (ElementConfig EventResult t (DomBuilderSpace m)))
-> Map AttributeName Text
-> ElementConfig EventResult t (DomBuilderSpace m)
-> ElementConfig EventResult t (DomBuilderSpace m)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Text -> AttributeName) -> Map Text Text -> Map AttributeName Text
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys (Maybe Text -> Text -> AttributeName
AttributeName Maybe Text
forall a. Maybe a
Nothing) Map Text Text
attrs

-- | Create a DOM element with a class and return the element
{-# INLINABLE elClass' #-}
elClass' :: forall t m a. DomBuilder t m => Text -> Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
elClass' :: forall t (m :: * -> *) a.
DomBuilder t m =>
Text
-> Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
elClass' Text
elementTag Text
c = Text
-> Map Text Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) a.
DomBuilder t m =>
Text
-> Map Text Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elAttr' Text
elementTag (Text
Index (Map Text Text)
"class" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: Text
IxValue (Map Text Text)
c)

-- | Create a DOM element with Dynamic Attributes and return the element
{-# INLINABLE elDynAttr' #-}
elDynAttr' :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t (Map Text Text) -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
elDynAttr' :: forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elDynAttr' = Maybe Text
-> Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Maybe Text
-> Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elDynAttrNS' Maybe Text
forall a. Maybe a
Nothing

-- | Create a DOM element with a Dynamic class and return the element
{-# INLINABLE elDynClass' #-}
elDynClass' :: forall t m a. (DomBuilder t m, PostBuild t m) => Text -> Dynamic t Text -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
elDynClass' :: forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text
-> Dynamic t Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elDynClass' Text
elementTag Dynamic t Text
c = Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elDynAttr' Text
elementTag ((Text -> Map Text Text)
-> Dynamic t Text -> Dynamic t (Map Text Text)
forall a b. (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
Index (Map Text Text)
"class" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=:) Dynamic t Text
c)

{-# INLINABLE elDynAttrNS' #-}
elDynAttrNS' :: forall t m a. (DomBuilder t m, PostBuild t m) => Maybe Text -> Text -> Dynamic t (Map Text Text) -> m a -> m (Element EventResult (DomBuilderSpace m) t, a)
elDynAttrNS' :: forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Maybe Text
-> Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elDynAttrNS' Maybe Text
mns Text
elementTag Dynamic t (Map Text Text)
attrs m a
child = do
  modifyAttrs <- Dynamic t (Map Text Text) -> m (Event t (Map Text (Maybe Text)))
forall k t (m :: * -> *).
(Ord k, PostBuild t m) =>
Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributes Dynamic t (Map Text Text)
attrs
  let cfg = ElementConfig EventResult t (DomBuilderSpace m)
forall a. Default a => a
def
        ElementConfig EventResult t (DomBuilderSpace m)
-> (ElementConfig EventResult t (DomBuilderSpace m)
    -> ElementConfig EventResult t (DomBuilderSpace m))
-> ElementConfig EventResult t (DomBuilderSpace m)
forall a b. a -> (a -> b) -> b
& (Maybe Text -> Identity (Maybe Text))
-> ElementConfig EventResult t (DomBuilderSpace m)
-> Identity (ElementConfig EventResult t (DomBuilderSpace m))
forall (er :: EventTag -> *) k1 (t :: k1) k2 (s :: k2)
       (f :: * -> *).
Functor f =>
(Maybe Text -> f (Maybe Text))
-> ElementConfig er t s -> f (ElementConfig er t s)
elementConfig_namespace ((Maybe Text -> Identity (Maybe Text))
 -> ElementConfig EventResult t (DomBuilderSpace m)
 -> Identity (ElementConfig EventResult t (DomBuilderSpace m)))
-> Maybe Text
-> ElementConfig EventResult t (DomBuilderSpace m)
-> ElementConfig EventResult t (DomBuilderSpace m)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Text
mns
        ElementConfig EventResult t (DomBuilderSpace m)
-> (ElementConfig EventResult t (DomBuilderSpace m)
    -> ElementConfig EventResult t (DomBuilderSpace m))
-> ElementConfig EventResult t (DomBuilderSpace m)
forall a b. a -> (a -> b) -> b
& (Event t (Map AttributeName (Maybe Text))
 -> Identity (Event t (Map AttributeName (Maybe Text))))
-> ElementConfig EventResult t (DomBuilderSpace m)
-> Identity (ElementConfig EventResult t (DomBuilderSpace m))
forall {k} (t :: k) a.
(ModifyAttributes t a, Reflex t) =>
Lens' a (Event t (Map AttributeName (Maybe Text)))
Lens'
  (ElementConfig EventResult t (DomBuilderSpace m))
  (Event t (Map AttributeName (Maybe Text)))
modifyAttributes ((Event t (Map AttributeName (Maybe Text))
  -> Identity (Event t (Map AttributeName (Maybe Text))))
 -> ElementConfig EventResult t (DomBuilderSpace m)
 -> Identity (ElementConfig EventResult t (DomBuilderSpace m)))
-> Event t (Map AttributeName (Maybe Text))
-> ElementConfig EventResult t (DomBuilderSpace m)
-> ElementConfig EventResult t (DomBuilderSpace m)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Map Text (Maybe Text) -> Map AttributeName (Maybe Text))
-> Event t (Map Text (Maybe Text))
-> Event t (Map AttributeName (Maybe Text))
forall {k} (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap Map Text (Maybe Text) -> Map AttributeName (Maybe Text)
forall v. Map Text v -> Map AttributeName v
mapKeysToAttributeName Event t (Map Text (Maybe Text))
modifyAttrs
  result <- element elementTag cfg child
  postBuild <- getPostBuild
  notReadyUntil postBuild
  return result

{-# INLINABLE elDynAttrNS #-}
elDynAttrNS :: forall t m a. (DomBuilder t m, PostBuild t m) => Maybe Text -> Text -> Dynamic t (Map Text Text) -> m a -> m a
elDynAttrNS :: forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Maybe Text -> Text -> Dynamic t (Map Text Text) -> m a -> m a
elDynAttrNS Maybe Text
mns Text
elementTag Dynamic t (Map Text Text)
attrs m a
child = ((Element EventResult (DomBuilderSpace m) t, a) -> a)
-> m (Element EventResult (DomBuilderSpace m) t, a) -> m a
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Element EventResult (DomBuilderSpace m) t, a) -> a
forall a b. (a, b) -> b
snd (m (Element EventResult (DomBuilderSpace m) t, a) -> m a)
-> m (Element EventResult (DomBuilderSpace m) t, a) -> m a
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Maybe Text
-> Text
-> Dynamic t (Map Text Text)
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elDynAttrNS' Maybe Text
mns Text
elementTag Dynamic t (Map Text Text)
attrs m a
child

dynamicAttributesToModifyAttributes :: (Ord k, PostBuild t m) => Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributes :: forall k t (m :: * -> *).
(Ord k, PostBuild t m) =>
Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributes = Map k Text
-> Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
forall k t (m :: * -> *).
(Ord k, PostBuild t m) =>
Map k Text
-> Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributesWithInitial Map k Text
forall a. Monoid a => a
mempty

dynamicAttributesToModifyAttributesWithInitial :: (Ord k, PostBuild t m) => Map k Text -> Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributesWithInitial :: forall k t (m :: * -> *).
(Ord k, PostBuild t m) =>
Map k Text
-> Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))
dynamicAttributesToModifyAttributesWithInitial Map k Text
attrs0 Dynamic t (Map k Text)
d = do
  postBuild <- m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
  let modificationsNeeded = ((These () (Map k Text) -> PushM t (Maybe (Map k (Maybe Text))))
 -> Event t (These () (Map k Text)) -> Event t (Map k (Maybe Text)))
-> Event t (These () (Map k Text))
-> (These () (Map k Text) -> PushM t (Maybe (Map k (Maybe Text))))
-> Event t (Map k (Maybe Text))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (These () (Map k Text) -> PushM t (Maybe (Map k (Maybe Text))))
-> Event t (These () (Map k Text)) -> Event t (Map k (Maybe Text))
forall {k} (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
forall a b. (a -> PushM t (Maybe b)) -> Event t a -> Event t b
push (Event t ()
-> Event t (Map k Text) -> Event t (These () (Map k Text))
forall a b. Event t a -> Event t b -> Event t (These a b)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t ()
postBuild (Event t (Map k Text) -> Event t (These () (Map k Text)))
-> Event t (Map k Text) -> Event t (These () (Map k Text))
forall a b. (a -> b) -> a -> b
$ Dynamic t (Map k Text) -> Event t (Map k Text)
forall a. Dynamic t a -> Event t a
forall {k} (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Map k Text)
d) ((These () (Map k Text) -> PushM t (Maybe (Map k (Maybe Text))))
 -> Event t (Map k (Maybe Text)))
-> (These () (Map k Text) -> PushM t (Maybe (Map k (Maybe Text))))
-> Event t (Map k (Maybe Text))
forall a b. (a -> b) -> a -> b
$ \These () (Map k Text)
x -> do
        p <- case These () (Map k Text)
x of
          This () -> do
            new <- Behavior t (Map k Text) -> PushM t (Map k Text)
forall a. Behavior t a -> PushM t a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t (Map k Text) -> PushM t (Map k Text))
-> Behavior t (Map k Text) -> PushM t (Map k Text)
forall a b. (a -> b) -> a -> b
$ Dynamic t (Map k Text) -> Behavior t (Map k Text)
forall a. Dynamic t a -> Behavior t a
forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Map k Text)
d
            return $ diffMap attrs0 new
          These () Map k Text
new -> Map k (Maybe Text) -> PushM t (Map k (Maybe Text))
forall a. a -> PushM t a
forall (m :: * -> *) a. Monad m => a -> m a
return (Map k (Maybe Text) -> PushM t (Map k (Maybe Text)))
-> Map k (Maybe Text) -> PushM t (Map k (Maybe Text))
forall a b. (a -> b) -> a -> b
$ Map k Text -> Map k Text -> Map k (Maybe Text)
forall k v. (Ord k, Eq v) => Map k v -> Map k v -> Map k (Maybe v)
diffMap Map k Text
attrs0 Map k Text
new
          That Map k Text
new -> do
            old <- Behavior t (Map k Text) -> PushM t (Map k Text)
forall a. Behavior t a -> PushM t a
forall {k} (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t (Map k Text) -> PushM t (Map k Text))
-> Behavior t (Map k Text) -> PushM t (Map k Text)
forall a b. (a -> b) -> a -> b
$ Dynamic t (Map k Text) -> Behavior t (Map k Text)
forall a. Dynamic t a -> Behavior t a
forall {k} (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Map k Text)
d
            return $ diffMap old new
        return $ if Map.null p then Nothing else Just p
  return modificationsNeeded

newtype Link t
  = Link { forall t. Link t -> Event t ()
_link_clicked :: Event t ()
         }

linkClass :: DomBuilder t m => Text -> Text -> m (Link t)
linkClass :: forall t (m :: * -> *).
DomBuilder t m =>
Text -> Text -> m (Link t)
linkClass Text
s Text
c = do
  (l,_) <- Text
-> Map Text Text
-> m ()
-> m (Element EventResult (DomBuilderSpace m) t, ())
forall t (m :: * -> *) a.
DomBuilder t m =>
Text
-> Map Text Text
-> m a
-> m (Element EventResult (DomBuilderSpace m) t, a)
elAttr' Text
"a" (Text
Index (Map Text Text)
"class" Index (Map Text Text) -> IxValue (Map Text Text) -> Map Text Text
forall m. (At m, Monoid m) => Index m -> IxValue m -> m
=: Text
IxValue (Map Text Text)
c) (m () -> m (Element EventResult (DomBuilderSpace m) t, ()))
-> m () -> m (Element EventResult (DomBuilderSpace m) t, ())
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
s
  return $ Link $ domEvent Click l

link :: DomBuilder t m => Text -> m (Link t)
link :: forall t (m :: * -> *). DomBuilder t m => Text -> m (Link t)
link Text
s = Text -> Text -> m (Link t)
forall t (m :: * -> *).
DomBuilder t m =>
Text -> Text -> m (Link t)
linkClass Text
s Text
""

divClass :: forall t m a. DomBuilder t m => Text -> m a -> m a
divClass :: forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
divClass = Text -> Text -> m a -> m a
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Text -> m a -> m a
elClass Text
"div"

dtdd :: forall t m a. DomBuilder t m => Text -> m a -> m a
dtdd :: forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
dtdd Text
h m a
w = do
  Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"dt" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
h
  Text -> m a -> m a
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"dd" m a
w

blank :: forall m. Monad m => m ()
blank :: forall (m :: * -> *). Monad m => m ()
blank = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- TODO: Move to an example project.
-- | A widget to display a table with static columns and dynamic rows.
tableDynAttr :: forall t m r k v. (Ord k, Eq r, DomBuilder t m, MonadHold t m, PostBuild t m, MonadFix m)
  => Text                                   -- ^ Class applied to <table> element
  -> [(Text, k -> Dynamic t r -> m v)]      -- ^ Columns of (header, row key -> row value -> child widget)
  -> Dynamic t (Map k r)                      -- ^ Map from row key to row value
  -> (k -> m (Dynamic t (Map Text Text))) -- ^ Function to compute <tr> element attributes from row key
  -> m (Dynamic t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))        -- ^ Map from row key to (El, list of widget return values)
tableDynAttr :: forall t (m :: * -> *) r k v.
(Ord k, Eq r, DomBuilder t m, MonadHold t m, PostBuild t m,
 MonadFix m) =>
Text
-> [(Text, k -> Dynamic t r -> m v)]
-> Dynamic t (Map k r)
-> (k -> m (Dynamic t (Map Text Text)))
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
tableDynAttr Text
klass [(Text, k -> Dynamic t r -> m v)]
cols Dynamic t (Map k r)
dRows k -> m (Dynamic t (Map Text Text))
rowAttrs = Text
-> Map Text Text
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr Text
"div" (Text -> Text -> Map Text Text
forall k a. k -> a -> Map k a
Map.singleton Text
"style" Text
"zoom: 1; overflow: auto; background: white;") (m (Dynamic
      t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
 -> m (Dynamic
         t (Map k (Element EventResult (DomBuilderSpace m) t, [v]))))
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
forall a b. (a -> b) -> a -> b
$
    Text
-> Map Text Text
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Map Text Text -> m a -> m a
elAttr Text
"table" (Text -> Text -> Map Text Text
forall k a. k -> a -> Map k a
Map.singleton Text
"class" Text
klass) (m (Dynamic
      t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
 -> m (Dynamic
         t (Map k (Element EventResult (DomBuilderSpace m) t, [v]))))
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
forall a b. (a -> b) -> a -> b
$ do
      Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"thead" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"tr" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        ((Text, k -> Dynamic t r -> m v) -> m ())
-> [(Text, k -> Dynamic t r -> m v)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Text
h, k -> Dynamic t r -> m v
_) -> Text -> m () -> m ()
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"th" (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
h) [(Text, k -> Dynamic t r -> m v)]
cols
      Text
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"tbody" (m (Dynamic
      t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
 -> m (Dynamic
         t (Map k (Element EventResult (DomBuilderSpace m) t, [v]))))
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
forall a b. (a -> b) -> a -> b
$
        Dynamic t (Map k r)
-> (k
    -> Dynamic t r
    -> m (Element EventResult (DomBuilderSpace m) t, [v]))
-> m (Dynamic
        t (Map k (Element EventResult (DomBuilderSpace m) t, [v])))
forall t k v (m :: * -> *) a.
(Ord k, Adjustable t m, PostBuild t m, MonadFix m, MonadHold t m,
 Eq v) =>
Dynamic t (Map k v)
-> (k -> Dynamic t v -> m a) -> m (Dynamic t (Map k a))
listWithKey Dynamic t (Map k r)
dRows (\k
k Dynamic t r
r -> do
          dAttrs <- k -> m (Dynamic t (Map Text Text))
rowAttrs k
k
          elDynAttr' "tr" dAttrs $ mapM (\(Text, k -> Dynamic t r -> m v)
x -> Text -> m v -> m v
forall t (m :: * -> *) a. DomBuilder t m => Text -> m a -> m a
el Text
"td" (m v -> m v) -> m v -> m v
forall a b. (a -> b) -> a -> b
$ (Text, k -> Dynamic t r -> m v) -> k -> Dynamic t r -> m v
forall a b. (a, b) -> b
snd (Text, k -> Dynamic t r -> m v)
x k
k Dynamic t r
r) cols)

-- TODO: Move to an example project.
-- | A widget to construct a tabbed view that shows only one of its child widgets at a time.
--   Creates a header bar containing a <ul> with one <li> per child; clicking a <li> displays
--   the corresponding child and hides all others.
tabDisplay :: forall t m k. (MonadFix m, DomBuilder t m, MonadHold t m, PostBuild t m, Ord k)
  => Text               -- ^ Class applied to <ul> element
  -> Text               -- ^ Class applied to currently active <li> element
  -> Map k (Text, m ()) -- ^ Map from (arbitrary) key to (tab label, child widget)
  -> m ()
tabDisplay :: forall t (m :: * -> *) k.
(MonadFix m, DomBuilder t m, MonadHold t m, PostBuild t m,
 Ord k) =>
Text -> Text -> Map k (Text, m ()) -> m ()
tabDisplay Text
ulClass Text
activeClass Map k (Text, m ())
tabItems = do
  let t0 :: Maybe k
t0 = [k] -> Maybe k
forall a. [a] -> Maybe a
listToMaybe ([k] -> Maybe k) -> [k] -> Maybe k
forall a b. (a -> b) -> a -> b
$ Map k (Text, m ()) -> [k]
forall k a. Map k a -> [k]
Map.keys Map k (Text, m ())
tabItems
  rec currentTab :: Demux t (Maybe k) <- elAttr "ul" ("class" =: ulClass) $ do
        tabClicksList :: [Event t k] <- Map.elems <$> imapM (\k
k (Text
s,m ()
_) -> Text -> k -> Dynamic t Bool -> m (Event t k)
headerBarLink Text
s k
k (Dynamic t Bool -> m (Event t k))
-> Dynamic t Bool -> m (Event t k)
forall a b. (a -> b) -> a -> b
$ Demux t (Maybe k) -> Maybe k -> Dynamic t Bool
forall {k1} (t :: k1) k2.
(Reflex t, Eq k2) =>
Demux t k2 -> k2 -> Dynamic t Bool
demuxed Demux t (Maybe k)
currentTab (k -> Maybe k
forall a. a -> Maybe a
Just k
k)) tabItems
        let eTabClicks :: Event t k = leftmost tabClicksList
        fmap demux $ holdDyn t0 $ fmap Just eTabClicks
  el "div" $ do
    iforM_ tabItems $ \k
k (Text
_, m ()
w) -> do
      let isSelected :: Dynamic t Bool
isSelected = Demux t (Maybe k) -> Maybe k -> Dynamic t Bool
forall {k1} (t :: k1) k2.
(Reflex t, Eq k2) =>
Demux t k2 -> k2 -> Dynamic t Bool
demuxed Demux t (Maybe k)
currentTab (Maybe k -> Dynamic t Bool) -> Maybe k -> Dynamic t Bool
forall a b. (a -> b) -> a -> b
$ k -> Maybe k
forall a. a -> Maybe a
Just k
k
          attrs :: Dynamic t (Map Text Text)
attrs = Dynamic t Bool
-> (Bool -> Map Text Text) -> Dynamic t (Map Text Text)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t Bool
isSelected ((Bool -> Map Text Text) -> Dynamic t (Map Text Text))
-> (Bool -> Map Text Text) -> Dynamic t (Map Text Text)
forall a b. (a -> b) -> a -> b
$ \Bool
s -> if Bool
s then Map Text Text
forall k a. Map k a
Map.empty else Text -> Text -> Map Text Text
forall k a. k -> a -> Map k a
Map.singleton Text
"style" Text
"display:none;"
      Text -> Dynamic t (Map Text Text) -> m () -> m ()
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text -> Dynamic t (Map Text Text) -> m a -> m a
elDynAttr Text
"div" Dynamic t (Map Text Text)
attrs m ()
w
    return ()
  where
    headerBarLink :: Text -> k -> Dynamic t Bool -> m (Event t k)
    headerBarLink :: Text -> k -> Dynamic t Bool -> m (Event t k)
headerBarLink Text
x k
k Dynamic t Bool
isSelected = do
      let attrs :: Dynamic t (Map Text Text)
attrs = (Bool -> Map Text Text)
-> Dynamic t Bool -> Dynamic t (Map Text Text)
forall a b. (a -> b) -> Dynamic t a -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Bool
b -> if Bool
b then Text -> Text -> Map Text Text
forall k a. k -> a -> Map k a
Map.singleton Text
"class" Text
activeClass else Map Text Text
forall k a. Map k a
Map.empty) Dynamic t Bool
isSelected
      Text -> Dynamic t (Map Text Text) -> m (Event t k) -> m (Event t k)
forall t (m :: * -> *) a.
(DomBuilder t m, PostBuild t m) =>
Text -> Dynamic t (Map Text Text) -> m a -> m a
elDynAttr Text
"li" Dynamic t (Map Text Text)
attrs (m (Event t k) -> m (Event t k)) -> m (Event t k) -> m (Event t k)
forall a b. (a -> b) -> a -> b
$ do
        a <- Text -> m (Link t)
forall t (m :: * -> *). DomBuilder t m => Text -> m (Link t)
link Text
x
        return $ fmap (const k) (_link_clicked a)

class HasAttributes a where
  type Attrs a :: Type
  attributes :: Lens' a (Attrs a)