blaze-markup-0.7.0.3/0000755000000000000000000000000012602206044012433 5ustar0000000000000000blaze-markup-0.7.0.3/blaze-markup.cabal0000644000000000000000000000360712602206044016017 0ustar0000000000000000Name: blaze-markup Version: 0.7.0.3 Homepage: http://jaspervdj.be/blaze Bug-Reports: http://github.com/jaspervdj/blaze-markup/issues License: BSD3 License-file: LICENSE Author: Jasper Van der Jeugt, Simon Meier, Deepak Jois Maintainer: Jasper Van der Jeugt Stability: Experimental Category: Text Synopsis: A blazingly fast markup combinator library for Haskell Description: Core modules of a blazingly fast markup combinator library for the Haskell programming language. The Text.Blaze module is a good starting point, as well as this tutorial: . Build-type: Simple Cabal-version: >= 1.8 Extra-source-files: CHANGELOG Library Hs-source-dirs: src Ghc-Options: -Wall Exposed-modules: Text.Blaze Text.Blaze.Internal Text.Blaze.Renderer.Pretty Text.Blaze.Renderer.String Text.Blaze.Renderer.Text Text.Blaze.Renderer.Utf8 Build-depends: base >= 4 && < 5, blaze-builder >= 0.3 && < 0.5, text >= 0.10 && < 1.3, bytestring >= 0.9 && < 0.11 Test-suite blaze-markup-tests Type: exitcode-stdio-1.0 Hs-source-dirs: src tests Main-is: TestSuite.hs Ghc-options: -Wall Other-modules: Text.Blaze.Tests Text.Blaze.Tests.Util Build-depends: HUnit >= 1.2 && < 1.4, QuickCheck >= 2.4 && < 2.9, containers >= 0.3 && < 0.6, test-framework >= 0.4 && < 0.9, test-framework-hunit >= 0.3 && < 0.4, test-framework-quickcheck2 >= 0.3 && < 0.4, -- Copied from regular dependencies... base >= 4 && < 5, blaze-builder >= 0.3 && < 0.5, text >= 0.10 && < 1.3, bytestring >= 0.9 && < 0.11 Source-repository head Type: git Location: http://github.com/jaspervdj/blaze-markup blaze-markup-0.7.0.3/CHANGELOG0000644000000000000000000000117312602206044013647 0ustar0000000000000000- 0.7.0.3 * Relax `HUnit` dependency to allow 1.3 - 0.7.0.2 * Relax `blaze-builder` dependency to allow 0.3 - 0.7.0.1 * Bump `QuickCheck` dependency to allow 2.8 - 0.7.0.0 * Depend on blaze-builder 0.4 - 0.6.3.0 * Add combinators to insert HTML comments - 0.6.2.0 * Add `Applicative` instance for `MarkupM` - 0.6.1.1 * Bump `text` dependency to allow 1.2 - 0.6.1.0 * Add the `null` query to Text.Blaze.Internal. - 0.6.0.0 * Add the operator (!?) for nicely setting conditional attributes - 0.5.2.0 * Provide ToHtml and ToValue instances for Int32, Int64, Word, Word32, and Word64 blaze-markup-0.7.0.3/LICENSE0000644000000000000000000000277512602206044013453 0ustar0000000000000000Copyright Jasper Van der Jeugt 2010 All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Jasper Van der Jeugt nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. blaze-markup-0.7.0.3/Setup.hs0000644000000000000000000000005612602206044014070 0ustar0000000000000000import Distribution.Simple main = defaultMain blaze-markup-0.7.0.3/src/0000755000000000000000000000000012602206044013222 5ustar0000000000000000blaze-markup-0.7.0.3/src/Text/0000755000000000000000000000000012602206044014146 5ustar0000000000000000blaze-markup-0.7.0.3/src/Text/Blaze.hs0000644000000000000000000001457312602206044015551 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} -- | BlazeMarkup is a markup combinator library. It provides a way to embed -- markup languages like HTML and SVG in Haskell in an efficient and convenient -- way, with a light-weight syntax. -- -- To use the library, one needs to import a set of combinators. For example, -- you can use HTML 4 Strict from BlazeHtml package. -- -- > {-# LANGUAGE OverloadedStrings #-} -- > import Prelude hiding (head, id, div) -- > import Text.Blaze.Html4.Strict hiding (map) -- > import Text.Blaze.Html4.Strict.Attributes hiding (title) -- -- To render the page later on, you need a so called Renderer. The recommended -- renderer is an UTF-8 renderer which produces a lazy bytestring. -- -- > import Text.Blaze.Renderer.Utf8 (renderMarkup) -- -- Now, you can describe pages using the imported combinators. -- -- > page1 :: Markup -- > page1 = html $ do -- > head $ do -- > title "Introduction page." -- > link ! rel "stylesheet" ! type_ "text/css" ! href "screen.css" -- > body $ do -- > div ! id "header" $ "Syntax" -- > p "This is an example of BlazeMarkup syntax." -- > ul $ mapM_ (li . toMarkup . show) [1, 2, 3] -- -- The resulting HTML can now be extracted using: -- -- > renderMarkup page1 -- module Text.Blaze ( -- * Important types. Markup , Tag , Attribute , AttributeValue -- * Creating attributes. , dataAttribute , customAttribute -- * Converting values to Markup. , ToMarkup (..) , text , preEscapedText , lazyText , preEscapedLazyText , string , preEscapedString , unsafeByteString , unsafeLazyByteString -- * Comments , textComment , lazyTextComment , stringComment , unsafeByteStringComment , unsafeLazyByteStringComment -- * Creating tags. , textTag , stringTag -- * Converting values to attribute values. , ToValue (..) , textValue , preEscapedTextValue , lazyTextValue , preEscapedLazyTextValue , stringValue , preEscapedStringValue , unsafeByteStringValue , unsafeLazyByteStringValue -- * Setting attributes , (!) , (!?) -- * Modifiying Markup trees , contents ) where import Data.Int (Int32, Int64) import Data.Monoid (mconcat) import Data.Word (Word, Word32, Word64) import Data.Text (Text) import qualified Data.Text.Lazy as LT import Text.Blaze.Internal -- | Class allowing us to use a single function for Markup values -- class ToMarkup a where -- | Convert a value to Markup. -- toMarkup :: a -> Markup -- | Convert a value to Markup without escaping -- preEscapedToMarkup :: a -> Markup preEscapedToMarkup = toMarkup {-# INLINE preEscapedToMarkup #-} instance ToMarkup Markup where toMarkup = id {-# INLINE toMarkup #-} instance ToMarkup [Markup] where toMarkup = mconcat {-# INLINE toMarkup #-} instance ToMarkup Text where toMarkup = text {-# INLINE toMarkup #-} preEscapedToMarkup = preEscapedText {-# INLINE preEscapedToMarkup #-} instance ToMarkup LT.Text where toMarkup = lazyText {-# INLINE toMarkup #-} preEscapedToMarkup = preEscapedLazyText {-# INLINE preEscapedToMarkup #-} instance ToMarkup String where toMarkup = string {-# INLINE toMarkup #-} preEscapedToMarkup = preEscapedString {-# INLINE preEscapedToMarkup #-} instance ToMarkup Int where toMarkup = string . show {-# INLINE toMarkup #-} instance ToMarkup Int32 where toMarkup = string . show {-# INLINE toMarkup #-} instance ToMarkup Int64 where toMarkup = string . show {-# INLINE toMarkup #-} instance ToMarkup Char where toMarkup = string . return {-# INLINE toMarkup #-} instance ToMarkup Bool where toMarkup = string . show {-# INLINE toMarkup #-} instance ToMarkup Integer where toMarkup = string . show {-# INLINE toMarkup #-} instance ToMarkup Float where toMarkup = string . show {-# INLINE toMarkup #-} instance ToMarkup Double where toMarkup = string . show {-# INLINE toMarkup #-} instance ToMarkup Word where toMarkup = string . show {-# INLINE toMarkup #-} instance ToMarkup Word32 where toMarkup = string . show {-# INLINE toMarkup #-} instance ToMarkup Word64 where toMarkup = string . show {-# INLINE toMarkup #-} -- | Class allowing us to use a single function for attribute values -- class ToValue a where -- | Convert a value to an attribute value -- toValue :: a -> AttributeValue -- | Convert a value to an attribute value without escaping -- preEscapedToValue :: a -> AttributeValue preEscapedToValue = toValue {-# INLINE preEscapedToValue #-} instance ToValue AttributeValue where toValue = id {-# INLINE toValue #-} instance ToValue Text where toValue = textValue {-# INLINE toValue #-} preEscapedToValue = preEscapedTextValue {-# INLINE preEscapedToValue #-} instance ToValue LT.Text where toValue = lazyTextValue {-# INLINE toValue #-} preEscapedToValue = preEscapedLazyTextValue {-# INLINE preEscapedToValue #-} instance ToValue String where toValue = stringValue {-# INLINE toValue #-} preEscapedToValue = preEscapedStringValue {-# INLINE preEscapedToValue #-} instance ToValue Int where toValue = stringValue . show {-# INLINE toValue #-} instance ToValue Int32 where toValue = stringValue . show {-# INLINE toValue #-} instance ToValue Int64 where toValue = stringValue . show {-# INLINE toValue #-} instance ToValue Char where toValue = stringValue . return {-# INLINE toValue #-} instance ToValue Bool where toValue = stringValue . show {-# INLINE toValue #-} instance ToValue Integer where toValue = stringValue . show {-# INLINE toValue #-} instance ToValue Float where toValue = stringValue . show {-# INLINE toValue #-} instance ToValue Double where toValue = stringValue . show {-# INLINE toValue #-} instance ToValue Word where toValue = stringValue . show {-# INLINE toValue #-} instance ToValue Word32 where toValue = stringValue . show {-# INLINE toValue #-} instance ToValue Word64 where toValue = stringValue . show {-# INLINE toValue #-} blaze-markup-0.7.0.3/src/Text/Blaze/0000755000000000000000000000000012602206044015203 5ustar0000000000000000blaze-markup-0.7.0.3/src/Text/Blaze/Internal.hs0000644000000000000000000004177312602206044017327 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, Rank2Types, FlexibleInstances, ExistentialQuantification, DeriveDataTypeable #-} -- | The BlazeMarkup core, consisting of functions that offer the power to -- generate custom markup elements. It also offers user-centric functions, -- which are exposed through 'Text.Blaze'. -- -- While this module is exported, usage of it is not recommended, unless you -- know what you are doing. This module might undergo changes at any time. -- module Text.Blaze.Internal ( -- * Important types. ChoiceString (..) , StaticString (..) , MarkupM (..) , Markup , Tag , Attribute , AttributeValue -- * Creating custom tags and attributes. , customParent , customLeaf , attribute , dataAttribute , customAttribute -- * Converting values to Markup. , text , preEscapedText , lazyText , preEscapedLazyText , string , preEscapedString , unsafeByteString , unsafeLazyByteString -- * Comments , textComment , lazyTextComment , stringComment , unsafeByteStringComment , unsafeLazyByteStringComment -- * Converting values to tags. , textTag , stringTag -- * Converting values to attribute values. , textValue , preEscapedTextValue , lazyTextValue , preEscapedLazyTextValue , stringValue , preEscapedStringValue , unsafeByteStringValue , unsafeLazyByteStringValue -- * Setting attributes , Attributable , (!) , (!?) -- * Modifying Markup elements , contents , external -- * Querying Markup elements , null ) where import Prelude hiding (null) import Control.Applicative (Applicative (..)) import Data.Monoid (Monoid, mappend, mempty, mconcat) import Unsafe.Coerce (unsafeCoerce) import qualified Data.List as List import Data.ByteString.Char8 (ByteString) import Data.Text (Text) import Data.Typeable (Typeable) import GHC.Exts (IsString (..)) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as LT -- | A static string that supports efficient output to all possible backends. -- data StaticString = StaticString { getString :: String -> String -- ^ Appending haskell string , getUtf8ByteString :: B.ByteString -- ^ UTF-8 encoded bytestring , getText :: Text -- ^ Text value } -- 'StaticString's should only be converted from string literals, as far as I -- can see. -- instance IsString StaticString where fromString s = let t = T.pack s in StaticString (s ++) (T.encodeUtf8 t) t -- | A string denoting input from different string representations. -- data ChoiceString -- | Static data = Static {-# UNPACK #-} !StaticString -- | A Haskell String | String String -- | A Text value | Text Text -- | An encoded bytestring | ByteString B.ByteString -- | A pre-escaped string | PreEscaped ChoiceString -- | External data in style/script tags, should be checked for validity | External ChoiceString -- | Concatenation | AppendChoiceString ChoiceString ChoiceString -- | Empty string | EmptyChoiceString instance Monoid ChoiceString where mempty = EmptyChoiceString {-# INLINE mempty #-} mappend = AppendChoiceString {-# INLINE mappend #-} instance IsString ChoiceString where fromString = String {-# INLINE fromString #-} -- | The core Markup datatype. -- data MarkupM a -- | Tag, open tag, end tag, content = forall b. Parent StaticString StaticString StaticString (MarkupM b) -- | Custom parent | forall b. CustomParent ChoiceString (MarkupM b) -- | Tag, open tag, end tag | Leaf StaticString StaticString StaticString -- | Custom leaf | CustomLeaf ChoiceString Bool -- | HTML content | Content ChoiceString -- | HTML comment. Note: you should wrap the 'ChoiceString' in a -- 'PreEscaped'. | Comment ChoiceString -- | Concatenation of two HTML pieces | forall b c. Append (MarkupM b) (MarkupM c) -- | Add an attribute to the inner HTML. Raw key, key, value, HTML to -- receive the attribute. | AddAttribute StaticString StaticString ChoiceString (MarkupM a) -- | Add a custom attribute to the inner HTML. | AddCustomAttribute ChoiceString ChoiceString (MarkupM a) -- | Empty HTML. | Empty deriving (Typeable) -- | Simplification of the 'MarkupM' datatype. -- type Markup = MarkupM () instance Monoid a => Monoid (MarkupM a) where mempty = Empty {-# INLINE mempty #-} mappend x y = Append x y {-# INLINE mappend #-} mconcat = foldr Append Empty {-# INLINE mconcat #-} instance Functor MarkupM where -- Safe because it does not contain a value anyway fmap _ = unsafeCoerce instance Applicative MarkupM where pure _ = Empty {-# INLINE pure #-} (<*>) = Append {-# INLINE (<*>) #-} (*>) = Append {-# INLINE (*>) #-} (<*) = Append {-# INLINE (<*) #-} instance Monad MarkupM where return _ = Empty {-# INLINE return #-} (>>) = Append {-# INLINE (>>) #-} h1 >>= f = h1 >> f (error "Text.Blaze.Internal.MarkupM: invalid use of monadic bind") {-# INLINE (>>=) #-} instance IsString (MarkupM a) where fromString = Content . fromString {-# INLINE fromString #-} -- | Type for an HTML tag. This can be seen as an internal string type used by -- BlazeMarkup. -- newtype Tag = Tag { unTag :: StaticString } deriving (IsString) -- | Type for an attribute. -- newtype Attribute = Attribute (forall a. MarkupM a -> MarkupM a) instance Monoid Attribute where mempty = Attribute id Attribute f `mappend` Attribute g = Attribute (g . f) -- | The type for the value part of an attribute. -- newtype AttributeValue = AttributeValue { unAttributeValue :: ChoiceString } deriving (IsString, Monoid) -- | Create a custom parent element customParent :: Tag -- ^ Element tag -> Markup -- ^ Content -> Markup -- ^ Resulting markup customParent tag = CustomParent (Static $ unTag tag) -- | Create a custom leaf element customLeaf :: Tag -- ^ Element tag -> Bool -- ^ Close the leaf? -> Markup -- ^ Resulting markup customLeaf tag = CustomLeaf (Static $ unTag tag) -- | Create an HTML attribute that can be applied to an HTML element later using -- the '!' operator. -- attribute :: Tag -- ^ Raw key -> Tag -- ^ Shared key string for the HTML attribute. -> AttributeValue -- ^ Value for the HTML attribute. -> Attribute -- ^ Resulting HTML attribute. attribute rawKey key value = Attribute $ AddAttribute (unTag rawKey) (unTag key) (unAttributeValue value) {-# INLINE attribute #-} -- | From HTML 5 onwards, the user is able to specify custom data attributes. -- -- An example: -- -- >

