{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- | This module exists primarily so as to provide an alternative to
-- `elDynHtml'` that works with the static builder. `elRawHtml` is pretty much
-- what you typically need; and if you are on GHCJS, you should define how it
-- will behave via writing instances for `PandocRaw`.
module Reflex.Dom.Pandoc.Raw
  ( RawBuilder,
    elRawHtml,
    PandocRawNode (..),
    elPandocRawNodeSafe,
    PandocRaw (..),
  )
where

import Control.Monad.Fix (MonadFix)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (ReaderT (..), lift)
import Control.Monad.Ref (MonadRef, Ref)
import Control.Monad.State (modify)
import Data.Constraint (Constraint)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8Builder)
import GHC.IORef (IORef)
import Reflex.Dom.Core hiding (Link, Space)
import Reflex.Host.Class (MonadReflexCreateTrigger)
import Text.Pandoc.Definition (Format (..))

type RawBuilder m = (PandocRaw m, PandocRawConstraints m)

elRawHtml :: (RawBuilder m) => Text -> m ()
elRawHtml :: Text -> m ()
elRawHtml =
  PandocRawNode -> m ()
forall (m :: * -> *).
(PandocRaw m, PandocRawConstraints m) =>
PandocRawNode -> m ()
elPandocRaw (PandocRawNode -> m ()) -> (Text -> PandocRawNode) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Format -> Text -> PandocRawNode
PandocRawNode_Block Format
"html"

_elRawHtmlExample :: IO ()
_elRawHtmlExample :: IO ()
_elRawHtmlExample = do
  ((), ByteString)
_ <- StaticWidget Any () -> IO ((), ByteString)
forall k (x :: k) a. StaticWidget x a -> IO (a, ByteString)
renderStatic (StaticWidget Any () -> IO ((), ByteString))
-> StaticWidget Any () -> IO ((), ByteString)
forall a b. (a -> b) -> a -> b
$ do
    Text -> StaticWidget Any ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"some <Text/> before"
    Text -> StaticWidget Any ()
forall (m :: * -> *). RawBuilder m => Text -> m ()
elRawHtml Text
"<b>hello</b> world"
    Text -> StaticWidget Any ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
"some <Text/> after"
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

data PandocRawNode
  = PandocRawNode_Block Format Text
  | PandocRawNode_Inline Format Text
  deriving (PandocRawNode -> PandocRawNode -> Bool
(PandocRawNode -> PandocRawNode -> Bool)
-> (PandocRawNode -> PandocRawNode -> Bool) -> Eq PandocRawNode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PandocRawNode -> PandocRawNode -> Bool
$c/= :: PandocRawNode -> PandocRawNode -> Bool
== :: PandocRawNode -> PandocRawNode -> Bool
$c== :: PandocRawNode -> PandocRawNode -> Bool
Eq, Int -> PandocRawNode -> ShowS
[PandocRawNode] -> ShowS
PandocRawNode -> String
(Int -> PandocRawNode -> ShowS)
-> (PandocRawNode -> String)
-> ([PandocRawNode] -> ShowS)
-> Show PandocRawNode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PandocRawNode] -> ShowS
$cshowList :: [PandocRawNode] -> ShowS
show :: PandocRawNode -> String
$cshow :: PandocRawNode -> String
showsPrec :: Int -> PandocRawNode -> ShowS
$cshowsPrec :: Int -> PandocRawNode -> ShowS
Show)

elPandocRawNodeSafe :: DomBuilder t m => PandocRawNode -> m ()
elPandocRawNodeSafe :: PandocRawNode -> m ()
elPandocRawNodeSafe = \case
  PandocRawNode_Block Format
fmt Text
s ->
    Text -> Format -> Text -> m ()
forall t (m :: * -> *).
DomBuilder t m =>
Text -> Format -> Text -> m ()
elPandocRawSafe Text
"div" Format
fmt Text
s
  PandocRawNode_Inline Format
fmt Text
s ->
    Text -> Format -> Text -> m ()
forall t (m :: * -> *).
DomBuilder t m =>
Text -> Format -> Text -> m ()
elPandocRawSafe Text
"span" Format
fmt Text
s

-- | Class to define how to render pandoc raw nodes
class PandocRaw m where
  -- | The constraints required to render
  type PandocRawConstraints m :: Constraint

  -- | Render a raw content of the given format
  elPandocRaw :: PandocRawConstraints m => PandocRawNode -> m ()

-- | In a static builder, we accept whatever raw html that comes through.
--
-- Non-html formats are rendered as-is.
instance PandocRaw (StaticDomBuilderT t m) where
  type
    PandocRawConstraints (StaticDomBuilderT t m) =
      ( Reflex t,
        Monad m,
        Ref m ~ IORef,
        MonadIO m,
        MonadHold t m,
        MonadFix m,
        MonadRef m,
        Adjustable t m,
        PerformEvent t m,
        MonadReflexCreateTrigger t m
      )
  elPandocRaw :: PandocRawNode -> StaticDomBuilderT t m ()
elPandocRaw = \case
    PandocRawNode_Block Format
"html" Text
s ->
      Text -> StaticDomBuilderT t m ()
forall (m :: * -> *) t.
(Monad m, Reflex t) =>
Text -> StaticDomBuilderT t m ()
elPandocRawHtmlStatic Text
s
    PandocRawNode_Inline Format
