{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
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 PandocRaw m where
type PandocRawConstraints m :: Constraint
elPandocRaw :: PandocRawConstraints m => PandocRawNode -> m ()
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