src/Text/BlazeT/Internal.hs

   1 {-# LANGUAGE DeriveFunctor #-}
   2 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
   3 {-# LANGUAGE FlexibleInstances #-}
   4 {-# LANGUAGE RankNTypes #-}
   5 {-# LANGUAGE CPP #-}
   6 #if MIN_VERSION_blaze_markup(0,7,1)
   7 #define PRE_BUILDER
   8 #endif
   9 module Text.BlazeT.Internal
  10     (
  11     -- * Entities exported only by the @blazeT@ version of this module
  12     MarkupT(..)
  13     ,MarkupI
  14     ,mapMarkupT
  15     -- ** Specializations for @blaze-markup@ backwards compatibility
  16     ,MarkupM
  17     ,Markup
  18     ,Markup2
  19     -- ** Running
  20     ,runMarkupT
  21     ,runMarkup
  22     ,runWith
  23     -- ** Executing
  24     ,execMarkupT
  25     ,execMarkup
  26     ,execWith
  27     -- ** Wrappers
  28     ,wrapMarkupT
  29     ,wrapMarkupT2
  30     ,wrapMarkup
  31     ,wrapMarkup2
  32     ,
  33
  34     -- * Entities exported also by "Text.Blaze.Internal"
  35     -- $descr1
  36
  37       -- ** Important types.
  38       Text.Blaze.ChoiceString (..)
  39     , Text.Blaze.StaticString (..)
  40     -- , MarkupM
  41     -- , Markup
  42     , Text.Blaze.Tag
  43     , Text.Blaze.Attribute
  44     , Text.Blaze.AttributeValue
  45
  46       -- ** Creating custom tags and attributes.
  47     , customParent
  48     , customLeaf
  49     , Text.Blaze.attribute
  50     , Text.Blaze.dataAttribute
  51     , Text.Blaze.customAttribute
  52
  53       -- ** Converting values to Markup.
  54     , text
  55     , preEscapedText
  56     , lazyText
  57     , preEscapedLazyText
  58     , textBuilder
  59     , preEscapedTextBuilder
  60     , string
  61     , preEscapedString
  62     , unsafeByteString
  63     , unsafeLazyByteString
  64
  65       -- ** Comments
  66     , Text.Blaze.textComment
  67     , Text.Blaze.lazyTextComment
  68     , Text.Blaze.stringComment
  69     , Text.Blaze.unsafeByteStringComment
  70     , Text.Blaze.unsafeLazyByteStringComment
  71
  72       -- ** Converting values to tags.
  73     , Text.Blaze.textTag
  74     , Text.Blaze.stringTag
  75
  76       -- ** Converting values to attribute values.
  77     , Text.Blaze.textValue
  78     , Text.Blaze.preEscapedTextValue
  79     , Text.Blaze.lazyTextValue
  80     , Text.Blaze.preEscapedLazyTextValue
  81     , Text.Blaze.textBuilderValue
  82     , Text.Blaze.preEscapedTextBuilderValue
  83     , Text.Blaze.stringValue
  84     , Text.Blaze.preEscapedStringValue
  85     , Text.Blaze.unsafeByteStringValue
  86     , Text.Blaze.unsafeLazyByteStringValue
  87
  88       -- ** Setting attributes
  89     , Text.Blaze.Attributable
  90     , (Text.Blaze.!)
  91     , (Text.Blaze.!?)
  92
  93       -- ** Modifying Markup elements
  94     , contents
  95     , external
  96
  97       -- ** Querying Markup elements
  98     , null
  99
 100   ) where
 101
 102 import           Control.Arrow
 103 import           Control.Monad.Identity
 104 import           Control.Monad.Trans.Class
 105 import           Control.Monad.Writer.Strict
 106 import qualified Data.ByteString as BS
 107 import qualified Data.ByteString.Lazy as BL
 108 import           Data.String
 109 import qualified Data.Text as T
 110 import qualified Data.Text.Lazy as LT
 111 import qualified Data.Text.Lazy.Builder as LTB
 112 import qualified Text.Blaze
 113 import qualified Text.Blaze.Internal as Text.Blaze
 114
 115 {- | Everything is build around the simple @newtype@ definition of the
 116 'MarkupT' transformer, which makes use the 'Monoid' instance of Blaze
 117 'Text.Blaze.Markup' and is simply a 'WriterT' writing Blaze
 118 'Text.Blaze.Markup':
 119 -}
 120 newtype MarkupT m a= MarkupT { fromMarkupT :: WriterT Text.Blaze.Markup m a }
 121                      deriving (Functor
 122 #if MIN_VERSION_base(4,8,0)
 123                               ,Applicative
 124 #endif
 125                               ,Monad
 126                               ,MonadWriter Text.Blaze.Markup
 127                               ,MonadTrans
 128                               )
 129
 130 type MarkupI a = MarkupT Identity a
 131
 132 -- | Map both the return value and markup of a computation using the
 133 -- given function
 134 mapMarkupT :: (m (a,Text.Blaze.Markup) -> n (b,Text.Blaze.Markup)) -> MarkupT m a -> MarkupT n b
 135 mapMarkupT f = MarkupT . mapWriterT f . fromMarkupT
 136 {-# INLINE mapMarkupT #-}
 137
 138 type MarkupM a = forall m . Monad m => MarkupT m a
 139 type Markup = MarkupM ()
 140 type Markup2 = forall m . Monad m => MarkupT m () -> MarkupT m ()
 141
 142 runMarkupT :: MarkupT m a -> m (a,Text.Blaze.Markup)
 143 runMarkupT = runWriterT . fromMarkupT
 144 {-# INLINE runMarkupT #-}
 145
 146 -- | run the MarkupT and return a pair consisting of the result of the
 147 -- computation and the blaze markup rendered with a blaze renderer
 148 -- like 'Text.BlazeT.Renderer.Text.renderHtml'
 149 runWith :: Monad m => (MarkupI () -> c) -> MarkupT m a -> m (a, c)
 150 runWith renderer =  liftM (second $ renderer . wrapMarkup) . runMarkupT
 151 {-# INLINE runWith #-}
 152
 153 execMarkupT :: Monad m => MarkupT m a -> m Text.Blaze.Markup
 154 execMarkupT = liftM snd . runMarkupT
 155 {-# INLINE execMarkupT #-}
 156
 157 execWith :: Monad m => (MarkupI () -> c) -> MarkupT m a -> m c
 158 execWith renderer = liftM snd . runWith renderer
 159 {-# INLINE execWith #-}
 160
 161 runMarkup :: MarkupI a -> (a, Text.Blaze.Markup)
 162 runMarkup = runIdentity . runMarkupT
 163 {-# INLINE runMarkup #-}
 164
 165 execMarkup :: MarkupI a -> Text.Blaze.Markup
 166 execMarkup = snd . runMarkup
 167 {-# INLINE execMarkup #-}
 168
 169 -- | Wrapper for 'Text.Blaze.Markup' is simply
 170 -- 'tell'
 171 wrapMarkupT :: Monad m => Text.Blaze.Markup -> MarkupT m ()
 172 wrapMarkupT = tell
 173 {-# INLINE wrapMarkupT #-}
 174
 175 wrapMarkup :: Text.Blaze.Markup -> Markup
 176 wrapMarkup = wrapMarkupT
 177 {-# INLINE wrapMarkup #-}
 178
 179
 180 -- | Wrapper for functions that modify 'Text.Blaze.Markup' is simply
 181 -- 'censor'
 182 wrapMarkupT2 ::  Monad m => (Text.Blaze.Markup -> Text.Blaze.Markup)
 183                  -> MarkupT m a -> MarkupT m a
 184 wrapMarkupT2 = censor
 185 {-# INLINE wrapMarkupT2 #-}
 186
 187 wrapMarkup2 :: (Text.Blaze.Markup -> Text.Blaze.Markup) -> Markup2
 188 wrapMarkup2 = wrapMarkupT2
 189 {-# INLINE wrapMarkup2 #-}
 190
 191
 192 instance (Monad m,Monoid a) => Monoid (MarkupT m a) where
 193   mempty = return mempty
 194   {-# INLINE mempty #-}
 195   a `mappend` b = do {a' <- a; b >>= return . (mappend a')}
 196   {-# INLINE mappend #-}
 197
 198
 199 instance Monad m => Text.Blaze.Attributable (MarkupT m a) where
 200   h ! a = wrapMarkupT2 (Text.Blaze.! a) h
 201   {-# INLINE (!) #-}
 202
 203 instance Monad m => Text.Blaze.Attributable (a -> MarkupT m b) where
 204   h ! a = \x -> wrapMarkupT2 (Text.Blaze.! a) $ h x
 205   {-# INLINE (!) #-}
 206
 207 instance Monad m => IsString (MarkupT m ()) where
 208   fromString = wrapMarkup . fromString
 209   {-# INLINE fromString #-}
 210
 211 unsafeByteString :: BS.ByteString -> Markup
 212 unsafeByteString = wrapMarkup . Text.Blaze.unsafeByteString
 213 {-# INLINE unsafeByteString #-}
 214
 215 -- | Insert a lazy 'BL.ByteString'. See 'unsafeByteString' for reasons why this
 216 -- is an unsafe operation.
 217 --
 218 unsafeLazyByteString :: BL.ByteString  -- ^ Value to insert
 219                      -> Markup         -- ^ Resulting HTML fragment
 220 unsafeLazyByteString = wrapMarkup . Text.Blaze.unsafeLazyByteString
 221 {-# INLINE unsafeLazyByteString #-}
 222
 223 external :: Monad m => MarkupT m a -> MarkupT m a
 224 external = wrapMarkupT2  Text.Blaze.external
 225 {-# INLINE external #-}
 226
 227 contents :: Monad m => MarkupT m a -> MarkupT m a
 228 contents = wrapMarkupT2  Text.Blaze.contents
 229 {-# INLINE contents #-}
 230
 231 customParent ::Text.Blaze.Tag -> Markup2
 232 customParent = wrapMarkup2 . Text.Blaze.customParent
 233 {-# INLINE customParent #-}
 234
 235 customLeaf :: Text.Blaze.Tag -> Bool -> Markup
 236 customLeaf = fmap wrapMarkup . Text.Blaze.customLeaf
 237 {-# INLINE customLeaf #-}
 238
 239 preEscapedText :: T.Text -> Markup
 240 preEscapedText = wrapMarkup . Text.Blaze.preEscapedText
 241 {-# INLINE preEscapedText #-}
 242
 243 preEscapedLazyText :: LT.Text -> Markup
 244 preEscapedLazyText = wrapMarkup . Text.Blaze.preEscapedLazyText
 245 {-# INLINE preEscapedLazyText #-}
 246
 247 preEscapedTextBuilder :: LTB.Builder -> Markup
 248 textBuilder :: LTB.Builder -> Markup
 249
 250 #ifdef PRE_BUILDER
 251 preEscapedTextBuilder = wrapMarkup . Text.Blaze.preEscapedTextBuilder
 252 textBuilder = wrapMarkup . Text.Blaze.textBuilder
 253 {-# INLINE preEscapedTextBuilder #-}
 254 {-# INLINE textBuilder #-}
 255 #else
 256 preEscapedTextBuilder = error "This function needs blaze-markup 0.7.1.0"
 257 textBuilder = error "This function needs blaze-markup 0.7.1.0"
 258 #endif
 259
 260 preEscapedString :: String -> Markup
 261 preEscapedString = wrapMarkup . Text.Blaze.preEscapedString
 262 {-# INLINE preEscapedString #-}
 263
 264 string :: String -> Markup
 265 string = wrapMarkup . Text.Blaze.string
 266 {-# INLINE string #-}
 267
 268 text :: T.Text -> Markup
 269 text = wrapMarkup . Text.Blaze.text
 270 {-# INLINE text #-}
 271
 272 lazyText :: LT.Text -> Markup
 273 lazyText = wrapMarkup . Text.Blaze.lazyText
 274 {-# INLINE lazyText #-}
 275
 276 -- $descr1
 277 -- The following is an adaptation of all "Text.Blaze.Internal" exports to
 278 -- @blazeT@ types.
 279 --
 280 -- Entities that are reexported from "Text.Blaze.Internal" have the original
 281 -- documentation attached to them.
 282 --
 283 -- Entities that had to be adapted are tagged with \"(Adapted)\". For
 284 -- their documentation consult the "Text.Blaze.Internal" documentation.