Hello.

-- -- We support this in BlazeMarkup using this funcion. The above fragment could -- be described using BlazeMarkup with: -- -- > p ! dataAttribute "foo" "bar" $ "Hello." -- dataAttribute :: Tag -- ^ Name of the attribute. -> AttributeValue -- ^ Value for the attribute. -> Attribute -- ^ Resulting HTML attribute. dataAttribute tag value = Attribute $ AddCustomAttribute (Static "data-" `mappend` Static (unTag tag)) (unAttributeValue value) {-# INLINE dataAttribute #-} -- | Create a custom attribute. This is not specified in the HTML spec, but some -- JavaScript libraries rely on it. -- -- An example: -- -- > -- -- Can be produced using: -- -- > select ! customAttribute "dojoType" "select" $ "foo" -- customAttribute :: Tag -- ^ Name of the attribute -> AttributeValue -- ^ Value for the attribute -> Attribute -- ^ Resulting HTML attribtue customAttribute tag value = Attribute $ AddCustomAttribute (Static $ unTag tag) (unAttributeValue value) {-# INLINE customAttribute #-} -- | Render text. Functions like these can be used to supply content in HTML. -- text :: Text -- ^ Text to render. -> Markup -- ^ Resulting HTML fragment. text = Content . Text {-# INLINE text #-} -- | Render text without escaping. -- preEscapedText :: Text -- ^ Text to insert -> Markup -- ^ Resulting HTML fragment preEscapedText = Content . PreEscaped . Text {-# INLINE preEscapedText #-} -- | A variant of 'text' for lazy 'LT.Text'. -- lazyText :: LT.Text -- ^ Text to insert -> Markup -- ^ Resulting HTML fragment lazyText = mconcat . map text . LT.toChunks {-# INLINE lazyText #-} -- | A variant of 'preEscapedText' for lazy 'LT.Text' -- preEscapedLazyText :: LT.Text -- ^ Text to insert -> Markup -- ^ Resulting HTML fragment preEscapedLazyText = mconcat . map preEscapedText . LT.toChunks -- | Create an HTML snippet from a 'String'. -- string :: String -- ^ String to insert. -> Markup -- ^ Resulting HTML fragment. string = Content . String {-# INLINE string #-} -- | Create an HTML snippet from a 'String' without escaping -- preEscapedString :: String -- ^ String to insert. -> Markup -- ^ Resulting HTML fragment. preEscapedString = Content . PreEscaped . String {-# INLINE preEscapedString #-} -- | Insert a 'ByteString'. This is an unsafe operation: -- -- * The 'ByteString' could have the wrong encoding. -- -- * The 'ByteString' might contain illegal HTML characters (no escaping is -- done). -- unsafeByteString :: ByteString -- ^ Value to insert. -> Markup -- ^ Resulting HTML fragment. unsafeByteString = Content . ByteString {-# INLINE unsafeByteString #-} -- | Insert a lazy 'BL.ByteString'. See 'unsafeByteString' for reasons why this -- is an unsafe operation. -- unsafeLazyByteString :: BL.ByteString -- ^ Value to insert -> Markup -- ^ Resulting HTML fragment unsafeLazyByteString = mconcat . map unsafeByteString . BL.toChunks {-# INLINE unsafeLazyByteString #-} -- | Create a comment from a 'Text' value. -- The text should not contain @"--"@. -- This is not checked by the library. textComment :: Text -> Markup textComment = Comment . PreEscaped . Text -- | Create a comment from a 'LT.Text' value. -- The text should not contain @"--"@. -- This is not checked by the library. lazyTextComment :: LT.Text -> Markup lazyTextComment = Comment . mconcat . map (PreEscaped . Text) . LT.toChunks -- | Create a comment from a 'String' value. -- The text should not contain @"--"@. -- This is not checked by the library. stringComment :: String -> Markup stringComment = Comment . PreEscaped . String -- | Create a comment from a 'ByteString' value. -- The text should not contain @"--"@. -- This is not checked by the library. unsafeByteStringComment :: ByteString -> Markup unsafeByteStringComment = Comment . PreEscaped . ByteString -- | Create a comment from a 'BL.ByteString' value. -- The text should not contain @"--"@. -- This is not checked by the library. unsafeLazyByteStringComment :: BL.ByteString -> Markup unsafeLazyByteStringComment = Comment . mconcat . map (PreEscaped . ByteString) . BL.toChunks -- | Create a 'Tag' from some 'Text'. -- textTag :: Text -- ^ Text to create a tag from -> Tag -- ^ Resulting tag textTag t = Tag $ StaticString (T.unpack t ++) (T.encodeUtf8 t) t -- | Create a 'Tag' from a 'String'. -- stringTag :: String -- ^ String to create a tag from -> Tag -- ^ Resulting tag stringTag = Tag . fromString -- | Render an attribute value from 'Text'. -- textValue :: Text -- ^ The actual value. -> AttributeValue -- ^ Resulting attribute value. textValue = AttributeValue . Text {-# INLINE textValue #-} -- | Render an attribute value from 'Text' without escaping. -- preEscapedTextValue :: Text -- ^ The actual value -> AttributeValue -- ^ Resulting attribute value preEscapedTextValue = AttributeValue . PreEscaped . Text {-# INLINE preEscapedTextValue #-} -- | A variant of 'textValue' for lazy 'LT.Text' -- lazyTextValue :: LT.Text -- ^ The actual value -> AttributeValue -- ^ Resulting attribute value lazyTextValue = mconcat . map textValue . LT.toChunks {-# INLINE lazyTextValue #-} -- | A variant of 'preEscapedTextValue' for lazy 'LT.Text' -- preEscapedLazyTextValue :: LT.Text -- ^ The actual value -> AttributeValue -- ^ Resulting attribute value preEscapedLazyTextValue = mconcat . map preEscapedTextValue . LT.toChunks {-# INLINE preEscapedLazyTextValue #-} -- | Create an attribute value from a 'String'. -- stringValue :: String -> AttributeValue stringValue = AttributeValue . String {-# INLINE stringValue #-} -- | Create an attribute value from a 'String' without escaping. -- preEscapedStringValue :: String -> AttributeValue preEscapedStringValue = AttributeValue . PreEscaped . String {-# INLINE preEscapedStringValue #-} -- | Create an attribute value from a 'ByteString'. See 'unsafeByteString' -- for reasons why this might not be a good idea. -- unsafeByteStringValue :: ByteString -- ^ ByteString value -> AttributeValue -- ^ Resulting attribute value unsafeByteStringValue = AttributeValue . ByteString {-# INLINE unsafeByteStringValue #-} -- | Create an attribute value from a lazy 'BL.ByteString'. See -- 'unsafeByteString' for reasons why this might not be a good idea. -- unsafeLazyByteStringValue :: BL.ByteString -- ^ ByteString value -> AttributeValue -- ^ Resulting attribute value unsafeLazyByteStringValue = mconcat . map unsafeByteStringValue . BL.toChunks {-# INLINE unsafeLazyByteStringValue #-} -- | Used for applying attributes. You should not define your own instances of -- this class. class Attributable h where -- | Apply an attribute to an element. -- -- Example: -- -- > img ! src "foo.png" -- -- Result: -- -- > -- -- This can be used on nested elements as well. -- -- Example: -- -- > p ! style "float: right" $ "Hello!" -- -- Result: -- -- >

Hello!

-- (!) :: h -> Attribute -> h instance Attributable (MarkupM a) where h ! (Attribute f) = f h {-# INLINE (!) #-} instance Attributable (MarkupM a -> MarkupM b) where h ! f = (! f) . h {-# INLINE (!) #-} -- | Shorthand for setting an attribute depending on a conditional. -- -- Example: -- -- > p !? (isBig, A.class "big") $ "Hello" -- -- Gives the same result as: -- -- > (if isBig then p ! A.class "big" else p) "Hello" -- (!?) :: Attributable h => h -> (Bool, Attribute) -> h (!?) h (c, a) = if c then h ! a else h -- | Mark HTML as external data. External data can be: -- -- * CSS data in a @