{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}


-- | A preliminary renderer that produces `JS` components when run using
-- Fay.
--
module Text.Blaze.Front.Renderer where

import qualified Data.ByteString           as S
import qualified Data.ByteString.Char8     as SBC
import           Data.List                 (isInfixOf)
import           Data.Text                 (Text)
import qualified Data.Text                 as T
import qualified Data.Text.Lazy            as TL
import           Data.Text.Lazy.Builder    (Builder)
import qualified Data.Text.Lazy.Builder    as TLB

import           Prelude                   hiding (span)

import           Text.Blaze.Front
import           Text.Blaze.Front.Internal

-- import qualified Text.Blaze as B
import qualified Text.Blaze.Html           as B

import           Bridge

------------------------------------------------------------------------------
-- Rendering
------------------------------------------------------------------------------


-- | Escape predefined XML entities in a text value
--
escapeMarkupEntities :: Text     -- ^ Text to escape
                   -> Builder  -- ^ Resulting text builder
escapeMarkupEntities :: Text -> Builder
escapeMarkupEntities = (Char -> Builder -> Builder) -> Builder -> Text -> Builder
forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr Char -> Builder -> Builder
escape Builder
forall a. Monoid a => a
mempty
  where
    escape :: Char -> Builder -> Builder
    escape :: Char -> Builder -> Builder
escape Char
'<'  Builder
b = Text -> Builder
TLB.fromText Text
"&lt;"   Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape Char
'>'  Builder
b = Text -> Builder
TLB.fromText Text
"&gt;"   Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape Char
'&'  Builder
b = Text -> Builder
TLB.fromText Text
"&amp;"  Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape Char
'"'  Builder
b = Text -> Builder
TLB.fromText Text
"&quot;" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape Char
'\'' Builder
b = Text -> Builder
TLB.fromText Text
"&#39;"  Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape Char
x    Builder
b = Char -> Builder
TLB.singleton Char
x       Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b

-- | Render a 'ChoiceString'.
--
fromChoiceString :: ChoiceString  -- ^ String to render
                 -> Builder        -- ^ String to append
                 -> Builder        -- ^ Resulting string
