diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,25 @@ +## 0.0.20260427 + +* Support GHC 9.14 + +## 0.0.20250303 + +* Support GHC 9.12 + +## 0.0.20240424 + +* Add `dialog_` element. + +## 0.0.20230706 + +* Inline the `blaze-builder` modules in-use into the package, to drop + dependency on + `blaze-builder`. + +## 0.0.20221012 + +* Fix `commuteHtmlT` in favor of newly added `commuteHtmlT2` + ## 0.0.20220526 This release adds some extra functions for running different monad diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,6 @@ -Copyright (c) 2014, Chris Done +Copyright (c) 2014-2022 Chris Done +Copyright (c) 2013 Leon P Smith +Copyright (c) 2010 Jasper Van der Jeugt, 2010-2011 Simon Meier All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -149,3 +149,9 @@ ``` html "

Chris

" ``` + +## Copyright + +* Copyright (c) 2014-2022 Chris Done +* Copyright (c) 2013 Leon P Smith +* Copyright (c) 2010 Jasper Van der Jeugt, 2010-2011 Simon Meier diff --git a/lucid2.cabal b/lucid2.cabal --- a/lucid2.cabal +++ b/lucid2.cabal @@ -1,5 +1,5 @@ name: lucid2 -version: 0.0.20220526 +version: 0.0.20260427 synopsis: Clear to write, read and edit DSL for HTML description: Clear to write, read and edit DSL for HTML. @@ -32,16 +32,19 @@ Lucid.Base Lucid.Html5 + -- These have been inlined from the blaze-builder package, so that + -- all dependencies are GHC boot libraries. + other-modules: Blaze.ByteString.Builder.Char.Utf8 + Blaze.ByteString.Builder.Html.Utf8 + Blaze.ByteString.Builder.Html.Word + -- GHC boot libraries - build-depends: base >= 4.8 && < 4.17 + build-depends: base >= 4.8 && < 5 , bytestring >= 0.10.12.0 , containers >= 0.6.5.1 , transformers >= 0.5.6.2 , mtl >= 2.2.2 , text >= 1.2.4.1 - - -- other dependencies - build-depends: blaze-builder source-repository head type: git diff --git a/src/Blaze/ByteString/Builder/Char/Utf8.hs b/src/Blaze/ByteString/Builder/Char/Utf8.hs new file mode 100644 --- /dev/null +++ b/src/Blaze/ByteString/Builder/Char/Utf8.hs @@ -0,0 +1,58 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Blaze.ByteString.Builder.Char.Utf8 +-- Copyright: (c) 2013 Leon P Smith +-- License: BSD3 +-- Maintainer: https://github.com/blaze-builder +-- Stability: stable +-- +-- 'Write's and 'Builder's for serializing Unicode characters using the UTF-8 +-- encoding. +-- +------------------------------------------------------------------------------ + +module Blaze.ByteString.Builder.Char.Utf8 + ( + -- * Creating Builders from UTF-8 encoded characters + fromChar + , fromString + , fromShow + , fromText + , fromLazyText + ) where + +import Data.ByteString.Builder ( Builder ) +import qualified Data.ByteString.Builder as B +import qualified Data.Text as TS +import qualified Data.Text.Lazy as TL + +-- | /O(1)/. Serialize a Unicode character using the UTF-8 encoding. +-- +fromChar :: Char -> Builder +fromChar = B.charUtf8 +{-# INLINE fromChar #-} + +-- | /O(n)/. Serialize a Unicode 'String' using the UTF-8 encoding. +-- +fromString :: String -> Builder +fromString = B.stringUtf8 +{-# INLINE fromString #-} + +-- | /O(n)/. Serialize a value by 'Show'ing it and UTF-8 encoding the resulting +-- 'String'. +-- +fromShow :: Show a => a -> Builder +fromShow = fromString . show +{-# INLINE fromShow #-} + +-- | /O(n)/. Serialize a strict Unicode 'TS.Text' value using the UTF-8 encoding. +-- +fromText :: TS.Text -> Builder +fromText = fromString . TS.unpack +{-# INLINE fromText #-} + +-- | /O(n)/. Serialize a lazy Unicode 'TL.Text' value using the UTF-8 encoding. +-- +fromLazyText :: TL.Text -> Builder +fromLazyText = fromString . TL.unpack +{-# INLINE fromLazyText #-} diff --git a/src/Blaze/ByteString/Builder/Html/Utf8.hs b/src/Blaze/ByteString/Builder/Html/Utf8.hs new file mode 100644 --- /dev/null +++ b/src/Blaze/ByteString/Builder/Html/Utf8.hs @@ -0,0 +1,110 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 704 +{-# OPTIONS_GHC -fsimpl-tick-factor=40000 #-} +#endif + +------------------------------------------------------------------------------ +-- | +-- Module: Blaze.ByteString.Builder.Html.Utf8 +-- Copyright: (c) 2013 Leon P Smith +-- License: BSD3 +-- Maintainer: https://github.com/blaze-builder +-- Stability: stable +-- +-- 'Write's and 'Builder's for serializing HTML escaped and UTF-8 encoded +-- characters. +-- +-- This module is used by both the 'blaze-html' and the \'hamlet\' HTML +-- templating libraries. If the 'Builder' from 'blaze-builder' replaces the +-- 'Data.Binary.Builder' implementation, this module will most likely keep its +-- place, as it provides a set of very specialized functions. +-- +------------------------------------------------------------------------------ + +module Blaze.ByteString.Builder.Html.Utf8 + ( + module Blaze.ByteString.Builder.Char.Utf8 + + -- * Creating Builders from HTML escaped and UTF-8 encoded characters + , fromHtmlEscapedChar + , fromHtmlEscapedString + , fromHtmlEscapedShow + , fromHtmlEscapedText + , fromHtmlEscapedLazyText + ) where + +import Data.ByteString.Char8 () -- for the 'IsString' instance of bytesrings + +import qualified Data.Text as TS +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Lazy as TL +import qualified Data.Text.Lazy.Encoding as TLE + +import qualified Data.ByteString.Builder as B +import Data.ByteString.Builder.Prim ((>*<), (>$<), condB) +import qualified Data.ByteString.Builder.Prim as P + +import Blaze.ByteString.Builder.Char.Utf8 +import Blaze.ByteString.Builder.Html.Word + +-- | /O(1)./ Serialize a HTML escaped Unicode character using the UTF-8 +-- encoding. +fromHtmlEscapedChar :: Char -> B.Builder +fromHtmlEscapedChar = P.primBounded charUtf8HtmlEscaped +{-# INLINE fromHtmlEscapedChar #-} + +{-# INLINE charUtf8HtmlEscaped #-} +charUtf8HtmlEscaped :: P.BoundedPrim Char +charUtf8HtmlEscaped = + condB (> '>' ) (condB (== '\DEL') P.emptyB P.charUtf8) $ + condB (== '<' ) (fixed4 ('&',('l',('t',';')))) $ -- < + condB (== '>' ) (fixed4 ('&',('g',('t',';')))) $ -- > + condB (== '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $ -- & + condB (== '"' ) (fixed6 ('&',('q',('u',('o',('t',';')))))) $ -- &#quot; + condB (== '\'') (fixed5 ('&',('#',('3',('9',';'))))) $ -- ' + condB (\c -> c >= ' ' || c == '\t' || c == '\n' || c == '\r') + (P.liftFixedToBounded P.char7) $ + P.emptyB + where + {-# INLINE fixed4 #-} + fixed4 x = P.liftFixedToBounded $ const x >$< + P.char7 >*< P.char7 >*< P.char7 >*< P.char7 + + {-# INLINE fixed5 #-} + fixed5 x = P.liftFixedToBounded $ const x >$< + P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7 + + {-# INLINE fixed6 #-} + fixed6 x = P.liftFixedToBounded $ const x >$< + P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7 >*< P.char7 + +-- | /O(n)/. Serialize a HTML escaped Unicode 'String' using the UTF-8 +-- encoding. +-- +fromHtmlEscapedString :: String -> B.Builder +fromHtmlEscapedString = P.primMapListBounded charUtf8HtmlEscaped + +-- | /O(n)/. Serialize a value by 'Show'ing it and then, HTML escaping and +-- UTF-8 encoding the resulting 'String'. +-- +fromHtmlEscapedShow :: Show a => a -> B.Builder +fromHtmlEscapedShow = fromHtmlEscapedString . show + +-- | /O(n)/. Serialize a HTML escaped strict Unicode 'TS.Text' value using the +-- UTF-8 encoding. +-- +fromHtmlEscapedText :: TS.Text -> B.Builder +#if MIN_VERSION_text(1,1,2) && MIN_VERSION_bytestring(0,10,4) +fromHtmlEscapedText = TE.encodeUtf8BuilderEscaped wordHtmlEscaped +#else +fromHtmlEscapedText = fromHtmlEscapedString . TS.unpack +#endif + +-- | /O(n)/. Serialize a HTML escaped Unicode 'TL.Text' using the UTF-8 encoding. +-- +fromHtmlEscapedLazyText :: TL.Text -> B.Builder +#if MIN_VERSION_text(1,1,2) && MIN_VERSION_bytestring(0,10,4) +fromHtmlEscapedLazyText = TLE.encodeUtf8BuilderEscaped wordHtmlEscaped +#else +fromHtmlEscapedLazyText = fromHtmlEscapedString . TL.unpack +#endif diff --git a/src/Blaze/ByteString/Builder/Html/Word.hs b/src/Blaze/ByteString/Builder/Html/Word.hs new file mode 100644 --- /dev/null +++ b/src/Blaze/ByteString/Builder/Html/Word.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ >= 704 +{-# OPTIONS_GHC -fsimpl-tick-factor=40000 #-} +#endif + +------------------------------------------------------------------------------ +-- | +-- Module: Blaze.ByteString.Builder.Html.Word +-- Copyright: (c) 2016 Dylan Simon +-- License: BSD3 +-- Maintainer: https://github.com/blaze-builder +-- Stability: stable +-- +-- 'W.Write's and 'B.Builder's for serializing HTML escaped 'Word8' characters +-- and 'BS.ByteString's that have already been appropriately encoded into HTML by +-- escaping basic ASCII character references but leaving other bytes untouched. +-- +------------------------------------------------------------------------------ + +module Blaze.ByteString.Builder.Html.Word + ( wordHtmlEscaped + -- * Creating Builders from HTML escaped bytes + , fromHtmlEscapedWord + , fromHtmlEscapedWordList + , fromHtmlEscapedByteString + , fromHtmlEscapedLazyByteString + ) where + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Builder.Prim as P +import Data.ByteString.Internal (c2w) +import qualified Data.ByteString.Lazy as BSL +import Data.Word (Word8) + +{-# INLINE wordHtmlEscaped #-} +wordHtmlEscaped :: P.BoundedPrim Word8 +wordHtmlEscaped = + P.condB (> c2w '>' ) (P.condB (== c2w '\DEL') P.emptyB $ P.liftFixedToBounded P.word8) $ + P.condB (== c2w '<' ) (fixed4 ('&',('l',('t',';')))) $ -- < + P.condB (== c2w '>' ) (fixed4 ('&',('g',('t',';')))) $ -- > + P.condB (== c2w '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $ -- & + P.condB (== c2w '"' ) (fixed6 ('&',('q',('u',('o',('t',';')))))) $ -- " + P.condB (== c2w '\'') (fixed5 ('&',('#',('3',('9',';'))))) $ -- ' + P.condB (\c -> c >= c2w ' ' || c == c2w '\t' || c == c2w '\n' || c == c2w '\r') + (P.liftFixedToBounded P.word8) P.emptyB + where + {-# INLINE fixed4 #-} + fixed4 x = P.liftFixedToBounded $ const x P.>$< + P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 + {-# INLINE fixed5 #-} + fixed5 x = P.liftFixedToBounded $ const x P.>$< + P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 + {-# INLINE fixed6 #-} + fixed6 x = P.liftFixedToBounded $ const x P.>$< + P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 P.>*< P.char8 + +-- | /O(1)./ Serialize a HTML escaped byte. +fromHtmlEscapedWord :: Word8 -> B.Builder +fromHtmlEscapedWord = P.primBounded wordHtmlEscaped + +-- | /O(n)/. Serialize a HTML escaped list of bytes. +fromHtmlEscapedWordList :: [Word8] -> B.Builder +fromHtmlEscapedWordList = P.primMapListBounded wordHtmlEscaped + +-- | /O(n)/. Serialize a HTML escaped 'BS.ByteString'. +fromHtmlEscapedByteString :: BS.ByteString -> B.Builder +fromHtmlEscapedByteString = P.primMapByteStringBounded wordHtmlEscaped + +-- | /O(n)/. Serialize a HTML escaped lazy 'BSL.ByteString'. +fromHtmlEscapedLazyByteString :: BSL.ByteString -> B.Builder +fromHtmlEscapedLazyByteString = P.primMapLazyByteStringBounded wordHtmlEscaped diff --git a/src/Lucid/Base.hs b/src/Lucid/Base.hs --- a/src/Lucid/Base.hs +++ b/src/Lucid/Base.hs @@ -4,8 +4,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeOperators #-} + -- Search for UndecidableInstances to see why this is needed {-# LANGUAGE UndecidableInstances #-} @@ -23,7 +25,7 @@ ,evalHtmlT ,runHtmlT ,generalizeHtmlT - ,commuteHtmlT + ,commuteHtmlT2 ,hoistHtmlT -- * Combinators ,makeElement @@ -41,11 +43,12 @@ -- * Deprecated ,relaxHtmlT + ,commuteHtmlT ) where -import Blaze.ByteString.Builder (Builder) -import qualified Blaze.ByteString.Builder as Blaze +import Data.ByteString.Builder (Builder) +import qualified Data.ByteString.Builder as Blaze import qualified Blaze.ByteString.Builder.Html.Utf8 as Blaze import Control.Applicative import Control.Monad @@ -122,7 +125,9 @@ -- | Monoid is right-associative, a la the 'Builder' in it. instance (a ~ (),Monad m) => Monoid (HtmlT m a) where mempty = pure mempty +#if !MIN_VERSION_base(4,11,0) mappend = liftA2 mappend +#endif -- | If you want to use IO in your HTML generation. instance MonadIO m => MonadIO (HtmlT m) where @@ -168,7 +173,7 @@ -- @since 2.9.5 instance ToHtml S.ByteString where toHtml = write . Blaze.fromHtmlEscapedText . T.decodeUtf8 - toHtmlRaw = write . Blaze.fromByteString + toHtmlRaw = write . Blaze.byteString -- | This instance requires the ByteString to contain UTF-8 encoded -- text, for the 'toHtml' method. The 'toHtmlRaw' method doesn't care, @@ -177,7 +182,7 @@ -- @since 2.9.5 instance ToHtml L.ByteString where toHtml = write . Blaze.fromHtmlEscapedLazyText . LT.decodeUtf8 - toHtmlRaw = write . Blaze.fromLazyByteString + toHtmlRaw = write . Blaze.lazyByteString -- | Used to construct HTML terms. -- @@ -337,12 +342,12 @@ -- exampleHtml' = evalState (commuteHtmlT exampleHtml) 1 -- @ -- -commuteHtmlT :: (Monad m, Monad n) +commuteHtmlT2 :: (Monad m, Monad n) => HtmlT m a -- ^ unpurely generated HTML -> m (HtmlT n a) -- ^ Commuted monads. /Note:/ @n@ can be 'Identity' -commuteHtmlT h = do +commuteHtmlT2 h = do (builder, a) <- runHtmlT h - return . HtmlT $ put builder >> return a + return . HtmlT $ modify' (<> builder) >> return a -- | Evaluate the HTML to its return value. Analogous to @evalState@. -- @@ -453,3 +458,11 @@ relaxHtmlT :: Monad m => HtmlT Identity a -> HtmlT m a relaxHtmlT = undefined {-# DEPRECATED relaxHtmlT "DO NOT USE. This was exported accidentally and throws an exception." #-} + +commuteHtmlT :: (Monad m, Monad n) + => HtmlT m a -- ^ unpurely generated HTML + -> m (HtmlT n a) -- ^ Commuted monads. /Note:/ @n@ can be 'Identity' +commuteHtmlT h = do + (builder, a) <- runHtmlT h + return . HtmlT $ put builder >> return a +{-# DEPRECATED commuteHtmlT "This has incorrect behavior and will lose HTML output. See commuteHtmlT2." #-} diff --git a/src/Lucid/Html5.hs b/src/Lucid/Html5.hs --- a/src/Lucid/Html5.hs +++ b/src/Lucid/Html5.hs @@ -130,6 +130,10 @@ dfn_ :: Term arg result => arg -> result dfn_ = term "dfn" +-- | @dialog@ element +dialog_ :: Term arg result => arg -> result +dialog_ = term "dialog" + -- | @div@ element div_ :: Term arg result => arg -> result div_ = term "div" diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -30,6 +30,7 @@ describe "attributes" testAttributes describe "special-elements" testSpecials describe "self-closing" testSelfClosing + describe "commute" testCommute (==?*) :: (Eq a, Show a) => a -> [a] -> Assertion x ==?* xs | x `elem` xs = return () @@ -154,3 +155,12 @@ it "input" (renderText (input_ [type_ "text"]) `shouldBe` "") + +testCommute :: Spec +testCommute = do + it "commutes" $ do + let stateAction :: HtmlT (Control.Monad.State.Strict.State [Integer]) () + stateAction = div_ [class_ "inside"] $ pure () + (fragment, _s) = runState (commuteHtmlT2 stateAction) [0] + renderText (div_ [class_ "outside"] fragment) `shouldBe` + "
"