{-# 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 '<'  b :: Builder
b = Text -> Builder
TLB.fromText "&lt;"   Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape '>'  b :: Builder
b = Text -> Builder
TLB.fromText "&gt;"   Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape '&'  b :: Builder
b = Text -> Builder
TLB.fromText "&amp;"  Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape '"'  b :: Builder
b = Text -> Builder
TLB.fromText "&quot;" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape '\'' b :: Builder
b = Text -> Builder
TLB.fromText "&#39;"  Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Builder
b
    escape x :: Char
x    b :: 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 s :: 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 s :: 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 s :: Text
s)       = ((Text -> Builder
escapeMarkupEntities Text
s) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
fromChoiceString (ByteString s :: 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 x :: ChoiceString
x) =
    case ChoiceString
x of
      String s :: 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   s :: Text
s -> ((Text -> Builder
TLB.fromText Text
s) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
      s :: ChoiceString
s        -> ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
s
fromChoiceString (External x :: ChoiceString
x) = case ChoiceString
x of
    -- Check that the sequence "</" is *not* in the external data.
    String s :: String
s     -> if "</" 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   s :: Text
s     -> if "</" 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 s :: ByteString
s -> if "</" 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`)
    s :: ChoiceString
s            -> ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
s
fromChoiceString (AppendChoiceString x :: ChoiceString
x y :: 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 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 attrs :: Builder -> Builder
attrs (Parent _ open :: StaticString
open close :: StaticString
close content :: 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 ">") 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 attrs :: Builder -> Builder
attrs (CustomParent tag :: ChoiceString
tag content :: 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 '<') 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 ">") 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 "</") 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 ">") Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
    go attrs :: Builder -> Builder
attrs (Leaf _ begin :: StaticString
begin end :: 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 attrs :: Builder -> Builder
attrs (CustomLeaf tag :: ChoiceString
tag close :: 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 '<') 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 " />" else ">")) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`)
    go attrs :: Builder -> Builder
attrs (AddAttribute _ key :: StaticString
key value :: ChoiceString
value h :: 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 '"') 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 attrs :: Builder -> Builder
attrs (AddCustomAttribute key :: ChoiceString
key value :: ChoiceString
value h :: 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 ' ') 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 "=\"") 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 '"') 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 _ (Content content :: ChoiceString
content) = ChoiceString -> Builder -> Builder
fromChoiceString ChoiceString
content
    go attrs :: Builder -> Builder
attrs (Append h1 :: MarkupM act' b
h1 h2 :: 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 _ (MarkupM act' b
Empty) = Builder -> Builder
forall a. a -> a
id
    go _ (MapActions _ _) = Builder -> Builder
forall a. a -> a
id
    go attrs :: Builder -> Builder
attrs (OnEvent _ h :: 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 html :: 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 _ = ""
{-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 x :: 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 _ _)           = [CallbackAction a] -> [CallbackAction a]
forall a. a -> a
id
    go (Parent _ _ _ content :: 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 _ content :: 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 _ _ _)               = [CallbackAction a] -> [CallbackAction a]
forall a. a -> a
id
    go (CustomLeaf _ _)           = [CallbackAction a] -> [CallbackAction a]
forall a. a -> a
id
    go (Content _)                = [CallbackAction a] -> [CallbackAction a]
forall a. a -> a
id
    go (Append a :: MarkupM a b
a b :: 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 _ _ _ a :: 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 _ _ a :: 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 Empty                      = [CallbackAction a] -> [CallbackAction a]
forall a. a -> a
id
    go (OnEvent eh :: EventHandler a
eh a :: 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 x' :: 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