├── .ghci ├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── CHANGELOG ├── LICENSE ├── Makefile ├── README.markdown ├── Setup.hs ├── benchmarks ├── BenchmarkUtils.hs ├── HtmlBenchmarks.hs ├── RunHtmlBenchmarks.hs ├── ServerChunkSize.hs └── bigtable │ ├── erb.rb │ ├── erubis.rb │ ├── hamlet.hs │ ├── html-minimalist.hs │ ├── html.hs │ ├── php.php │ └── xhtml.hs ├── blaze-markup.cabal ├── cabal.haskell-ci ├── src └── Text │ ├── Blaze.hs │ └── Blaze │ ├── Internal.hs │ └── Renderer │ ├── Pretty.hs │ ├── String.hs │ ├── Text.hs │ └── Utf8.hs └── tests ├── TestSuite.hs └── Text └── Blaze ├── Tests.hs └── Tests └── Util.hs /.ghci: -------------------------------------------------------------------------------- 1 | :set -isrc -itests -ibenchmarks 2 | -------------------------------------------------------------------------------- /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'blaze-markup.cabal' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/haskell-CI/haskell-ci 10 | # 11 | # version: 0.19.20250506 12 | # 13 | # REGENDATA ("0.19.20250506",["github","blaze-markup.cabal"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | push: 18 | branches: 19 | - master 20 | pull_request: 21 | branches: 22 | - master 23 | jobs: 24 | linux: 25 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 26 | runs-on: ubuntu-24.04 27 | timeout-minutes: 28 | 60 29 | container: 30 | image: buildpack-deps:jammy 31 | continue-on-error: ${{ matrix.allow-failure }} 32 | strategy: 33 | matrix: 34 | include: 35 | - compiler: ghc-9.12.2 36 | compilerKind: ghc 37 | compilerVersion: 9.12.2 38 | setup-method: ghcup 39 | allow-failure: false 40 | - compiler: ghc-9.10.2 41 | compilerKind: ghc 42 | compilerVersion: 9.10.2 43 | setup-method: ghcup 44 | allow-failure: false 45 | - compiler: ghc-9.8.4 46 | compilerKind: ghc 47 | compilerVersion: 9.8.4 48 | setup-method: ghcup 49 | allow-failure: false 50 | - compiler: ghc-9.6.7 51 | compilerKind: ghc 52 | compilerVersion: 9.6.7 53 | setup-method: ghcup 54 | allow-failure: false 55 | - compiler: ghc-9.4.8 56 | compilerKind: ghc 57 | compilerVersion: 9.4.8 58 | setup-method: ghcup 59 | allow-failure: false 60 | - compiler: ghc-9.2.8 61 | compilerKind: ghc 62 | compilerVersion: 9.2.8 63 | setup-method: ghcup 64 | allow-failure: false 65 | - compiler: ghc-9.0.2 66 | compilerKind: ghc 67 | compilerVersion: 9.0.2 68 | setup-method: ghcup 69 | allow-failure: false 70 | - compiler: ghc-8.10.7 71 | compilerKind: ghc 72 | compilerVersion: 8.10.7 73 | setup-method: ghcup 74 | allow-failure: false 75 | - compiler: ghc-8.8.4 76 | compilerKind: ghc 77 | compilerVersion: 8.8.4 78 | setup-method: ghcup 79 | allow-failure: false 80 | - compiler: ghc-8.6.5 81 | compilerKind: ghc 82 | compilerVersion: 8.6.5 83 | setup-method: ghcup 84 | allow-failure: false 85 | - compiler: ghc-8.4.4 86 | compilerKind: ghc 87 | compilerVersion: 8.4.4 88 | setup-method: ghcup 89 | allow-failure: false 90 | - compiler: ghc-8.2.2 91 | compilerKind: ghc 92 | compilerVersion: 8.2.2 93 | setup-method: ghcup 94 | allow-failure: false 95 | - compiler: ghc-8.0.2 96 | compilerKind: ghc 97 | compilerVersion: 8.0.2 98 | setup-method: ghcup 99 | allow-failure: false 100 | fail-fast: false 101 | steps: 102 | - name: apt-get install 103 | run: | 104 | apt-get update 105 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 libnuma-dev 106 | - name: Install GHCup 107 | run: | 108 | mkdir -p "$HOME/.ghcup/bin" 109 | curl -sL https://downloads.haskell.org/ghcup/0.1.50.1/x86_64-linux-ghcup-0.1.50.1 > "$HOME/.ghcup/bin/ghcup" 110 | chmod a+x "$HOME/.ghcup/bin/ghcup" 111 | - name: Install cabal-install 112 | run: | 113 | "$HOME/.ghcup/bin/ghcup" install cabal 3.14.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 114 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" 115 | - name: Install GHC (GHCup) 116 | if: matrix.setup-method == 'ghcup' 117 | run: | 118 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 119 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 120 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 121 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 122 | echo "HC=$HC" >> "$GITHUB_ENV" 123 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 124 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 125 | env: 126 | HCKIND: ${{ matrix.compilerKind }} 127 | HCNAME: ${{ matrix.compiler }} 128 | HCVER: ${{ matrix.compilerVersion }} 129 | - name: Set PATH and environment variables 130 | run: | 131 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 132 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 133 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 134 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 135 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 136 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 137 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 138 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 139 | echo "HEADHACKAGE=false" >> "$GITHUB_ENV" 140 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 141 | env: 142 | HCKIND: ${{ matrix.compilerKind }} 143 | HCNAME: ${{ matrix.compiler }} 144 | HCVER: ${{ matrix.compilerVersion }} 145 | - name: env 146 | run: | 147 | env 148 | - name: write cabal config 149 | run: | 150 | mkdir -p $CABAL_DIR 151 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 184 | echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - 185 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 186 | rm -f cabal-plan.xz 187 | chmod a+x $HOME/.cabal/bin/cabal-plan 188 | cabal-plan --version 189 | - name: checkout 190 | uses: actions/checkout@v4 191 | with: 192 | path: source 193 | - name: initial cabal.project for sdist 194 | run: | 195 | touch cabal.project 196 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 197 | cat cabal.project 198 | - name: sdist 199 | run: | 200 | mkdir -p sdist 201 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 202 | - name: unpack 203 | run: | 204 | mkdir -p unpacked 205 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 206 | - name: generate cabal.project 207 | run: | 208 | PKGDIR_blaze_markup="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/blaze-markup-[0-9.]*')" 209 | echo "PKGDIR_blaze_markup=${PKGDIR_blaze_markup}" >> "$GITHUB_ENV" 210 | rm -f cabal.project cabal.project.local 211 | touch cabal.project 212 | touch cabal.project.local 213 | echo "packages: ${PKGDIR_blaze_markup}" >> cabal.project 214 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package blaze-markup" >> cabal.project ; fi 215 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 216 | cat >> cabal.project <> cabal.project.local 219 | cat cabal.project 220 | cat cabal.project.local 221 | - name: dump install plan 222 | run: | 223 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 224 | cabal-plan 225 | - name: restore cache 226 | uses: actions/cache/restore@v4 227 | with: 228 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 229 | path: ~/.cabal/store 230 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 231 | - name: install dependencies 232 | run: | 233 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 234 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 235 | - name: build w/o tests 236 | run: | 237 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 238 | - name: build 239 | run: | 240 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 241 | - name: tests 242 | run: | 243 | $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct 244 | - name: cabal check 245 | run: | 246 | cd ${PKGDIR_blaze_markup} || false 247 | ${CABAL} -vnormal check 248 | - name: haddock 249 | run: | 250 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 251 | - name: unconstrained build 252 | run: | 253 | rm -f cabal.project.local 254 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 255 | - name: save cache 256 | if: always() 257 | uses: actions/cache/save@v4 258 | with: 259 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 260 | path: ~/.cabal/store 261 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | dist-newstyle 3 | local 4 | .\#* 5 | *.o 6 | *.hi 7 | *.swp 8 | .ghc.environment.* 9 | 10 | .cabal-sandbox/ 11 | cabal.sandbox.config 12 | cabal.config 13 | 14 | TestSuite.tix 15 | .hpc 16 | hpc 17 | 18 | notes/ 19 | 20 | benchmarks/BigTableServer 21 | benchmarks/HtmlBenchmarks 22 | benchmarks/RunHtmlBenchmarks 23 | 24 | tests/TestSuite 25 | 26 | doc/examples/BenchmarkServer 27 | doc/examples/SnapBenchmarkServer 28 | doc/examples/SnapFramework 29 | 30 | website/_site 31 | website/_cache 32 | website/docs 33 | website/hakyll 34 | 35 | src/Text/Blaze/Html4/FrameSet.hs 36 | src/Text/Blaze/Html4/FrameSet/Attributes.hs 37 | src/Text/Blaze/Html4/Strict.hs 38 | src/Text/Blaze/Html4/Strict/Attributes.hs 39 | src/Text/Blaze/Html4/Transitional.hs 40 | src/Text/Blaze/Html4/Transitional/Attributes.hs 41 | src/Text/Blaze/Html5.hs 42 | src/Text/Blaze/Html5/Attributes.hs 43 | src/Text/Blaze/XHtml1/FrameSet.hs 44 | src/Text/Blaze/XHtml1/FrameSet/Attributes.hs 45 | src/Text/Blaze/XHtml1/Strict.hs 46 | src/Text/Blaze/XHtml1/Strict/Attributes.hs 47 | src/Text/Blaze/XHtml1/Transitional.hs 48 | src/Text/Blaze/XHtml1/Transitional/Attributes.hs 49 | -------------------------------------------------------------------------------- /CHANGELOG: -------------------------------------------------------------------------------- 1 | # Changelog 2 | 3 | - 0.8.3.0 (2023-09-25) 4 | * Add `ToMarkup` and `ToValue` instances for `NonEmpty Char` 5 | * Bump `bytestring` upper bound to 0.13 6 | * Bump `text` upper bound to 2.1 7 | 8 | - 0.8.2.8 (2021-03-04) 9 | * Bump `base` upper bound to 4.16 10 | * Bump `tasty` upper bound to 1.5 11 | * Bump `bytestring` upper bound to 0.12 12 | 13 | - 0.8.2.7 (2020-06-30) 14 | * Bump Cabal version lower bound to 1.10 15 | 16 | - 0.8.2.6 (2020-06-30) 17 | * Bump `tasty` upper bound to 1.4 18 | 19 | - 0.8.2.5 (2020-04-20) 20 | * Bump `base` upper bound to 4.15 21 | 22 | - 0.8.2.4 (2020-03-29) 23 | * Bump `QuickCheck` upper bound to 2.15 24 | 25 | - 0.8.2.3 (2019-10-02) 26 | * Bump `base` to 4.13 27 | * Bump `tasty` to 1.2 28 | * Bump `QuickCheck` to 2.13 29 | 30 | - 0.8.2.2 (2018-09-25) 31 | * Bump `base` to 4.12 32 | * Bump `containers` to 0.6 33 | * Bump `tasty` to 1.1 34 | 35 | - 0.8.2.1 (2018-04-09) 36 | * Bump `QuickCheck` dependency to allow 2.11 37 | * Bump `tasty` dependency to allow 1.0 38 | * Bump `tasty-hunit` dependency to allow 0.10 39 | * Bump `tasty-quickcheck` dependency to allow 0.10 40 | 41 | - 0.8.2.0 (2018-01-09) 42 | * Define `ToMarkup` instance for `Natural`. 43 | 44 | - 0.8.1.0 (2017-09-16) 45 | * Compatibility with Semigroup/Monoid proposal 46 | * Switch to `tasty` for running tests 47 | 48 | - 0.8.0.0 (2017-01-30) 49 | * Make `MarkupM` finally adhere to the Monad laws 50 | * Stricten the `IsString` instance to only work with `MarkupM ()` and not 51 | `MarkupM a` 52 | * Change the type of `contents` to `MarkupM a -> MarkupM a` 53 | * Add a `Semigroup` instance for `MarkupM` 54 | 55 | - 0.7.1.1 56 | * Bump `HUnit` dependency to allow 1.5 57 | 58 | - 0.7.1.0 59 | * Relax `QuickCheck` dependency to allow 2.9 60 | * Add text builder instances 61 | 62 | - 0.7.0.3 63 | * Relax `HUnit` dependency to allow 1.3 64 | 65 | - 0.7.0.2 66 | * Relax `blaze-builder` dependency to allow 0.3 67 | 68 | - 0.7.0.1 69 | * Bump `QuickCheck` dependency to allow 2.8 70 | 71 | - 0.7.0.0 72 | * Depend on blaze-builder 0.4 73 | 74 | - 0.6.3.0 75 | * Add combinators to insert HTML comments 76 | 77 | - 0.6.2.0 78 | * Add `Applicative` instance for `MarkupM` 79 | 80 | - 0.6.1.1 81 | * Bump `text` dependency to allow 1.2 82 | 83 | - 0.6.1.0 84 | * Add the `null` query to Text.Blaze.Internal. 85 | 86 | - 0.6.0.0 87 | * Add the operator (!?) for nicely setting conditional attributes 88 | 89 | - 0.5.2.0 90 | * Provide ToHtml and ToValue instances for Int32, Int64, Word, Word32, 91 | and Word64 92 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Jasper Van der Jeugt 2010 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Jasper Van der Jeugt nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | ################################################################################ 2 | # Configuration 3 | ################################################################################ 4 | 5 | GHC = ghc 6 | GHCI = ghci 7 | GHC_FLAGS = -O2 -fforce-recomp -ibenchmarks -isrc -itests 8 | 9 | BENCHMARK_FLAGS = --resamples 10000 10 | 11 | ################################################################################ 12 | # Tests 13 | ################################################################################ 14 | 15 | # Run the tests 16 | test: 17 | $(GHC) $(GHC_FLAGS) -fhpc --make tests/TestSuite.hs 18 | rm -f TestSuite.tix 19 | ./tests/TestSuite 20 | 21 | # HPC 22 | test-hpc: 23 | hpc markup --destdir=hpc TestSuite 24 | 25 | ################################################################################ 26 | # Benchmarks 27 | ################################################################################ 28 | 29 | benchmark: 30 | $(GHC) $(GHC_FLAGS) --make -main-is RunHtmlBenchmarks benchmarks/RunHtmlBenchmarks.hs 31 | ./benchmarks/RunHtmlBenchmarks $(BENCHMARK_FLAGS) -o report.html 32 | 33 | benchmark-bigtable-non-haskell: 34 | ruby benchmarks/bigtable/erb.rb 35 | ruby benchmarks/bigtable/erubis.rb 36 | php -n benchmarks/bigtable/php.php 37 | -------------------------------------------------------------------------------- /README.markdown: -------------------------------------------------------------------------------- 1 | blaze-markup 2 | ============ 3 | 4 | [![Build Status](https://secure.travis-ci.org/jaspervdj/blaze-markup.png?branch=master)](http://travis-ci.org/jaspervdj/blaze-markup) 5 | 6 | What 7 | ---- 8 | 9 | The core modules to build a blazingly fast markup combinator library such as 10 | [blaze-html]. Most applications should not use this package directly. 11 | 12 | [blaze-html]: http://jaspervdj.be/blaze 13 | 14 | Development 15 | ----------- 16 | 17 | Running the tests: 18 | 19 | cabal configure --enable-tests && cabal build && cabal test 20 | 21 | Running the benchmarks: 22 | 23 | make benchmark 24 | 25 | Credits 26 | ------- 27 | 28 | Authors: 29 | 30 | - Jasper Van der Jeugt 31 | - Simon Meier 32 | - Deepak Jois 33 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /benchmarks/BenchmarkUtils.hs: -------------------------------------------------------------------------------- 1 | -- | This is a module which contains some ad-hoc HTML combinators for use when 2 | -- benchmarking 3 | -- 4 | {-# LANGUAGE OverloadedStrings, NoMonomorphismRestriction #-} 5 | module BenchmarkUtils 6 | ( Html 7 | , toHtml 8 | 9 | , tr 10 | , td 11 | , html 12 | , head 13 | , title 14 | , body 15 | , div 16 | , h1 17 | , h2 18 | , p 19 | , ol 20 | , li 21 | , table 22 | , img 23 | , id 24 | ) where 25 | 26 | import Prelude hiding (div, head, id) 27 | import Text.Blaze 28 | import Text.Blaze.Internal 29 | 30 | type Html = Markup 31 | 32 | toHtml :: ToMarkup a => a -> Html 33 | toHtml = toMarkup 34 | 35 | tr :: Html -- ^ Inner HTML. 36 | -> Html -- ^ Resulting HTML. 37 | tr = Parent "tr" "" 38 | {-# INLINE tr #-} 39 | 40 | td :: Html -- ^ Inner HTML. 41 | -> Html -- ^ Resulting HTML. 42 | td = Parent "td" "" 43 | {-# INLINE td #-} 44 | 45 | html :: Html -- ^ Inner HTML. 46 | -> Html -- ^ Resulting HTML. 47 | html = Parent "html" "" 48 | {-# INLINE html #-} 49 | 50 | head :: Html -- ^ Inner HTML. 51 | -> Html -- ^ Resulting HTML. 52 | head = Parent "head" "" 53 | {-# INLINE head #-} 54 | 55 | title :: Html -- ^ Inner HTML. 56 | -> Html -- ^ Resulting HTML. 57 | title = Parent "title" "" 58 | {-# INLINE title #-} 59 | 60 | body :: Html -- ^ Inner HTML. 61 | -> Html -- ^ Resulting HTML. 62 | body = Parent "body" "" 63 | {-# INLINE body #-} 64 | 65 | div :: Html -- ^ Inner HTML. 66 | -> Html -- ^ Resulting HTML. 67 | div = Parent "div" "" 68 | {-# INLINE div #-} 69 | 70 | h1 :: Html -- ^ Inner HTML. 71 | -> Html -- ^ Resulting HTML. 72 | h1 = Parent "h1" "" 73 | {-# INLINE h1 #-} 74 | 75 | h2 :: Html -- ^ Inner HTML. 76 | -> Html -- ^ Resulting HTML. 77 | h2 = Parent "h2" "" 78 | {-# INLINE h2 #-} 79 | 80 | p :: Html -- ^ Inner HTML. 81 | -> Html -- ^ Resulting HTML. 82 | p = Parent "p" "" 83 | {-# INLINE p #-} 84 | 85 | ol :: Html -- ^ Inner HTML. 86 | -> Html -- ^ Resulting HTML. 87 | ol = Parent "ol" "" 88 | {-# INLINE ol #-} 89 | 90 | li :: Html -- ^ Inner HTML. 91 | -> Html -- ^ Resulting HTML. 92 | li = Parent "li" "" 93 | {-# INLINE li #-} 94 | 95 | table :: Html -- ^ Inner HTML. 96 | -> Html -- ^ Resulting HTML. 97 | table = Parent "table" "" 98 | {-# INLINE table #-} 99 | 100 | img :: Html -- ^ Resulting HTML. 101 | img = Leaf "img" "" () 102 | {-# INLINE img #-} 103 | 104 | id :: AttributeValue -- ^ Attribute value. 105 | -> Attribute -- ^ Resulting attribute. 106 | id = attribute "id" " id=\"" 107 | {-# INLINE id #-} 108 | -------------------------------------------------------------------------------- /benchmarks/HtmlBenchmarks.hs: -------------------------------------------------------------------------------- 1 | -- | This is a collection of HTML benchmarks for BlazeMarkup. 2 | -- 3 | {-# LANGUAGE OverloadedStrings, ExistentialQuantification #-} 4 | {-# OPTIONS_GHC -fno-warn-unused-do-bind #-} 5 | module HtmlBenchmarks where 6 | 7 | import Data.Monoid (Monoid, mempty, mconcat, mappend) 8 | import Prelude hiding (div, id) 9 | import qualified Prelude as P 10 | 11 | import BenchmarkUtils 12 | import Text.Blaze 13 | import qualified BenchmarkUtils as H 14 | 15 | -- | Description of an HTML benchmark 16 | -- 17 | data HtmlBenchmark = forall a. HtmlBenchmark 18 | String -- ^ Name. 19 | (a -> Html) -- ^ Rendering function. 20 | a -- ^ Data. 21 | Html -- ^ Longer description. 22 | 23 | -- | List containing all benchmarks. 24 | -- 25 | benchmarks :: [HtmlBenchmark] 26 | benchmarks = 27 | [ HtmlBenchmark "bigTable" bigTable bigTableData $ 28 | let h = toHtml $ length bigTableData 29 | w = toHtml $ length $ P.head bigTableData 30 | in "Rendering of a big (" >> h >> "x" >> w >> ") HTML table" 31 | , HtmlBenchmark "basic" basic basicData 32 | "A simple, small basic template with a few holes to fill in" 33 | , HtmlBenchmark "wideTree" wideTree wideTreeData $ 34 | "A very wide tree (" >> toHtml (length wideTreeData) >> " elements)" 35 | , HtmlBenchmark "wideTreeEscaping" wideTree wideTreeEscapingData $ do 36 | "A very wide tree (" >> toHtml (length wideTreeData) >> " elements)" 37 | " with lots of escaping" 38 | , HtmlBenchmark "deepTree" deepTree deepTreeData $ do 39 | "A really deep tree (" >> toHtml deepTreeData >> " nested templates)" 40 | , HtmlBenchmark "manyAttributes" manyAttributes manyAttributesData $ do 41 | "A single element with " >> toHtml (length manyAttributesData) 42 | " attributes." 43 | , HtmlBenchmark "customAttribute" customAttributes customAttributesData $ 44 | "Creating custom attributes" 45 | ] 46 | 47 | rows :: Int 48 | rows = 1000 49 | 50 | bigTableData :: [[Int]] 51 | bigTableData = replicate rows [1..10] 52 | {-# NOINLINE bigTableData #-} 53 | 54 | basicData :: (String, String, [String]) 55 | basicData = ("Just a test", "joe", items) 56 | {-# NOINLINE basicData #-} 57 | 58 | items :: [String] 59 | items = map (("Number " `mappend`) . show) [1 :: Int .. 14] 60 | {-# NOINLINE items #-} 61 | 62 | wideTreeData :: [String] 63 | wideTreeData = take 5000 $ 64 | cycle ["λf.(λx.fxx)(λx.fxx)", "These old days", "Foobar", "lol", "x ∈ A"] 65 | {-# NOINLINE wideTreeData #-} 66 | 67 | wideTreeEscapingData :: [String] 68 | wideTreeEscapingData = take 1000 $ 69 | cycle ["<><>", "\"lol\"", "<&>", "'>>'"] 70 | {-# NOINLINE wideTreeEscapingData #-} 71 | 72 | deepTreeData :: Int 73 | deepTreeData = 1000 74 | {-# NOINLINE deepTreeData #-} 75 | 76 | manyAttributesData :: [String] 77 | manyAttributesData = wideTreeData 78 | 79 | customAttributesData :: [(String, String)] 80 | customAttributesData = zip wideTreeData wideTreeData 81 | 82 | -- | Render the argument matrix as an HTML table. 83 | -- 84 | bigTable :: [[Int]] -- ^ Matrix. 85 | -> Html -- ^ Result. 86 | bigTable t = table $ mconcat $ map row t 87 | where 88 | row r = tr $ mconcat $ map (td . toHtml) r 89 | 90 | -- | Render a simple HTML page with some data. 91 | -- 92 | basic :: (String, String, [String]) -- ^ (Title, User, Items) 93 | -> Html -- ^ Result. 94 | basic (title', user, items') = html $ do 95 | H.head $ title $ toHtml title' 96 | body $ do 97 | div ! id "header" $ (h1 $ toHtml title') 98 | p $ "Hello, " `mappend` toHtml user `mappend` "!" 99 | p $ "Hello, me!" 100 | p $ "Hello, world!" 101 | h2 $ "loop" 102 | ol $ mconcat $ map (li . toHtml) items' 103 | div ! id "footer" $ mempty 104 | 105 | -- | A benchmark producing a very wide but very shallow tree. 106 | -- 107 | wideTree :: [String] -- ^ Text to create a tree from. 108 | -> Html -- ^ Result. 109 | wideTree = div . mapM_ ((p ! id "foo") . toHtml) 110 | 111 | -- | Create a very deep tree. 112 | -- 113 | deepTree :: Int -- ^ Depth of the tree. 114 | -> Html -- ^ Result. 115 | deepTree 0 = "foo" 116 | deepTree n = p $ table $ tr $ td $ div $ deepTree (n - 1) 117 | 118 | -- | Create an element with many attributes. 119 | -- 120 | manyAttributes :: [String] -- ^ List of attribute values. 121 | -> Html -- ^ Result. 122 | manyAttributes = foldl setAttribute img 123 | where 124 | setAttribute html' value' = html' ! id (toValue value') 125 | {-# INLINE setAttribute #-} 126 | 127 | customAttributes :: [(String, String)] -- ^ List of attribute name, value pairs 128 | -> Html -- ^ Result 129 | customAttributes = foldl setAttribute img 130 | where 131 | setAttribute html' (name, value') = 132 | html' ! customAttribute (stringTag name) (toValue value') 133 | -------------------------------------------------------------------------------- /benchmarks/RunHtmlBenchmarks.hs: -------------------------------------------------------------------------------- 1 | -- | This is a module which runs the 'HtmlBenchmarks' module using the different 2 | -- renderers available. 3 | -- 4 | module RunHtmlBenchmarks where 5 | 6 | import Criterion.Main 7 | import qualified Data.Text.Lazy as LT 8 | import qualified Data.ByteString.Lazy as LB 9 | 10 | import qualified Text.Blaze.Renderer.Utf8 as Utf8 11 | import qualified Text.Blaze.Renderer.String as String 12 | import qualified Text.Blaze.Renderer.Text as Text 13 | 14 | import HtmlBenchmarks (HtmlBenchmark (..), benchmarks) 15 | 16 | -- | Function to run the benchmarks using criterion 17 | -- 18 | main :: IO () 19 | main = defaultMain $ map benchHtml benchmarks 20 | where 21 | benchHtml (HtmlBenchmark name f x _) = bgroup name $ 22 | [ bench "Utf8" $ nf (LB.length . Utf8.renderMarkup . f) x 23 | , bench "String" $ nf (String.renderMarkup . f) x 24 | , bench "Text" $ nf (LT.length . Text.renderMarkup . f) x 25 | ] 26 | -------------------------------------------------------------------------------- /benchmarks/ServerChunkSize.hs: -------------------------------------------------------------------------------- 1 | -- | A benchmark for measuring the impact of lazy bytestring chunk size on 2 | -- server performance. 3 | -- 4 | {-# LANGUAGE OverloadedStrings #-} 5 | module Main where 6 | 7 | import Control.Concurrent (forkIO) 8 | import Control.Monad (forever) 9 | import Data.Monoid (mappend) 10 | import Network (listenOn, PortID (PortNumber)) 11 | import Network.Socket (accept, sClose) 12 | import Prelude hiding (putStrLn) 13 | import System.Environment (getArgs) 14 | 15 | import Network.Socket.ByteString (recv, send) 16 | import Network.Socket.ByteString.Lazy (sendAll) 17 | import qualified Data.ByteString.Char8 as SBC 18 | import qualified Data.ByteString.Lazy as LB 19 | 20 | -- | Generate a 128k response, with a given chunk size. 21 | -- 22 | makeResponse :: Int -- ^ Chunk size. 23 | -> LB.ByteString -- ^ Result. 24 | makeResponse chunkSize = 25 | let chunks = createChunks chunkSize totalSize 26 | in LB.fromChunks chunks 27 | where 28 | -- A 64 kilobyte response. 29 | totalSize = 128 * 1024 30 | 31 | createChunks c s 32 | | c < s = SBC.replicate c 'a' : createChunks c (s - c) 33 | | otherwise = SBC.replicate s 'a' : [] 34 | 35 | main :: IO () 36 | main = do 37 | args <- getArgs 38 | let port = PortNumber $ fromIntegral $ (read $ head args :: Int) 39 | chunkSize = read $ args !! 1 40 | 41 | socket <- listenOn port 42 | forever $ do 43 | (s, _) <- accept socket 44 | forkIO (respond chunkSize s) 45 | where 46 | respond chunkSize s = do 47 | _ <- recv s 1024 48 | _ <- send s $ "HTTP/1.1 200 OK\r\n" 49 | `mappend` "Content-Type: text/html; charset=UTF-8\r\n" 50 | `mappend` "\r\n" 51 | sendAll s $ makeResponse chunkSize 52 | sClose s 53 | -------------------------------------------------------------------------------- /benchmarks/bigtable/erb.rb: -------------------------------------------------------------------------------- 1 | # BigTable benchmark implemented in ERB. 2 | # 3 | require 'erb' 4 | require 'benchmark' 5 | include ERB::Util 6 | 7 | table = (1 .. 1000).map do |_| (1 .. 10) end 8 | 9 | template = ERB.new <<-EOF 10 | 11 | <% table.each do |row| %> 12 | 13 | <% row.each do |value| %> 14 | 17 | <% end %> 18 | 19 | <% end %> 20 |
15 | <%= value %> 16 |
21 | EOF 22 | 23 | number_runs = 100 24 | start_time = Time.now.to_f 25 | number_runs.times do 26 | template.result(binding) 27 | end 28 | end_time = Time.now.to_f 29 | 30 | # start_time and end_time are both in seconds now 31 | ms = (end_time - start_time) * 1000 / number_runs 32 | puts "\"ERB\", #{ms}" 33 | -------------------------------------------------------------------------------- /benchmarks/bigtable/erubis.rb: -------------------------------------------------------------------------------- 1 | # BigTable benchmark implemented in erubis 2 | # 3 | require 'erubis' 4 | require 'benchmark' 5 | 6 | table = (1 .. 1000).map do |_| (1 .. 10) end 7 | 8 | template = Erubis::Eruby.new <<-EOF 9 | 10 | <% table.each do |row| %> 11 | 12 | <% row.each do |value| %> 13 | 16 | <% end %> 17 | 18 | <% end %> 19 |
14 | <%= value %> 15 |
20 | EOF 21 | 22 | number_runs = 100 23 | start_time = Time.now.to_f 24 | number_runs.times do 25 | template.result(binding) 26 | end 27 | end_time = Time.now.to_f 28 | 29 | # start_time and end_time are both in seconds now 30 | ms = (end_time - start_time) * 1000 / number_runs 31 | puts "\"Erubis\", #{ms}" 32 | -------------------------------------------------------------------------------- /benchmarks/bigtable/hamlet.hs: -------------------------------------------------------------------------------- 1 | -- | BigTable benchmark implemented using Hamlet. 2 | -- 3 | {-# LANGUAGE QuasiQuotes #-} 4 | module Main where 5 | 6 | import Criterion.Main 7 | import Text.Hamlet 8 | import Text.Hamlet.Monad 9 | import Numeric (showInt) 10 | import Data.Text (Text) 11 | import qualified Data.Text as T 12 | import Data.Maybe (fromJust) 13 | 14 | main = defaultMain 15 | [ bench "bigTable" $ nf bigTable bigTableData 16 | ] 17 | where 18 | rows :: Int 19 | rows = 1000 20 | 21 | bigTableData :: [[Int]] 22 | bigTableData = replicate rows [1..10] 23 | {-# NOINLINE bigTableData #-} 24 | 25 | bigTable rows = fromJust $ hamletToText undefined [$hamlet| 26 | %table 27 | $forall rows row 28 | %tr 29 | $forall row cell 30 | %td $showInt'.cell$ 31 | |] 32 | where 33 | showInt' i = Encoded $ T.pack $ showInt i "" 34 | -------------------------------------------------------------------------------- /benchmarks/bigtable/html-minimalist.hs: -------------------------------------------------------------------------------- 1 | -- | BigTable benchmark using the html-minimalist package from hackage. 2 | -- 3 | import Text.HTML.Light hiding (map) 4 | import Criterion.Main 5 | 6 | bigTable :: [[Int]] -> String 7 | bigTable t = 8 | renderXHTML xhtml_1_0_strict $ html [] $ return $ table [] $ map row t 9 | where 10 | row r = tr [] $ map (td [] . return . cdata . show) r 11 | 12 | main = defaultMain 13 | [ bench "bigTable" $ nf bigTable myTable ] 14 | where 15 | rows :: Int 16 | rows = 1000 17 | 18 | myTable :: [[Int]] 19 | myTable = replicate rows [1..10] 20 | {-# NOINLINE myTable #-} 21 | -------------------------------------------------------------------------------- /benchmarks/bigtable/html.hs: -------------------------------------------------------------------------------- 1 | -- | BigTable benchmark using the HTML package from hackage. 2 | -- 3 | import Text.Html 4 | import Criterion.Main 5 | 6 | bigTable :: [[Int]] -> String 7 | bigTable t = renderHtml $ table $ concatHtml $ map row t 8 | where 9 | row r = tr $ concatHtml $ map (td . stringToHtml . show) r 10 | 11 | main = defaultMain 12 | [ bench "bigTable" $ nf bigTable myTable ] 13 | where 14 | rows :: Int 15 | rows = 1000 16 | 17 | myTable :: [[Int]] 18 | myTable = replicate rows [1..10] 19 | {-# NOINLINE myTable #-} 20 | -------------------------------------------------------------------------------- /benchmarks/bigtable/php.php: -------------------------------------------------------------------------------- 1 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
16 | 31 | -------------------------------------------------------------------------------- /benchmarks/bigtable/xhtml.hs: -------------------------------------------------------------------------------- 1 | -- | BigTable benchmark using the XHTML package from hackage. 2 | -- 3 | import Text.XHtml.Strict 4 | import Criterion.Main 5 | 6 | bigTable :: [[Int]] -> String 7 | bigTable t = renderHtml $ table $ concatHtml $ map row t 8 | where 9 | row r = tr $ concatHtml $ map (td . stringToHtml . show) r 10 | 11 | main = defaultMain 12 | [ bench "bigTable" $ nf bigTable myTable ] 13 | where 14 | rows :: Int 15 | rows = 1000 16 | 17 | myTable :: [[Int]] 18 | myTable = replicate rows [1..10] 19 | {-# NOINLINE myTable #-} 20 | -------------------------------------------------------------------------------- /blaze-markup.cabal: -------------------------------------------------------------------------------- 1 | Cabal-version: >= 1.10 2 | Name: blaze-markup 3 | Version: 0.8.3.0 4 | x-revision: 2 5 | Homepage: http://jaspervdj.be/blaze 6 | Bug-Reports: http://github.com/jaspervdj/blaze-markup/issues 7 | License: BSD3 8 | License-file: LICENSE 9 | Author: Jasper Van der Jeugt, Simon Meier, Deepak Jois 10 | Maintainer: Jasper Van der Jeugt 11 | Stability: Experimental 12 | Category: Text 13 | Synopsis: A blazingly fast markup combinator library for Haskell 14 | Description: 15 | Core modules of a blazingly fast markup combinator library for the Haskell 16 | programming language. The Text.Blaze module is a good 17 | starting point, as well as this tutorial: 18 | . 19 | 20 | Build-type: Simple 21 | 22 | Tested-with: 23 | GHC == 9.12.2 24 | GHC == 9.10.2 25 | GHC == 9.8.4 26 | GHC == 9.6.7 27 | GHC == 9.4.8 28 | GHC == 9.2.8 29 | GHC == 9.0.2 30 | GHC == 8.10.7 31 | GHC == 8.8.4 32 | GHC == 8.6.5 33 | GHC == 8.4.4 34 | GHC == 8.2.2 35 | GHC == 8.0.2 36 | 37 | Extra-source-files: 38 | CHANGELOG 39 | 40 | Library 41 | Hs-source-dirs: src 42 | Ghc-Options: -Wall 43 | Default-language: Haskell2010 44 | 45 | Exposed-modules: 46 | Text.Blaze 47 | Text.Blaze.Internal 48 | Text.Blaze.Renderer.Pretty 49 | Text.Blaze.Renderer.String 50 | Text.Blaze.Renderer.Text 51 | Text.Blaze.Renderer.Utf8 52 | 53 | Build-depends: 54 | base >= 4 && < 5 55 | , blaze-builder >= 0.3 && < 0.5 56 | , text >= 0.10 && < 2.2 57 | , bytestring >= 0.9 && < 0.13 58 | 59 | Test-suite blaze-markup-tests 60 | Type: exitcode-stdio-1.0 61 | Hs-source-dirs: src tests 62 | Main-is: TestSuite.hs 63 | Ghc-options: -Wall 64 | Default-language: Haskell2010 65 | 66 | Other-modules: 67 | Text.Blaze 68 | Text.Blaze.Internal 69 | Text.Blaze.Renderer.Pretty 70 | Text.Blaze.Renderer.String 71 | Text.Blaze.Renderer.Text 72 | Text.Blaze.Renderer.Utf8 73 | Text.Blaze.Tests 74 | Text.Blaze.Tests.Util 75 | 76 | Build-depends: 77 | -- Copied from regular dependencies... 78 | base >= 4 && < 5 79 | , blaze-builder >= 0.3 && < 0.5 80 | , text >= 0.10 && < 2.2 81 | , bytestring >= 0.9 && < 0.13 82 | -- Extra dependencies 83 | , HUnit >= 1.2 && < 1.7 84 | , QuickCheck >= 2.7 && < 3 85 | , containers >= 0.3 && < 0.8 86 | , tasty >= 1.0 && < 1.6 87 | , tasty-hunit >= 0.10 && < 0.11 88 | , tasty-quickcheck >= 0.10 && < 1 89 | 90 | Source-repository head 91 | Type: git 92 | Location: http://github.com/jaspervdj/blaze-markup 93 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | branches: master 2 | 3 | -- -- Test core libraries in versions newer than shipped with GHC 4 | -- constraint-set latest-core-libs-Sep-2023 5 | -- constraints: bytestring >= 0.12 6 | -- constraints: text >= 2.1 7 | -- constraints: containers >= 0.7 8 | -- ghc: >=8.2 && < 9.7 9 | -- tests: True 10 | -- run-tests: True 11 | 12 | -- raw-project 13 | -- allow-newer: bytestring 14 | -------------------------------------------------------------------------------- /src/Text/Blaze.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE OverloadedStrings #-} 4 | {-# LANGUAGE TypeSynonymInstances #-} 5 | -- | BlazeMarkup is a markup combinator library. It provides a way to embed 6 | -- markup languages like HTML and SVG in Haskell in an efficient and convenient 7 | -- way, with a light-weight syntax. 8 | -- 9 | -- To use the library, one needs to import a set of combinators. For example, 10 | -- you can use HTML 4 Strict from BlazeHtml package. 11 | -- 12 | -- > {-# LANGUAGE OverloadedStrings #-} 13 | -- > import Prelude hiding (head, id, div) 14 | -- > import Text.Blaze.Html4.Strict hiding (map) 15 | -- > import Text.Blaze.Html4.Strict.Attributes hiding (title) 16 | -- 17 | -- To render the page later on, you need a so called Renderer. The recommended 18 | -- renderer is an UTF-8 renderer which produces a lazy bytestring. 19 | -- 20 | -- > import Text.Blaze.Renderer.Utf8 (renderMarkup) 21 | -- 22 | -- Now, you can describe pages using the imported combinators. 23 | -- 24 | -- > page1 :: Markup 25 | -- > page1 = html $ do 26 | -- > head $ do 27 | -- > title "Introduction page." 28 | -- > link ! rel "stylesheet" ! type_ "text/css" ! href "screen.css" 29 | -- > body $ do 30 | -- > div ! id "header" $ "Syntax" 31 | -- > p "This is an example of BlazeMarkup syntax." 32 | -- > ul $ mapM_ (li . toMarkup . show) [1, 2, 3] 33 | -- 34 | -- The resulting HTML can now be extracted using: 35 | -- 36 | -- > renderMarkup page1 37 | -- 38 | module Text.Blaze 39 | ( 40 | -- * Important types. 41 | Markup 42 | , Tag 43 | , Attribute 44 | , AttributeValue 45 | 46 | -- * Creating attributes. 47 | , dataAttribute 48 | , customAttribute 49 | 50 | -- * Converting values to Markup. 51 | , ToMarkup (..) 52 | , text 53 | , preEscapedText 54 | , lazyText 55 | , preEscapedLazyText 56 | , string 57 | , preEscapedString 58 | , unsafeByteString 59 | , unsafeLazyByteString 60 | 61 | -- * Comments 62 | , textComment 63 | , lazyTextComment 64 | , stringComment 65 | , unsafeByteStringComment 66 | , unsafeLazyByteStringComment 67 | 68 | -- * Creating tags. 69 | , textTag 70 | , stringTag 71 | 72 | -- * Converting values to attribute values. 73 | , ToValue (..) 74 | , textValue 75 | , preEscapedTextValue 76 | , lazyTextValue 77 | , preEscapedLazyTextValue 78 | , stringValue 79 | , preEscapedStringValue 80 | , unsafeByteStringValue 81 | , unsafeLazyByteStringValue 82 | 83 | -- * Setting attributes 84 | , (!) 85 | , (!?) 86 | 87 | -- * Modifying Markup trees 88 | , contents 89 | ) where 90 | 91 | import Data.Int (Int32, Int64) 92 | import Data.Monoid (mconcat) 93 | import Data.Word (Word, Word32, Word64) 94 | #if MIN_VERSION_base(4,8,0) 95 | import Numeric.Natural (Natural) 96 | #endif 97 | #if MIN_VERSION_base(4,9,0) 98 | import Data.List.NonEmpty (NonEmpty (..)) 99 | #endif 100 | 101 | import Data.Text (Text) 102 | import qualified Data.Text.Lazy as LT 103 | import qualified Data.Text.Lazy.Builder as LTB 104 | 105 | import Text.Blaze.Internal 106 | 107 | -- | Class allowing us to use a single function for Markup values 108 | -- 109 | class ToMarkup a where 110 | -- | Convert a value to Markup. 111 | -- 112 | toMarkup :: a -> Markup 113 | 114 | -- | Convert a value to Markup without escaping 115 | -- 116 | preEscapedToMarkup :: a -> Markup 117 | preEscapedToMarkup = toMarkup 118 | {-# INLINE preEscapedToMarkup #-} 119 | 120 | instance ToMarkup Markup where 121 | toMarkup = id 122 | {-# INLINE toMarkup #-} 123 | 124 | instance ToMarkup [Markup] where 125 | toMarkup = mconcat 126 | {-# INLINE toMarkup #-} 127 | 128 | instance ToMarkup Text where 129 | toMarkup = text 130 | {-# INLINE toMarkup #-} 131 | preEscapedToMarkup = preEscapedText 132 | {-# INLINE preEscapedToMarkup #-} 133 | 134 | instance ToMarkup LT.Text where 135 | toMarkup = lazyText 136 | {-# INLINE toMarkup #-} 137 | preEscapedToMarkup = preEscapedLazyText 138 | {-# INLINE preEscapedToMarkup #-} 139 | 140 | instance ToMarkup LTB.Builder where 141 | toMarkup = textBuilder 142 | {-# INLINE toMarkup #-} 143 | preEscapedToMarkup = preEscapedTextBuilder 144 | {-# INLINE preEscapedToMarkup #-} 145 | 146 | instance ToMarkup String where 147 | toMarkup = string 148 | {-# INLINE toMarkup #-} 149 | preEscapedToMarkup = preEscapedString 150 | {-# INLINE preEscapedToMarkup #-} 151 | 152 | instance ToMarkup Int where 153 | toMarkup = string . show 154 | {-# INLINE toMarkup #-} 155 | 156 | instance ToMarkup Int32 where 157 | toMarkup = string . show 158 | {-# INLINE toMarkup #-} 159 | 160 | instance ToMarkup Int64 where 161 | toMarkup = string . show 162 | {-# INLINE toMarkup #-} 163 | 164 | #if MIN_VERSION_base(4,8,0) 165 | instance ToMarkup Natural where 166 | toMarkup = string . show 167 | {-# INLINE toMarkup #-} 168 | #endif 169 | 170 | instance ToMarkup Char where 171 | toMarkup = string . return 172 | {-# INLINE toMarkup #-} 173 | 174 | instance ToMarkup Bool where 175 | toMarkup = string . show 176 | {-# INLINE toMarkup #-} 177 | 178 | instance ToMarkup Integer where 179 | toMarkup = string . show 180 | {-# INLINE toMarkup #-} 181 | 182 | instance ToMarkup Float where 183 | toMarkup = string . show 184 | {-# INLINE toMarkup #-} 185 | 186 | instance ToMarkup Double where 187 | toMarkup = string . show 188 | {-# INLINE toMarkup #-} 189 | 190 | instance ToMarkup Word where 191 | toMarkup = string . show 192 | {-# INLINE toMarkup #-} 193 | 194 | instance ToMarkup Word32 where 195 | toMarkup = string . show 196 | {-# INLINE toMarkup #-} 197 | 198 | instance ToMarkup Word64 where 199 | toMarkup = string . show 200 | {-# INLINE toMarkup #-} 201 | 202 | -- | Class allowing us to use a single function for attribute values 203 | -- 204 | class ToValue a where 205 | -- | Convert a value to an attribute value 206 | -- 207 | toValue :: a -> AttributeValue 208 | 209 | -- | Convert a value to an attribute value without escaping 210 | -- 211 | preEscapedToValue :: a -> AttributeValue 212 | preEscapedToValue = toValue 213 | {-# INLINE preEscapedToValue #-} 214 | 215 | instance ToValue AttributeValue where 216 | toValue = id 217 | {-# INLINE toValue #-} 218 | 219 | instance ToValue Text where 220 | toValue = textValue 221 | {-# INLINE toValue #-} 222 | preEscapedToValue = preEscapedTextValue 223 | {-# INLINE preEscapedToValue #-} 224 | 225 | instance ToValue LT.Text where 226 | toValue = lazyTextValue 227 | {-# INLINE toValue #-} 228 | preEscapedToValue = preEscapedLazyTextValue 229 | {-# INLINE preEscapedToValue #-} 230 | 231 | instance ToValue LTB.Builder where 232 | toValue = textBuilderValue 233 | {-# INLINE toValue #-} 234 | preEscapedToValue = preEscapedTextBuilderValue 235 | {-# INLINE preEscapedToValue #-} 236 | 237 | instance ToValue String where 238 | toValue = stringValue 239 | {-# INLINE toValue #-} 240 | preEscapedToValue = preEscapedStringValue 241 | {-# INLINE preEscapedToValue #-} 242 | 243 | instance ToValue Int where 244 | toValue = stringValue . show 245 | {-# INLINE toValue #-} 246 | 247 | instance ToValue Int32 where 248 | toValue = stringValue . show 249 | {-# INLINE toValue #-} 250 | 251 | instance ToValue Int64 where 252 | toValue = stringValue . show 253 | {-# INLINE toValue #-} 254 | 255 | instance ToValue Char where 256 | toValue = stringValue . return 257 | {-# INLINE toValue #-} 258 | 259 | instance ToValue Bool where 260 | toValue = stringValue . show 261 | {-# INLINE toValue #-} 262 | 263 | instance ToValue Integer where 264 | toValue = stringValue . show 265 | {-# INLINE toValue #-} 266 | 267 | instance ToValue Float where 268 | toValue = stringValue . show 269 | {-# INLINE toValue #-} 270 | 271 | instance ToValue Double where 272 | toValue = stringValue . show 273 | {-# INLINE toValue #-} 274 | 275 | instance ToValue Word where 276 | toValue = stringValue . show 277 | {-# INLINE toValue #-} 278 | 279 | instance ToValue Word32 where 280 | toValue = stringValue . show 281 | {-# INLINE toValue #-} 282 | 283 | instance ToValue Word64 where 284 | toValue = stringValue . show 285 | {-# INLINE toValue #-} 286 | 287 | -- Non-empty strings 288 | #if MIN_VERSION_base(4,9,0) 289 | instance ToMarkup (NonEmpty Char) where 290 | toMarkup (x :| xs) = string (x : xs) 291 | preEscapedToMarkup (x :| xs) = preEscapedString (x : xs) 292 | 293 | instance ToValue (NonEmpty Char) where 294 | toValue (x :| xs) = stringValue (x : xs) 295 | #endif 296 | -------------------------------------------------------------------------------- /src/Text/Blaze/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveDataTypeable #-} 3 | {-# LANGUAGE ExistentialQuantification #-} 4 | {-# LANGUAGE FlexibleInstances #-} 5 | {-# LANGUAGE GADTs #-} 6 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 7 | {-# LANGUAGE OverloadedStrings #-} 8 | {-# LANGUAGE Rank2Types #-} 9 | -- | The BlazeMarkup core, consisting of functions that offer the power to 10 | -- generate custom markup elements. It also offers user-centric functions, 11 | -- which are exposed through "Text.Blaze". 12 | -- 13 | -- While this module is exported, usage of it is not recommended, unless you 14 | -- know what you are doing. This module might undergo changes at any time. 15 | -- 16 | module Text.Blaze.Internal 17 | ( 18 | -- * Important types. 19 | ChoiceString (..) 20 | , StaticString (..) 21 | , MarkupM (..) 22 | , Markup 23 | , Tag 24 | , Attribute 25 | , AttributeValue 26 | 27 | -- * Creating custom tags and attributes. 28 | , customParent 29 | , customLeaf 30 | , attribute 31 | , dataAttribute 32 | , customAttribute 33 | 34 | -- * Converting values to Markup. 35 | , text 36 | , preEscapedText 37 | , lazyText 38 | , preEscapedLazyText 39 | , textBuilder 40 | , preEscapedTextBuilder 41 | , string 42 | , preEscapedString 43 | , unsafeByteString 44 | , unsafeLazyByteString 45 | 46 | -- * Comments 47 | , textComment 48 | , lazyTextComment 49 | , stringComment 50 | , unsafeByteStringComment 51 | , unsafeLazyByteStringComment 52 | 53 | -- * Converting values to tags. 54 | , textTag 55 | , stringTag 56 | 57 | -- * Converting values to attribute values. 58 | , textValue 59 | , preEscapedTextValue 60 | , lazyTextValue 61 | , preEscapedLazyTextValue 62 | , textBuilderValue 63 | , preEscapedTextBuilderValue 64 | , stringValue 65 | , preEscapedStringValue 66 | , unsafeByteStringValue 67 | , unsafeLazyByteStringValue 68 | 69 | -- * Setting attributes 70 | , Attributable 71 | , (!) 72 | , (!?) 73 | 74 | -- * Modifying Markup elements 75 | , contents 76 | , external 77 | 78 | -- * Querying Markup elements 79 | , null 80 | ) where 81 | 82 | import Control.Applicative (Applicative (..)) 83 | import qualified Data.List as List 84 | import Data.Monoid (Monoid, mappend, mconcat, mempty) 85 | import Prelude hiding (null) 86 | 87 | import qualified Data.ByteString as B 88 | import Data.ByteString.Char8 (ByteString) 89 | import qualified Data.ByteString.Lazy as BL 90 | import Data.Text (Text) 91 | import qualified Data.Text as T 92 | import qualified Data.Text.Encoding as T 93 | import qualified Data.Text.Lazy as LT 94 | import qualified Data.Text.Lazy.Builder as LTB 95 | import Data.Typeable (Typeable) 96 | import GHC.Exts (IsString (..)) 97 | 98 | #if MIN_VERSION_base(4,9,0) 99 | import Data.Semigroup (Semigroup(..)) 100 | #endif 101 | 102 | -- | A static string that supports efficient output to all possible backends. 103 | -- 104 | data StaticString = StaticString 105 | { getString :: String -> String -- ^ Appending haskell string 106 | , getUtf8ByteString :: B.ByteString -- ^ UTF-8 encoded bytestring 107 | , getText :: Text -- ^ Text value 108 | } 109 | 110 | -- 'StaticString's should only be converted from string literals, as far as I 111 | -- can see. 112 | -- 113 | instance IsString StaticString where 114 | fromString s = let t = T.pack s 115 | in StaticString (s ++) (T.encodeUtf8 t) t 116 | 117 | -- | A string denoting input from different string representations. 118 | -- 119 | data ChoiceString 120 | -- | Static data 121 | = Static {-# UNPACK #-} !StaticString 122 | -- | A Haskell String 123 | | String String 124 | -- | A Text value 125 | | Text Text 126 | -- | An encoded bytestring 127 | | ByteString B.ByteString 128 | -- | A pre-escaped string 129 | | PreEscaped ChoiceString 130 | -- | External data in style/script tags, should be checked for validity 131 | | External ChoiceString 132 | -- | Concatenation 133 | | AppendChoiceString ChoiceString ChoiceString 134 | -- | Empty string 135 | | EmptyChoiceString 136 | 137 | #if MIN_VERSION_base(4,9,0) 138 | instance Semigroup ChoiceString where 139 | (<>) = AppendChoiceString 140 | {-# INLINE (<>) #-} 141 | #endif 142 | 143 | instance Monoid ChoiceString where 144 | mempty = EmptyChoiceString 145 | {-# INLINE mempty #-} 146 | #if !(MIN_VERSION_base(4,11,0)) 147 | mappend = AppendChoiceString 148 | {-# INLINE mappend #-} 149 | #endif 150 | 151 | instance IsString ChoiceString where 152 | fromString = String 153 | {-# INLINE fromString #-} 154 | 155 | -- | The core Markup datatype. 156 | -- 157 | data MarkupM a 158 | -- | Tag, open tag, end tag, content 159 | = Parent StaticString StaticString StaticString (MarkupM a) 160 | -- | Custom parent 161 | | CustomParent ChoiceString (MarkupM a) 162 | -- | Tag, open tag, end tag 163 | | Leaf StaticString StaticString StaticString a 164 | -- | Custom leaf 165 | | CustomLeaf ChoiceString Bool a 166 | -- | HTML content 167 | | Content ChoiceString a 168 | -- | HTML comment. Note: you should wrap the 'ChoiceString' in a 169 | -- 'PreEscaped'. 170 | | Comment ChoiceString a 171 | -- | Concatenation of two HTML pieces 172 | | forall b. Append (MarkupM b) (MarkupM a) 173 | -- | Add an attribute to the inner HTML. Raw key, key, value, HTML to 174 | -- receive the attribute. 175 | | AddAttribute StaticString StaticString ChoiceString (MarkupM a) 176 | -- | Add a custom attribute to the inner HTML. 177 | | AddCustomAttribute ChoiceString ChoiceString (MarkupM a) 178 | -- | Empty HTML. 179 | | Empty a 180 | deriving (Typeable) 181 | 182 | -- | Simplification of the 'MarkupM' datatype. 183 | -- 184 | type Markup = MarkupM () 185 | 186 | instance Monoid a => Monoid (MarkupM a) where 187 | mempty = Empty mempty 188 | {-# INLINE mempty #-} 189 | #if !(MIN_VERSION_base(4,11,0)) 190 | mappend x y = Append x y 191 | {-# INLINE mappend #-} 192 | mconcat = foldr Append (Empty mempty) 193 | {-# INLINE mconcat #-} 194 | #endif 195 | 196 | #if MIN_VERSION_base(4,9,0) 197 | instance Monoid a => Semigroup (MarkupM a) where 198 | x <> y = Append x y 199 | {-# INLINE (<>) #-} 200 | sconcat = foldr Append (Empty mempty) 201 | {-# INLINE sconcat #-} 202 | #endif 203 | 204 | instance Functor MarkupM where 205 | fmap f x = 206 | -- Instead of traversing through all the nodes, we just store an extra 207 | -- 'Empty' node with the new result. 208 | Append x (Empty (f (markupValue x))) 209 | 210 | instance Applicative MarkupM where 211 | pure x = Empty x 212 | {-# INLINE pure #-} 213 | (<*>) x y = 214 | -- We need to add an extra 'Empty' node to store the result. 215 | Append (Append x y) (Empty (markupValue x (markupValue y))) 216 | {-# INLINE (<*>) #-} 217 | (*>) = Append 218 | {-# INLINE (*>) #-} 219 | -- (<*) = Append 220 | -- {-# INLINE (<*) #-} 221 | 222 | instance Monad MarkupM where 223 | return x = Empty x 224 | {-# INLINE return #-} 225 | (>>) = Append 226 | {-# INLINE (>>) #-} 227 | h1 >>= f = Append h1 (f (markupValue h1)) 228 | {-# INLINE (>>=) #-} 229 | 230 | instance (a ~ ()) => IsString (MarkupM a) where 231 | fromString x = Content (fromString x) mempty 232 | {-# INLINE fromString #-} 233 | 234 | -- | Get the value from a 'MarkupM'. 235 | -- 236 | markupValue :: MarkupM a -> a 237 | markupValue m0 = case m0 of 238 | Parent _ _ _ m1 -> markupValue m1 239 | CustomParent _ m1 -> markupValue m1 240 | Leaf _ _ _ x -> x 241 | CustomLeaf _ _ x -> x 242 | Content _ x -> x 243 | Comment _ x -> x 244 | Append _ m1 -> markupValue m1 245 | AddAttribute _ _ _ m1 -> markupValue m1 246 | AddCustomAttribute _ _ m1 -> markupValue m1 247 | Empty x -> x 248 | 249 | -- | Type for an HTML tag. This can be seen as an internal string type used by 250 | -- BlazeMarkup. 251 | -- 252 | newtype Tag = Tag { unTag :: StaticString } 253 | deriving (IsString) 254 | 255 | -- | Type for an attribute. 256 | -- 257 | newtype Attribute = Attribute (forall a. MarkupM a -> MarkupM a) 258 | 259 | #if MIN_VERSION_base(4,9,0) 260 | instance Semigroup Attribute where 261 | Attribute f <> Attribute g = Attribute (g . f) 262 | #endif 263 | 264 | instance Monoid Attribute where 265 | mempty = Attribute id 266 | #if !(MIN_VERSION_base(4,11,0)) 267 | Attribute f `mappend` Attribute g = Attribute (g . f) 268 | #endif 269 | 270 | -- | The type for the value part of an attribute. 271 | -- 272 | newtype AttributeValue = AttributeValue { unAttributeValue :: ChoiceString } 273 | deriving (IsString, Monoid 274 | #if MIN_VERSION_base(4,9,0) 275 | ,Semigroup 276 | #endif 277 | ) 278 | 279 | -- | Create a custom parent element 280 | customParent :: Tag -- ^ Element tag 281 | -> Markup -- ^ Content 282 | -> Markup -- ^ Resulting markup 283 | customParent tag cont = CustomParent (Static $ unTag tag) cont 284 | 285 | -- | Create a custom leaf element 286 | customLeaf :: Tag -- ^ Element tag 287 | -> Bool -- ^ Close the leaf? 288 | -> Markup -- ^ Resulting markup 289 | customLeaf tag close = CustomLeaf (Static $ unTag tag) close () 290 | 291 | -- | Create an HTML attribute that can be applied to an HTML element later using 292 | -- the '!' operator. 293 | -- 294 | attribute :: Tag -- ^ Raw key 295 | -> Tag -- ^ Shared key string for the HTML attribute. 296 | -> AttributeValue -- ^ Value for the HTML attribute. 297 | -> Attribute -- ^ Resulting HTML attribute. 298 | attribute rawKey key value = Attribute $ 299 | AddAttribute (unTag rawKey) (unTag key) (unAttributeValue value) 300 | {-# INLINE attribute #-} 301 | 302 | -- | From HTML 5 onwards, the user is able to specify custom data attributes. 303 | -- 304 | -- An example: 305 | -- 306 | -- >

Hello.

307 | -- 308 | -- We support this in BlazeMarkup using this function. The above fragment could 309 | -- be described using BlazeMarkup with: 310 | -- 311 | -- > p ! dataAttribute "foo" "bar" $ "Hello." 312 | -- 313 | dataAttribute :: Tag -- ^ Name of the attribute. 314 | -> AttributeValue -- ^ Value for the attribute. 315 | -> Attribute -- ^ Resulting HTML attribute. 316 | dataAttribute tag value = Attribute $ AddCustomAttribute 317 | (Static "data-" `mappend` Static (unTag tag)) 318 | (unAttributeValue value) 319 | {-# INLINE dataAttribute #-} 320 | 321 | -- | Create a custom attribute. This is not specified in the HTML spec, but some 322 | -- JavaScript libraries rely on it. 323 | -- 324 | -- An example: 325 | -- 326 | -- > 327 | -- 328 | -- Can be produced using: 329 | -- 330 | -- > select ! customAttribute "dojoType" "select" $ "foo" 331 | -- 332 | customAttribute :: Tag -- ^ Name of the attribute 333 | -> AttributeValue -- ^ Value for the attribute 334 | -> Attribute -- ^ Resulting HTML attribtue 335 | customAttribute tag value = Attribute $ AddCustomAttribute 336 | (Static $ unTag tag) 337 | (unAttributeValue value) 338 | {-# INLINE customAttribute #-} 339 | 340 | -- | Render text. Functions like these can be used to supply content in HTML. 341 | -- 342 | text :: Text -- ^ Text to render. 343 | -> Markup -- ^ Resulting HTML fragment. 344 | text = content . Text 345 | {-# INLINE text #-} 346 | 347 | -- | Render text without escaping. 348 | -- 349 | preEscapedText :: Text -- ^ Text to insert 350 | -> Markup -- ^ Resulting HTML fragment 351 | preEscapedText = content . PreEscaped . Text 352 | {-# INLINE preEscapedText #-} 353 | 354 | -- | A variant of 'text' for lazy 'LT.Text'. 355 | -- 356 | lazyText :: LT.Text -- ^ Text to insert 357 | -> Markup -- ^ Resulting HTML fragment 358 | lazyText = mconcat . map text . LT.toChunks 359 | {-# INLINE lazyText #-} 360 | 361 | -- | A variant of 'preEscapedText' for lazy 'LT.Text' 362 | -- 363 | preEscapedLazyText :: LT.Text -- ^ Text to insert 364 | -> Markup -- ^ Resulting HTML fragment 365 | preEscapedLazyText = mconcat . map preEscapedText . LT.toChunks 366 | {-# INLINE preEscapedLazyText #-} 367 | 368 | -- | A variant of 'text' for text 'LTB.Builder'. 369 | -- 370 | textBuilder :: LTB.Builder -- ^ Text to insert 371 | -> Markup -- ^ Resulting HTML fragment 372 | textBuilder = lazyText . LTB.toLazyText 373 | {-# INLINE textBuilder #-} 374 | 375 | -- | A variant of 'preEscapedText' for lazy 'LT.Text' 376 | -- 377 | preEscapedTextBuilder :: LTB.Builder -- ^ Text to insert 378 | -> Markup -- ^ Resulting HTML fragment 379 | preEscapedTextBuilder = preEscapedLazyText . LTB.toLazyText 380 | {-# INLINE preEscapedTextBuilder #-} 381 | 382 | content :: ChoiceString -> Markup 383 | content cs = Content cs () 384 | {-# INLINE content #-} 385 | 386 | -- | Create an HTML snippet from a 'String'. 387 | -- 388 | string :: String -- ^ String to insert. 389 | -> Markup -- ^ Resulting HTML fragment. 390 | string = content . String 391 | {-# INLINE string #-} 392 | 393 | -- | Create an HTML snippet from a 'String' without escaping 394 | -- 395 | preEscapedString :: String -- ^ String to insert. 396 | -> Markup -- ^ Resulting HTML fragment. 397 | preEscapedString = content . PreEscaped . String 398 | {-# INLINE preEscapedString #-} 399 | 400 | -- | Insert a 'ByteString'. This is an unsafe operation: 401 | -- 402 | -- * The 'ByteString' could have the wrong encoding. 403 | -- 404 | -- * The 'ByteString' might contain illegal HTML characters (no escaping is 405 | -- done). 406 | -- 407 | unsafeByteString :: ByteString -- ^ Value to insert. 408 | -> Markup -- ^ Resulting HTML fragment. 409 | unsafeByteString = content . ByteString 410 | {-# INLINE unsafeByteString #-} 411 | 412 | -- | Insert a lazy 'BL.ByteString'. See 'unsafeByteString' for reasons why this 413 | -- is an unsafe operation. 414 | -- 415 | unsafeLazyByteString :: BL.ByteString -- ^ Value to insert 416 | -> Markup -- ^ Resulting HTML fragment 417 | unsafeLazyByteString = mconcat . map unsafeByteString . BL.toChunks 418 | {-# INLINE unsafeLazyByteString #-} 419 | 420 | comment :: ChoiceString -> Markup 421 | comment cs = Comment cs () 422 | {-# INLINE comment #-} 423 | 424 | -- | Create a comment from a 'Text' value. 425 | -- The text should not contain @"--"@. 426 | -- This is not checked by the library. 427 | textComment :: Text -> Markup 428 | textComment = comment . PreEscaped . Text 429 | 430 | -- | Create a comment from a 'LT.Text' value. 431 | -- The text should not contain @"--"@. 432 | -- This is not checked by the library. 433 | lazyTextComment :: LT.Text -> Markup 434 | lazyTextComment = comment . mconcat . map (PreEscaped . Text) . LT.toChunks 435 | 436 | -- | Create a comment from a 'String' value. 437 | -- The text should not contain @"--"@. 438 | -- This is not checked by the library. 439 | stringComment :: String -> Markup 440 | stringComment = comment . PreEscaped . String 441 | 442 | -- | Create a comment from a 'ByteString' value. 443 | -- The text should not contain @"--"@. 444 | -- This is not checked by the library. 445 | unsafeByteStringComment :: ByteString -> Markup 446 | unsafeByteStringComment = comment . PreEscaped . ByteString 447 | 448 | -- | Create a comment from a 'BL.ByteString' value. 449 | -- The text should not contain @"--"@. 450 | -- This is not checked by the library. 451 | unsafeLazyByteStringComment :: BL.ByteString -> Markup 452 | unsafeLazyByteStringComment = 453 | comment . mconcat . map (PreEscaped . ByteString) . BL.toChunks 454 | 455 | -- | Create a 'Tag' from some 'Text'. 456 | -- 457 | textTag :: Text -- ^ Text to create a tag from 458 | -> Tag -- ^ Resulting tag 459 | textTag t = Tag $ StaticString (T.unpack t ++) (T.encodeUtf8 t) t 460 | 461 | -- | Create a 'Tag' from a 'String'. 462 | -- 463 | stringTag :: String -- ^ String to create a tag from 464 | -> Tag -- ^ Resulting tag 465 | stringTag = Tag . fromString 466 | 467 | -- | Render an attribute value from 'Text'. 468 | -- 469 | textValue :: Text -- ^ The actual value. 470 | -> AttributeValue -- ^ Resulting attribute value. 471 | textValue = AttributeValue . Text 472 | {-# INLINE textValue #-} 473 | 474 | -- | Render an attribute value from 'Text' without escaping. 475 | -- 476 | preEscapedTextValue :: Text -- ^ The actual value 477 | -> AttributeValue -- ^ Resulting attribute value 478 | preEscapedTextValue = AttributeValue . PreEscaped . Text 479 | {-# INLINE preEscapedTextValue #-} 480 | 481 | -- | A variant of 'textValue' for lazy 'LT.Text' 482 | -- 483 | lazyTextValue :: LT.Text -- ^ The actual value 484 | -> AttributeValue -- ^ Resulting attribute value 485 | lazyTextValue = mconcat . map textValue . LT.toChunks 486 | {-# INLINE lazyTextValue #-} 487 | 488 | -- | A variant of 'preEscapedTextValue' for lazy 'LT.Text' 489 | -- 490 | preEscapedLazyTextValue :: LT.Text -- ^ The actual value 491 | -> AttributeValue -- ^ Resulting attribute value 492 | preEscapedLazyTextValue = mconcat . map preEscapedTextValue . LT.toChunks 493 | {-# INLINE preEscapedLazyTextValue #-} 494 | 495 | -- | A variant of 'textValue' for text 'LTB.Builder' 496 | -- 497 | textBuilderValue :: LTB.Builder -- ^ The actual value 498 | -> AttributeValue -- ^ Resulting attribute value 499 | textBuilderValue = lazyTextValue . LTB.toLazyText 500 | {-# INLINE textBuilderValue #-} 501 | 502 | -- | A variant of 'preEscapedTextValue' for text 'LTB.Builder' 503 | -- 504 | preEscapedTextBuilderValue :: LTB.Builder -- ^ The actual value 505 | -> AttributeValue -- ^ Resulting attribute value 506 | preEscapedTextBuilderValue = preEscapedLazyTextValue . LTB.toLazyText 507 | {-# INLINE preEscapedTextBuilderValue #-} 508 | 509 | -- | Create an attribute value from a 'String'. 510 | -- 511 | stringValue :: String -> AttributeValue 512 | stringValue = AttributeValue . String 513 | {-# INLINE stringValue #-} 514 | 515 | -- | Create an attribute value from a 'String' without escaping. 516 | -- 517 | preEscapedStringValue :: String -> AttributeValue 518 | preEscapedStringValue = AttributeValue . PreEscaped . String 519 | {-# INLINE preEscapedStringValue #-} 520 | 521 | -- | Create an attribute value from a 'ByteString'. See 'unsafeByteString' 522 | -- for reasons why this might not be a good idea. 523 | -- 524 | unsafeByteStringValue :: ByteString -- ^ ByteString value 525 | -> AttributeValue -- ^ Resulting attribute value 526 | unsafeByteStringValue = AttributeValue . ByteString 527 | {-# INLINE unsafeByteStringValue #-} 528 | 529 | -- | Create an attribute value from a lazy 'BL.ByteString'. See 530 | -- 'unsafeByteString' for reasons why this might not be a good idea. 531 | -- 532 | unsafeLazyByteStringValue :: BL.ByteString -- ^ ByteString value 533 | -> AttributeValue -- ^ Resulting attribute value 534 | unsafeLazyByteStringValue = mconcat . map unsafeByteStringValue . BL.toChunks 535 | {-# INLINE unsafeLazyByteStringValue #-} 536 | 537 | -- | Used for applying attributes. You should not define your own instances of 538 | -- this class. 539 | class Attributable h where 540 | -- | Apply an attribute to an element. 541 | -- 542 | -- Example: 543 | -- 544 | -- > img ! src "foo.png" 545 | -- 546 | -- Result: 547 | -- 548 | -- > 549 | -- 550 | -- This can be used on nested elements as well. 551 | -- 552 | -- Example: 553 | -- 554 | -- > p ! style "float: right" $ "Hello!" 555 | -- 556 | -- Result: 557 | -- 558 | -- >

Hello!

559 | -- 560 | (!) :: h -> Attribute -> h 561 | 562 | instance Attributable (MarkupM a) where 563 | h ! (Attribute f) = f h 564 | {-# INLINE (!) #-} 565 | 566 | instance Attributable (MarkupM a -> MarkupM b) where 567 | h ! f = (! f) . h 568 | {-# INLINE (!) #-} 569 | 570 | -- | Shorthand for setting an attribute depending on a conditional. 571 | -- 572 | -- Example: 573 | -- 574 | -- > p !? (isBig, A.class "big") $ "Hello" 575 | -- 576 | -- Gives the same result as: 577 | -- 578 | -- > (if isBig then p ! A.class "big" else p) "Hello" 579 | -- 580 | (!?) :: Attributable h => h -> (Bool, Attribute) -> h 581 | (!?) h (c, a) = if c then h ! a else h 582 | 583 | -- | Mark HTML as external data. External data can be: 584 | -- 585 | -- * CSS data in a @