Hello community, here is the log from the commit of package ghc-lucid for openSUSE:Factory checked in at 2017-04-14 13:38:16 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-lucid (Old) and /work/SRC/openSUSE:Factory/.ghc-lucid.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-lucid" Fri Apr 14 13:38:16 2017 rev:4 rq:485139 version:2.9.8.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-lucid/ghc-lucid.changes 2016-12-06 14:25:10.000000000 +0100 +++ /work/SRC/openSUSE:Factory/.ghc-lucid.new/ghc-lucid.changes 2017-04-14 13:38:18.918352331 +0200 @@ -1,0 +2,5 @@ +Tue Mar 7 11:19:20 UTC 2017 - psimons@suse.com + +- Update to version 2.9.8.1 with cabal2obs. + +------------------------------------------------------------------- Old: ---- lucid-2.9.7.tar.gz New: ---- lucid-2.9.8.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-lucid.spec ++++++ --- /var/tmp/diff_new_pack.A7D1l7/_old 2017-04-14 13:38:19.670246066 +0200 +++ /var/tmp/diff_new_pack.A7D1l7/_new 2017-04-14 13:38:19.674245501 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-lucid # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -19,7 +19,7 @@ %global pkg_name lucid %bcond_with tests Name: ghc-%{pkg_name} -Version: 2.9.7 +Version: 2.9.8.1 Release: 0 Summary: Clear to write, read and edit DSL for HTML License: BSD-3-Clause ++++++ lucid-2.9.7.tar.gz -> lucid-2.9.8.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lucid-2.9.7/CHANGELOG.md new/lucid-2.9.8.1/CHANGELOG.md --- old/lucid-2.9.7/CHANGELOG.md 2016-11-10 10:16:28.000000000 +0100 +++ new/lucid-2.9.8.1/CHANGELOG.md 2017-03-04 13:57:32.000000000 +0100 @@ -1,3 +1,13 @@ +## 2.9.8.1 + +* Improve performance by adding `INLINE` pragmas to `Monad` etc. combinators. + +## 2.9.8 + +* Add `integrity_`, `crossorigin_` attributes +* Add `classes_` smart attribute constructor +* Add `ToHtml (HtmlT m a)` instance + ## 2.9.6 * Fix compilation of benchmarks diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lucid-2.9.7/benchmarks/IO.hs new/lucid-2.9.8.1/benchmarks/IO.hs --- old/lucid-2.9.7/benchmarks/IO.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/lucid-2.9.8.1/benchmarks/IO.hs 2017-03-04 13:57:32.000000000 +0100 @@ -0,0 +1,24 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Lucid +import Criterion.Main +import Control.Monad (replicateM_) +import qualified Data.Text.Lazy as LT +import Control.Monad.Trans.Reader (runReader) +import Data.Functor.Identity (runIdentity) + +lotsOfDivs :: Monad m => Int -> HtmlT m () +lotsOfDivs n = body_ + $ replicateM_ n + $ div_ "hello world!" + +main :: IO () +main = defaultMain + [ bench "renderText" $ nf (renderText . lotsOfDivs) size + , bench "renderTextT Identity" $ nf (runIdentity . renderTextT . lotsOfDivs) size + , bench "renderTextT Reader" $ nf (\(r, s) -> flip runReader r . renderTextT . lotsOfDivs $ s) ((), size) + , bench "renderTextT IO" $ nfIO (renderTextT (lotsOfDivs size) :: IO LT.Text) + ] + where + size = 10000 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lucid-2.9.7/lucid.cabal new/lucid-2.9.8.1/lucid.cabal --- old/lucid-2.9.7/lucid.cabal 2016-11-10 10:29:17.000000000 +0100 +++ new/lucid-2.9.8.1/lucid.cabal 2017-03-04 13:57:32.000000000 +0100 @@ -1,5 +1,5 @@ name: lucid -version: 2.9.7 +version: 2.9.8.1 synopsis: Clear to write, read and edit DSL for HTML description: Clear to write, read and edit DSL for HTML. See the 'Lucid' module for description and documentation. @@ -7,8 +7,8 @@ license: BSD3 license-file: LICENSE author: Chris Done -maintainer: chrisdone@gmail.com -copyright: 2014 Chris Done +maintainer: chrisdone@gmail.com, oleg.grenrus@iki.fi +copyright: 2014-2017 Chris Done category: Web build-type: Simple cabal-version: >=1.8 @@ -62,3 +62,14 @@ bytestring, lucid ghc-options: -O2 + +benchmark bench-io + type: exitcode-stdio-1.0 + hs-source-dirs: benchmarks + main-is: IO.hs + build-depends: base, + criterion, + transformers, + text, + lucid + ghc-options: -O2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lucid-2.9.7/src/Lucid/Base.hs new/lucid-2.9.8.1/src/Lucid/Base.hs --- old/lucid-2.9.7/src/Lucid/Base.hs 2016-11-10 10:16:28.000000000 +0100 +++ new/lucid-2.9.8.1/src/Lucid/Base.hs 2017-03-04 13:57:32.000000000 +0100 @@ -111,20 +111,47 @@ -- | Based on the monad instance. instance Monad m => Applicative (HtmlT m) where - pure = return - (<*>) = ap + pure a = HtmlT (return (mempty,a)) + {-# INLINE pure #-} + + f <*> x = HtmlT $ do + ~(g, f') <- runHtmlT f + ~(h, x') <- runHtmlT x + return (g <> h, f' x') + {-# INLINE (<*>) #-} + + m *> n = HtmlT $ do + ~(g, _) <- runHtmlT m + ~(h, b) <- runHtmlT n + return (g <> h, b) + {-# INLINE (*>) #-} + + m <* n = HtmlT $ do + ~(g, a) <- runHtmlT m + ~(h, _) <- runHtmlT n + return (g <> h, a) + {-# INLINE (<*) #-} -- | Just re-uses Monad. instance Monad m => Functor (HtmlT m) where fmap = liftM + (<$) = fmap . const + {-# INLINE (<$) #-} + -- | Basically acts like Writer. instance Monad m => Monad (HtmlT m) where - return a = HtmlT (return (mempty,a)) - m >>= f = - HtmlT (do ~(g,a) <- runHtmlT m - ~(h,b) <- runHtmlT (f a) - return (g <> h,b)) + return = pure + {-# INLINE return #-} + + m >>= f = HtmlT $ do + ~(g,a) <- runHtmlT m + ~(h,b) <- runHtmlT (f a) + return (g <> h,b) + {-# INLINE (>>=) #-} + + (>>) = (*>) + {-# INLINE (>>) #-} -- | Used for 'lift'. instance MonadTrans HtmlT where @@ -162,6 +189,10 @@ toHtml :: Monad m => a -> HtmlT m () toHtmlRaw :: Monad m => a -> HtmlT m () +instance (a ~ (), m ~ Identity) => ToHtml (HtmlT m a) where + toHtml = relaxHtmlT + toHtmlRaw = relaxHtmlT + instance ToHtml String where toHtml = build . Blaze.fromHtmlEscapedString toHtmlRaw = build . Blaze.fromString @@ -217,6 +248,8 @@ -> arg -- ^ Either an attribute list or children. -> result -- ^ Result: either an element or an attribute. term = flip termWith [] + {-# INLINE term #-} + -- | Use this if you want to make an element which inserts some -- pre-prepared attributes into the element. termWith :: Text -- ^ Name. @@ -232,6 +265,7 @@ -- attributes. instance (Monad m) => Term (HtmlT m a) (HtmlT m a) where termWith name f = with (makeElement name) f + {-# INLINE termWith #-} -- | Some terms (like 'Lucid.Html5.style_', 'Lucid.Html5.title_') can be used for -- attributes as well as elements. @@ -409,6 +443,7 @@ => Text -- ^ Name. -> HtmlT m a -- ^ Children HTML. -> HtmlT m a -- ^ A parent element. +{-# INLINE[1] makeElement #-} makeElement name = \m' -> HtmlT (do ~(f,a) <- runHtmlT m' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/lucid-2.9.7/src/Lucid/Html5.hs new/lucid-2.9.8.1/src/Lucid/Html5.hs --- old/lucid-2.9.7/src/Lucid/Html5.hs 2016-11-10 10:16:28.000000000 +0100 +++ new/lucid-2.9.8.1/src/Lucid/Html5.hs 2017-03-04 13:57:32.000000000 +0100 @@ -9,7 +9,10 @@ import Lucid.Base import Data.Monoid -import Data.Text (Text) +import Data.Text (Text, unwords) + +------------------------------------------------------------------------------- +-- Elements -- | @DOCTYPE@ element doctype_ :: Monad m => HtmlT m () @@ -457,6 +460,9 @@ wbr_ :: Monad m => [Attribute] -> HtmlT m () wbr_ = with (makeElementNoEnd "wbr") +------------------------------------------------------------------------------- +-- Attributes + -- | The @accept@ attribute. accept_ :: Text -> Attribute accept_ = makeAttribute "accept" @@ -509,6 +515,9 @@ class_ :: Text -> Attribute class_ = makeAttribute "class" +classes_ :: [Text] -> Attribute +classes_ = makeAttribute "class" . Data.Text.unwords + -- | The @cols@ attribute. cols_ :: Text -> Attribute cols_ = makeAttribute "cols" @@ -537,6 +546,10 @@ coords_ :: Text -> Attribute coords_ = makeAttribute "coords" +-- | The @crossorigin@ attribute. +crossorigin_ :: Text -> Attribute +crossorigin_ = makeAttribute "crossorigin" + -- | The @data@ attribute. data_ :: Text -> Text -> Attribute data_ name = makeAttribute ("data-" <> name) @@ -629,6 +642,10 @@ id_ :: Text -> Attribute id_ = makeAttribute "id" +-- | The @integrity@ attribute. +integrity_ :: Text -> Attribute +integrity_ = makeAttribute "integrity" + -- | The @ismap@ attribute. ismap_ :: Text -> Attribute ismap_ = makeAttribute "ismap"