fromChoiceString :: ChoiceString -> Builder -> Builder
fromChoiceString (Static StaticString
s)     = (((Text -> Builder
TLB.fromText (Text -> Builder)
-> (StaticString -> Text) -> StaticString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> Text
getText) StaticString
s) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
fromChoiceString (String String
s)     = (((Text -> Builder
escapeMarkupEntities (Text -> Builder) -> (String -> Text) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) String
s) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
fromChoiceString (Text Text
s)       = ((Text -> Builder
escapeMarkupEntities Text
s) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
fromChoiceString (ByteString ByteString
s) = (((Text -> Builder
TLB.fromText (Text -> Builder) -> (ByteString -> Text) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
SBC.unpack) ByteString
s) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
fromChoiceString (PreEscaped ChoiceString
x) =
    case ChoiceString
x of
      String String
s -> (((Text -> Builder
TLB.fromText (Text -> Builder) -> (String -> Text) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) String
s) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
      Text   Text
s -> ((Text -> Builder
TLB.fromText Text
s) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
      ChoiceString
s        -> ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
s
fromChoiceString (External ChoiceString
x) = case ChoiceString
x of
    -- Check that the sequence "</" is *not* in the external data.
    String String
s     -> if String
"</" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
s then Builder -> Builder
forall a. a -> a
id else (((Text -> Builder
TLB.fromText (Text -> Builder) -> (String -> Text) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) String
s) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
    Text   Text
s     -> if Text
"</" Text -> Text -> Bool
`T.isInfixOf` Text
s then Builder -> Builder
forall a. a -> a
id else ((Text -> Builder
TLB.fromText Text
s) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
    ByteString ByteString
s -> if ByteString
"</" ByteString -> ByteString -> Bool
`S.isInfixOf` ByteString
s then Builder -> Builder
forall a. a -> a
id else (((Text -> Builder
TLB.fromText (Text -> Builder) -> (ByteString -> Text) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
SBC.unpack) ByteString
s) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
    ChoiceString
s            -> ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
s
fromChoiceString (AppendChoiceString ChoiceString
x ChoiceString
y) =
    ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
x (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
y
fromChoiceString ChoiceString
EmptyChoiceString = Builder -> Builder
forall a. a -> a
id


-- | Render some 'Markup' to a virtual dom.
--
-- This function is morally pure.
--
render
    :: Show act
    => Markup act
    -> Builder
    -> Builder
render :: Markup act -> Builder -> Builder
render = (Builder -> Builder) -> Markup act -> Builder -> Builder
forall act' b.
(Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
go Builder -> Builder
forall a. a -> a
id
  where
    go :: (Builder -> Builder)
      -> MarkupM act' b
      -> Builder -> Builder
    go :: (Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
go Builder -> Builder
attrs (Parent StaticString
_ StaticString
open StaticString
close MarkupM act' b
content) =
        Builder -> Builder
forall a. a -> a
id
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text -> Builder
TLB.fromText (Text -> Builder)
-> (StaticString -> Text) -> StaticString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> Text
getText) StaticString
open) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
attrs (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> Builder
TLB.fromText Text
">") Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
forall act' b.
(Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
go Builder -> Builder
forall a. a -> a
id MarkupM act' b
content
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text -> Builder
TLB.fromText (Text -> Builder)
-> (StaticString -> Text) -> StaticString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> Text
getText) StaticString
close) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
    go Builder -> Builder
attrs (CustomParent ChoiceString
tag MarkupM act' b
content) =
        Builder -> Builder
forall a. a -> a
id
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> Builder
TLB.singleton Char
'<') Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
tag (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder
attrs)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> Builder
TLB.fromText Text
">") Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
forall act' b.
(Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
go Builder -> Builder
forall a. a -> a
id MarkupM act' b
content
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> Builder
TLB.fromText Text
"</") Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
tag
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> Builder
TLB.fromText Text
">") Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
    go Builder -> Builder
attrs (Leaf StaticString
_ StaticString
begin StaticString
end) =
        Builder -> Builder
forall a. a -> a
id
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text -> Builder
TLB.fromText (Text -> Builder)
-> (StaticString -> Text) -> StaticString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> Text
getText) StaticString
begin) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder
attrs)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((Text -> Builder
TLB.fromText (Text -> Builder)
-> (StaticString -> Text) -> StaticString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> Text
getText) StaticString
end) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
    go Builder -> Builder
attrs (CustomLeaf ChoiceString
tag Bool
close) =
        Builder -> Builder
forall a. a -> a
id
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> Builder
TLB.singleton Char
'<') Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
tag (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
attrs
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> Builder
TLB.fromText (if Bool
close then Text
" />" else Text
">")) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
    go Builder -> Builder
attrs (AddAttribute StaticString
_ StaticString
key ChoiceString
value MarkupM act' b
h) = ((Builder -> Builder) -> MarkupM act' b -> Builder -> Builder)
-> MarkupM act' b -> (Builder -> Builder) -> Builder -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
forall act' b.
(Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
go MarkupM act' b
h ((Builder -> Builder) -> Builder -> Builder)
-> (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
        (((Text -> Builder
TLB.fromText (Text -> Builder)
-> (StaticString -> Text) -> StaticString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticString -> Text
getText) StaticString
key) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
value
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> Builder
TLB.singleton Char
'"') Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`) (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Builder
attrs
    go Builder -> Builder
attrs (AddCustomAttribute ChoiceString
key ChoiceString
value MarkupM act' b
h) = ((Builder -> Builder) -> MarkupM act' b -> Builder -> Builder)
-> MarkupM act' b -> (Builder -> Builder) -> Builder -> Builder
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
forall act' b.
(Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
go MarkupM act' b
h ((Builder -> Builder) -> Builder -> Builder)
-> (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$
        ((Char -> Builder
TLB.singleton Char
' ') Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
key
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> Builder
TLB.fromText Text
"=\"") Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
value
        (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Char -> Builder
TLB.singleton Char
'"') Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`) (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Builder -> Builder
attrs
    go Builder -> Builder
_ (Content ChoiceString
content) = ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
content
    go Builder -> Builder
attrs (Append MarkupM act' b
h1 MarkupM act' c
h2) = (Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
forall act' b.
(Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
go Builder -> Builder
attrs MarkupM act' b
h1 (Builder -> Builder) -> (Builder -> Builder) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder -> Builder) -> MarkupM act' c -> Builder -> Builder
forall act' b.
(Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
go Builder -> Builder
attrs MarkupM act' c
h2
    go Builder -> Builder
_ (MarkupM act' b
Empty) = Builder -> Builder
forall a. a -> a
id
    go Builder -> Builder
_ (MapActions act' -> act'
_ MarkupM act' b
_) = Builder -> Builder
forall a. a -> a
id
    go Builder -> Builder
attrs (OnEvent EventHandler act'
_ MarkupM act' b
h) = (Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
forall act' b.
(Builder -> Builder) -> MarkupM act' b -> Builder -> Builder
go Builder -> Builder
attrs MarkupM act' b
h  -- will be registered later through registerEvent
    {-# NOINLINE go #-}

    -- Increase the indentation
    -- inc = (+) 4

    -- Produce appending indentation
    -- ind i = ((TLB.fromString (replicate i ' ')) `mappend`)
{-# INLINE render #-}

renderHtml
    :: Show act
    => Markup act
    -> String
renderHtml :: Markup act -> String
renderHtml Markup act
html = Text -> String
TL.unpack (Text -> String) -> (Builder -> Text) -> Builder -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText (Builder -> String) -> Builder -> String
forall a b. (a -> b) -> a -> b
$ Markup act -> Builder -> Builder
forall act. Show act => Markup act -> Builder -> Builder
render Markup act
html Builder
TLB.flush
{-# INLINE renderHtml #-}

------------------------------------------------------------------------------
-- Event handler callback construction
------------------------------------------------------------------------------

-- | JS defines the following event types:
data EventType
      -- Clipboard Events
    = OnCopyE | OnCutE | OnPasteE
      -- Keyboard Events
    | OnKeyDownE | OnKeyPressE | OnKeyUpE
      -- Focus Events
    | OnFocusE | OnBlurE
      -- Form Events
    | OnChangeE | OnInputE | OnSubmitE
      -- Mouse Events
    | OnClickE | OnDoubleClickE | OnDragE | OnDragEndE | OnDragEnterE
    | OnDragExitE | OnDragLeaveE | OnDragOverE | OnDragStartE | OnDropE
    | OnMouseDownE | OnMouseEnterE | OnMouseLeaveE | OnMouseMoveE
    | OnMouseOutE | OnMouseOverE | OnMouseUpE
      -- Touch Events
    | OnTouchCancelE | OnTouchEndE | OnTouchMoveE | OnTouchStartE
      -- UI Events
    | OnScrollE
      -- Wheel Events
    | OnWheelE

eventName :: EventType -> String
eventName :: EventType -> String
eventName EventType
_ = String
""
{-eventName ev = case ev of
    OnCopyE        -> "onCopy"
    OnCutE         -> "onCut"
    OnPasteE       -> "onPaste"
    OnKeyDownE     -> "onKeyDown"
    OnKeyPressE    -> "onKeyPress"
    OnKeyUpE       -> "onKeyUp"
    OnFocusE       -> "onFocus"
    OnBlurE        -> "onBlur"
    OnChangeE      -> "onChange"
    OnInputE       -> "onInput"
    OnSubmitE      -> "onSubmit"
    OnClickE       -> "onClick"
    OnDoubleClickE -> "onDoubleClick"
    OnDragE        -> "onDrag"
    OnDragEndE     -> "onDragEnd"
    OnDragEnterE   -> "onDragEnter"
    OnDragExitE    -> "onDragExit"
    OnDragLeaveE   -> "onDragLeave"
    OnDragOverE    -> "onDragOver"
    OnDragStartE   -> "onDragStart"
    OnDropE        -> "onDrop"
    OnMouseDownE   -> "onMouseDown"
    OnMouseEnterE  -> "onMouseEnter"
    OnMouseLeaveE  -> "onMouseLeave"
    OnMouseMoveE   -> "onMouseMove"
    OnMouseOutE    -> "onMouseOut"
    OnMouseOverE   -> "onMouseOver"
    OnMouseUpE     -> "onMouseUp"
    OnTouchCancelE -> "onTouchCancel"
    OnTouchEndE    -> "onTouchEnd"
    OnTouchMoveE   -> "onTouchMove"
    OnTouchStartE  -> "onTouchStart"
    OnScrollE      -> "onScroll"
    OnWheelE       -> "onWheel"-}

data Handler
    = IgnoreEvent
    | HandleEvent (IO (Bool -> IO ()))
      -- ^ Contains an IO action which generates the callback to attach to the event

registerEvents
    :: Markup a -> [CallbackAction a] -> [CallbackAction a]
registerEvents :: Markup a -> [CallbackAction a] -> [CallbackAction a]
registerEvents Markup a
x = Markup a -> [CallbackAction a] -> [CallbackAction a]
forall a b. MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
go Markup a
x
  where
    go :: MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
    go :: MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
go (MapActions act' -> a
_ MarkupM act' b
_)           = [CallbackAction a] -> [CallbackAction a]
forall a. a -> a
id
    go (Parent StaticString
_ StaticString
_ StaticString
_ MarkupM a b
content)     = MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
forall a b. MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
go MarkupM a b
content
    go (CustomParent ChoiceString
_ MarkupM a b
content)   = MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
forall a b. MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
go MarkupM a b
content
    go (Leaf StaticString
_ StaticString
_ StaticString
_)               = [CallbackAction a] -> [CallbackAction a]
forall a. a -> a
id
    go (CustomLeaf ChoiceString
_ Bool
_)           = [CallbackAction a] -> [CallbackAction a]
forall a. a -> a
id
    go (Content ChoiceString
_)                = [CallbackAction a] -> [CallbackAction a]
forall a. a -> a
id
    go (Append MarkupM a b
a MarkupM a c
b)               = (MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
forall a b. MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
go MarkupM a b
a) ([CallbackAction a] -> [CallbackAction a])
-> ([CallbackAction a] -> [CallbackAction a])
-> [CallbackAction a]
-> [CallbackAction a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MarkupM a c -> [CallbackAction a] -> [CallbackAction a]
forall a b. MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
go MarkupM a c
b)
    go (AddAttribute StaticString
_ StaticString
_ ChoiceString
_ MarkupM a b
a)     = MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
forall a b. MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
go MarkupM a b
a
    go (AddCustomAttribute ChoiceString
_ ChoiceString
_ MarkupM a b
a) = MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
forall a b. MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
go MarkupM a b
a
    go MarkupM a b
Empty                      = [CallbackAction a] -> [CallbackAction a]
forall a. a -> a
id
    go (OnEvent EventHandler a
eh MarkupM a b
a)             = ((EventHandler a -> CallbackAction a
forall a. EventHandler a -> CallbackAction a
reg EventHandler a
eh) CallbackAction a -> [CallbackAction a] -> [CallbackAction a]
forall a. a -> [a] -> [a]
:) ([CallbackAction a] -> [CallbackAction a])
-> ([CallbackAction a] -> [CallbackAction a])
-> [CallbackAction a]
-> [CallbackAction a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
forall a b. MarkupM a b -> [CallbackAction a] -> [CallbackAction a]
go MarkupM a b
a)

    reg :: EventHandler a -> CallbackAction a
reg EventHandler a
x' = EventHandler a -> CallbackAction a
forall a. EventHandler a -> CallbackAction a
CallbackAction EventHandler a
x'

renderNewMarkup :: Show act => Markup act -> B.Html
renderNewMarkup :: Markup act -> Html
renderNewMarkup = Text -> Html
forall a. ToMarkup a => a -> Html
B.preEscapedToHtml (Text -> Html) -> (Markup act -> Text) -> Markup act -> Html
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Markup act -> String) -> Markup act -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Markup act -> String
forall act. Show act => Markup act -> String
renderHtml