"html" Text
s ->
      Text -> StaticDomBuilderT t m ()
forall (m :: * -> *) t.
(Monad m, Reflex t) =>
Text -> StaticDomBuilderT t m ()
elPandocRawHtmlStatic Text
s
    PandocRawNode
x ->
      PandocRawNode -> StaticDomBuilderT t m ()
forall t (m :: * -> *). DomBuilder t m => PandocRawNode -> m ()
elPandocRawNodeSafe PandocRawNode
x

elPandocRawHtmlStatic :: (Monad m, Reflex t) => Text -> StaticDomBuilderT t m ()
elPandocRawHtmlStatic :: Text -> StaticDomBuilderT t m ()
elPandocRawHtmlStatic Text
s =
  let html :: Behavior t Builder
html = Text -> Builder
encodeUtf8Builder (Text -> Builder) -> Behavior t Text -> Behavior t Builder
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t Text -> Behavior t Text
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current (Text -> Dynamic t Text
forall k (t :: k) a. Reflex t => a -> Dynamic t a
constDyn Text
s)
   in ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) ()
-> StaticDomBuilderT t m ()
forall k (t :: k) (m :: * -> *) a.
ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) a
-> StaticDomBuilderT t m a
StaticDomBuilderT (ReaderT (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) ()
 -> StaticDomBuilderT t m ())
-> ReaderT
     (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) ()
-> StaticDomBuilderT t m ()
forall a b. (a -> b) -> a -> b
$
        StateT [Behavior t Builder] m ()
-> ReaderT
     (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT [Behavior t Builder] m ()
 -> ReaderT
      (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) ())
-> StateT [Behavior t Builder] m ()
-> ReaderT
     (StaticDomBuilderEnv t) (StateT [Behavior t Builder] m) ()
forall a b. (a -> b) -> a -> b
$
          ([Behavior t Builder] -> [Behavior t Builder])
-> StateT [Behavior t Builder] m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Behavior t Builder] -> [Behavior t Builder])
 -> StateT [Behavior t Builder] m ())
-> ([Behavior t Builder] -> [Behavior t Builder])
-> StateT [Behavior t Builder] m ()
forall a b. (a -> b) -> a -> b
$ (:) Behavior t Builder
html

elPandocRawSafe :: DomBuilder t m => Text -> Format -> Text -> m ()
elPandocRawSafe :: Text -> Format -> Text -> m ()
elPandocRawSafe Text
e (Format Text
fmt) Text
s =
  Text -> Text -> m () -> m ()
forall t (m :: * -> *) a.
DomBuilder t m =>
Text -> Text -> m a -> m a
elClass Text
e (Text
"pandoc-raw-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
fmt Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-block") (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall t (m :: * -> *). DomBuilder t m => Text -> m ()
text Text
s

instance PandocRaw m => PandocRaw (ReaderT a m) where
  type PandocRawConstraints (ReaderT a m) = PandocRawConstraints m
  elPandocRaw :: PandocRawNode -> ReaderT a m ()
elPandocRaw PandocRawNode
x = (a -> m ()) -> ReaderT a m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((a -> m ()) -> ReaderT a m ()) -> (a -> m ()) -> ReaderT a m ()
forall a b. (a -> b) -> a -> b
$ \a
_ -> PandocRawNode -> m ()
forall (m :: * -> *).
(PandocRaw m, PandocRawConstraints m) =>
PandocRawNode -> m ()
elPandocRaw PandocRawNode
x

instance PandocRaw m => PandocRaw (PostBuildT t m) where
  type PandocRawConstraints (PostBuildT t m) = PandocRawConstraints m
  elPandocRaw :: PandocRawNode -> PostBuildT t m ()
elPandocRaw PandocRawNode
x = ReaderT (Event t ()) m () -> PostBuildT t m ()
forall t (m :: * -> *) a.
ReaderT (Event t ()) m a -> PostBuildT t m a
PostBuildT (ReaderT (Event t ()) m () -> PostBuildT t m ())
-> ReaderT (Event t ()) m () -> PostBuildT t m ()
forall a b. (a -> b) -> a -> b
$
    (Event t () -> m ()) -> ReaderT (Event t ()) m ()
forall r (m :: * -> *) a. (r -> m a) -> ReaderT r m a
ReaderT ((Event t () -> m ()) -> ReaderT (Event t ()) m ())
-> (Event t () -> m ()) -> ReaderT (Event t ()) m ()
forall a b. (a -> b) -> a -> b
$ \Event t ()
_ ->
      PandocRawNode -> m ()
forall (m :: * -> *).
(PandocRaw m, PandocRawConstraints m) =>
PandocRawNode -> m ()
elPandocRaw PandocRawNode
x

instance PandocRaw m => PandocRaw (HydratableT m) where
  type PandocRawConstraints (HydratableT m) = PandocRawConstraints m
  elPandocRaw :: PandocRawNode -> HydratableT m ()
elPandocRaw PandocRawNode
x = m () -> HydratableT m ()
forall (m :: * -> *) a. m a -> HydratableT m a
HydratableT (m () -> HydratableT m ()) -> m () -> HydratableT m ()
forall a b. (a -> b) -> a -> b
$ PandocRawNode -> m ()
forall (m :: * -> *).
(PandocRaw m, PandocRawConstraints m) =>
PandocRawNode -> m ()
elPandocRaw PandocRawNode
x