Hello community, here is the log from the commit of package ghc-pandoc-types for openSUSE:Factory checked in at 2018-05-30 12:11:16 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-pandoc-types (Old) and /work/SRC/openSUSE:Factory/.ghc-pandoc-types.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-pandoc-types" Wed May 30 12:11:16 2018 rev:18 rq:607851 version:1.17.4.2 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-pandoc-types/ghc-pandoc-types.changes 2017-09-15 22:03:05.929935224 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-pandoc-types.new/ghc-pandoc-types.changes 2018-05-30 12:26:39.375620583 +0200 @@ -1,0 +2,41 @@ +Mon May 14 17:02:11 UTC 2018 - [email protected] + +- Update pandoc-types to version 1.17.4.2 revision 1. + * Import Semigroups when needed rather than using CPP. + * Bump criterion upper bound. + * Add Semigroup instances for Pandoc, Meta, Inlines, Blocks + (if base >= 4.9). This is needed for the library to compile + with ghc 8.4. + * Bumped criterion upper bound. + * Bumped upper bounds for criterion and QuickCheck. + * Added Walkable instances for `[Inline] Inline` and `[Block] Block`. + * Provide default implementation for walk (Albert Krewinkel). + The implementations for `walk` and `walkM` are very similar, so a + default method is provided which implements the former in terms of the + latter. This change should not affect performance, as the `Identity` + functor, which is used in the default definition, is a newtype that + should be eliminated at compile time. (This requires a dependency + on transformers for ghc 7.8.x.) + * Force optimizations when compiling Walk module (Albert Krewinkel). + * Add `Applicative m` to the context of walkM (Albert Krewinkel). + The acceptance of AMP makes this a natural change. + * Add `Walkable [Block]` and `Walkable [Inline]` instances (Albert + Krewinkel). + * Factored out duplicate code in Walk. + * Added benchmark. + * Text.Pandoc.JSON: Use `walk` instead of `bottomUp` in the + `ToJSONFilter` instance for `a -> [a]`. Note that behavior will be + slightly different, since bottomUp's treatment of a function `[a] -> [a]` + is to apply it to each sublist of a list, while walk applies it only to + maximal sublists. Usually the latter behavior is what is wanted, and the + former can be simulated when needed. But there may be existing filters + that need to be rewritten in light of the new behavior. + * Better consistency in simpleTable and table (jgm/pandoc#3648). + If `headers` is empty, we populate it with empty cells, using the rows + to determine number of columns. We also ensure that there are numcols + alignments and column widths. + * Make sure Div and Span occur in Arbitrary instances. + * Bump dependency upper bounds. + * Removed unused mapConst. + +------------------------------------------------------------------- Old: ---- pandoc-types-1.17.0.5.tar.gz New: ---- pandoc-types-1.17.4.2.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-pandoc-types.spec ++++++ --- /var/tmp/diff_new_pack.xormqC/_old 2018-05-30 12:26:40.023598483 +0200 +++ /var/tmp/diff_new_pack.xormqC/_new 2018-05-30 12:26:40.027598347 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-pandoc-types # -# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2018 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,14 +19,14 @@ %global pkg_name pandoc-types %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.17.0.5 +Version: 1.17.4.2 Release: 0 Summary: Types for representing a structured document -License: GPL-2.0 +License: GPL-2.0-only Group: Development/Libraries/Haskell URL: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz -Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/4.cabal#/%{pkg_name}.cabal +Source1: https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/1.cabal#/%{pkg_name}.cabal BuildRequires: ghc-Cabal-devel BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-aeson-devel @@ -35,6 +35,7 @@ BuildRequires: ghc-deepseq-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-syb-devel +BuildRequires: ghc-transformers-devel %if %{with tests} BuildRequires: ghc-HUnit-devel BuildRequires: ghc-string-qq-devel @@ -93,7 +94,7 @@ %ghc_pkg_recache %files -f %{name}.files -%doc LICENSE +%license LICENSE %files devel -f %{name}-devel.files %doc changelog ++++++ pandoc-types-1.17.0.5.tar.gz -> pandoc-types-1.17.4.2.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.17.0.5/Text/Pandoc/Arbitrary.hs new/pandoc-types-1.17.4.2/Text/Pandoc/Arbitrary.hs --- old/pandoc-types-1.17.0.5/Text/Pandoc/Arbitrary.hs 2016-10-13 20:56:56.000000000 +0200 +++ new/pandoc-types-1.17.4.2/Text/Pandoc/Arbitrary.hs 2017-09-13 18:56:09.000000000 +0200 @@ -48,6 +48,9 @@ , (10, liftM Superscript $ arbInlines (n-1)) , (10, liftM Subscript $ arbInlines (n-1)) , (10, liftM SmallCaps $ arbInlines (n-1)) + , (10, do x1 <- arbAttr + x2 <- arbInlines (n-1) + return $ Span x1 x2) , (10, do x1 <- arbitrary x2 <- arbInlines (n-1) return $ Quoted x1 x2) @@ -102,6 +105,9 @@ x2 <- arbInlines (n-1) return (x2,x1) return $ DefinitionList items) + , (5, do x1 <- arbAttr + x2 <- listOf1 $ arbBlock (n-1) + return $ Div x1 x2) , (2, do rs <- choose (1 :: Int, 4) cs <- choose (1 :: Int, 4) x1 <- arbInlines (n-1) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.17.0.5/Text/Pandoc/Builder.hs new/pandoc-types-1.17.4.2/Text/Pandoc/Builder.hs --- old/pandoc-types-1.17.0.5/Text/Pandoc/Builder.hs 2016-10-17 20:27:07.000000000 +0200 +++ new/pandoc-types-1.17.4.2/Text/Pandoc/Builder.hs 2018-03-16 23:31:24.000000000 +0100 @@ -166,7 +166,6 @@ where import Text.Pandoc.Definition import Data.String -import Data.Monoid import qualified Data.Map as M import Data.Sequence (Seq, (|>), viewr, viewl, ViewR(..), ViewL(..)) import qualified Data.Sequence as Seq @@ -177,6 +176,7 @@ import Data.Data import Control.Arrow ((***)) import GHC.Generics (Generic) +import Data.Semigroup #if MIN_VERSION_base(4,5,0) -- (<>) is defined in Data.Monoid @@ -209,15 +209,15 @@ type Inlines = Many Inline type Blocks = Many Block +deriving instance Semigroup Blocks deriving instance Monoid Blocks -instance Monoid Inlines where - mempty = Many mempty - (Many xs) `mappend` (Many ys) = +instance Semigroup Inlines where + (Many xs) <> (Many ys) = case (viewr xs, viewl ys) of (EmptyR, _) -> Many ys (_, EmptyL) -> Many xs - (xs' :> x, y :< ys') -> Many (meld `mappend` ys') + (xs' :> x, y :< ys') -> Many (meld <> ys') where meld = case (x, y) of (Space, Space) -> xs' |> Space (Space, SoftBreak) -> xs' |> SoftBreak @@ -234,6 +234,9 @@ (LineBreak, SoftBreak) -> xs' |> LineBreak (SoftBreak, SoftBreak) -> xs' |> SoftBreak _ -> xs' |> x |> y +instance Monoid Inlines where + mempty = Many mempty + mappend = (<>) instance IsString Inlines where fromString = text @@ -478,19 +481,25 @@ -> Blocks table caption cellspecs headers rows = singleton $ Table (toList caption) aligns widths - (map toList headers) (map (map toList) rows) + (map toList headers') (map (map toList) rows) where (aligns, widths) = unzip cellspecs + numcols = case (headers:rows) of + [] -> 0 + xs -> maximum (map length xs) + headers' = if null headers + then replicate numcols mempty + else headers -- | A simple table without a caption. simpleTable :: [Blocks] -- ^ Headers -> [[Blocks]] -- ^ Rows -> Blocks -simpleTable headers = table mempty (mapConst defaults headers) headers +simpleTable headers rows = + table mempty (replicate numcols defaults) headers rows where defaults = (AlignDefault, 0) + numcols = case (headers:rows) of + [] -> 0 + xs -> maximum (map length xs) divWith :: Attr -> Blocks -> Blocks divWith attr = singleton . Div attr . toList - -mapConst :: Functor f => b -> f a -> f b -mapConst = fmap . const - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.17.0.5/Text/Pandoc/Definition.hs new/pandoc-types-1.17.4.2/Text/Pandoc/Definition.hs --- old/pandoc-types-1.17.0.5/Text/Pandoc/Definition.hs 2016-12-21 02:48:37.000000000 +0100 +++ new/pandoc-types-1.17.4.2/Text/Pandoc/Definition.hs 2018-03-16 20:23:37.000000000 +0100 @@ -90,24 +90,29 @@ #endif import Paths_pandoc_types (version) import Data.Version (Version, versionBranch) +import Data.Semigroup data Pandoc = Pandoc Meta [Block] deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) +instance Semigroup Pandoc where + (Pandoc m1 bs1) <> (Pandoc m2 bs2) = + Pandoc (m1 <> m2) (bs1 <> bs2) instance Monoid Pandoc where mempty = Pandoc mempty mempty - (Pandoc m1 bs1) `mappend` (Pandoc m2 bs2) = - Pandoc (m1 `mappend` m2) (bs1 `mappend` bs2) + mappend = (<>) -- | Metadata for the document: title, authors, date. newtype Meta = Meta { unMeta :: M.Map String MetaValue } deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -instance Monoid Meta where - mempty = Meta (M.empty) - (Meta m1) `mappend` (Meta m2) = Meta (M.union m1 m2) +instance Semigroup Meta where + (Meta m1) <> (Meta m2) = Meta (M.union m1 m2) -- note: M.union is left-biased, so if there are fields in both m1 -- and m2, m1 wins. +instance Monoid Meta where + mempty = Meta (M.empty) + mappend = (<>) data MetaValue = MetaMap (M.Map String MetaValue) | MetaList [MetaValue] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.17.0.5/Text/Pandoc/JSON.hs new/pandoc-types-1.17.4.2/Text/Pandoc/JSON.hs --- old/pandoc-types-1.17.0.5/Text/Pandoc/JSON.hs 2016-10-01 23:07:37.000000000 +0200 +++ new/pandoc-types-1.17.4.2/Text/Pandoc/JSON.hs 2017-10-26 19:38:06.000000000 +0200 @@ -74,9 +74,7 @@ where import Text.Pandoc.Definition import Text.Pandoc.Walk -import Text.Pandoc.Generic import Data.Maybe (listToMaybe) -import Data.Data import qualified Data.ByteString.Lazy as BL import Data.Aeson import System.Environment (getArgs) @@ -113,14 +111,14 @@ (walkM f :: Pandoc -> IO Pandoc) . either error id . eitherDecode' >>= BL.putStr . encode -instance Data a => ToJSONFilter (a -> [a]) where +instance (Walkable [a] Pandoc) => ToJSONFilter (a -> [a]) where toJSONFilter f = BL.getContents >>= - BL.putStr . encode . (bottomUp (concatMap f) :: Pandoc -> Pandoc) . + BL.putStr . encode . (walk (concatMap f) :: Pandoc -> Pandoc) . either error id . eitherDecode' -instance Data a => ToJSONFilter (a -> IO [a]) where +instance (Walkable [a] Pandoc) => ToJSONFilter (a -> IO [a]) where toJSONFilter f = BL.getContents >>= - (bottomUpM (fmap concat . mapM f) :: Pandoc -> IO Pandoc) . + (walkM (fmap concat . mapM f) :: Pandoc -> IO Pandoc) . either error id . eitherDecode' >>= BL.putStr . encode diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.17.0.5/Text/Pandoc/Walk.hs new/pandoc-types-1.17.4.2/Text/Pandoc/Walk.hs --- old/pandoc-types-1.17.0.5/Text/Pandoc/Walk.hs 2016-10-26 22:08:11.000000000 +0200 +++ new/pandoc-types-1.17.4.2/Text/Pandoc/Walk.hs 2018-03-16 23:30:53.000000000 +0100 @@ -1,6 +1,10 @@ -{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, CPP #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,9,0) -{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +{-# OPTIONS_GHC -fno-warn-redundant-constraints -O2 #-} #endif #if MIN_VERSION_base(4,8,0) #define OVERLAPS {-# OVERLAPPING #-} @@ -9,7 +13,7 @@ #define OVERLAPS #endif {- -Copyright (c) 2013-2016, John MacFarlane +Copyright (c) 2013-2017, John MacFarlane All rights reserved. @@ -89,14 +93,16 @@ module Text.Pandoc.Walk (Walkable(..)) where -import Control.Applicative ((<$>)) +import Control.Applicative () +import Control.Monad ((>=>)) +import Data.Functor.Identity (Identity (runIdentity)) import Text.Pandoc.Definition -import Text.Pandoc.Builder ((<>)) import qualified Data.Traversable as T -import Data.Traversable (Traversable) +import Data.Traversable () import qualified Data.Foldable as F -import Data.Foldable (Foldable) +import Data.Foldable () #if MIN_VERSION_base(4,8,0) +import Data.Monoid ((<>)) #else import Data.Monoid #endif @@ -105,11 +111,13 @@ -- | @walk f x@ walks the structure @x@ (bottom up) and replaces every -- occurrence of an @a@ with the result of applying @f@ to it. walk :: (a -> a) -> b -> b + walk f = runIdentity . walkM (return . f) -- | A monadic version of 'walk'. - walkM :: (Monad m, Functor m) => (a -> m a) -> b -> m b + walkM :: (Monad m, Applicative m, Functor m) => (a -> m a) -> b -> m b -- | @query f x@ walks the structure @x@ (bottom up) and applies @f@ -- to every @a@, appending the results. query :: Monoid c => (a -> c) -> b -> c + {-# MINIMAL walkM, query #-} instance (Foldable t, Traversable t, Walkable a b) => Walkable a (t b) where walk f = T.fmapDefault (walk f) @@ -125,326 +133,242 @@ query f (x,y) = mappend (query f x) (query f y) instance Walkable Inline Inline where - walk f (Str xs) = f $ Str xs - walk f (Emph xs) = f $ Emph (walk f xs) - walk f (Strong xs) = f $ Strong (walk f xs) - walk f (Strikeout xs) = f $ Strikeout (walk f xs) - walk f (Subscript xs) = f $ Subscript (walk f xs) - walk f (Superscript xs) = f $ Superscript (walk f xs) - walk f (SmallCaps xs) = f $ SmallCaps (walk f xs) - walk f (Quoted qt xs) = f $ Quoted qt (walk f xs) - walk f (Cite cs xs) = f $ Cite (walk f cs) (walk f xs) - walk f (Code attr s) = f $ Code attr s - walk f Space = f Space - walk f SoftBreak = f SoftBreak - walk f LineBreak = f LineBreak - walk f (Math mt s) = f (Math mt s) - walk f (RawInline t s) = f $ RawInline t s - walk f (Link atr xs t) = f $ Link atr (walk f xs) t - walk f (Image atr xs t) = f $ Image atr (walk f xs) t - walk f (Note bs) = f $ Note (walk f bs) - walk f (Span attr xs) = f $ Span attr (walk f xs) - - walkM f (Str xs) = f $ Str xs - walkM f (Emph xs) = Emph <$> walkM f xs >>= f - walkM f (Strong xs) = Strong <$> walkM f xs >>= f - walkM f (Strikeout xs) = Strikeout <$> walkM f xs >>= f - walkM f (Subscript xs) = Subscript <$> walkM f xs >>= f - walkM f (Superscript xs)= Superscript <$> walkM f xs >>= f - walkM f (SmallCaps xs) = SmallCaps <$> walkM f xs >>= f - walkM f (Quoted qt xs) = Quoted qt <$> walkM f xs >>= f - walkM f (Cite cs xs) = do cs' <- walkM f cs - xs' <- walkM f xs - f $ Cite cs' xs' - walkM f (Code attr s) = f $ Code attr s - walkM f Space = f Space - walkM f SoftBreak = f SoftBreak - walkM f LineBreak = f LineBreak - walkM f (Math mt s) = f (Math mt s) - walkM f (RawInline t s) = f $ RawInline t s - walkM f (Link atr xs t) = Link atr <$> walkM f xs >>= f . ($ t) - walkM f (Image atr xs t)= Image atr <$> walkM f xs >>= f . ($ t) - walkM f (Note bs) = Note <$> walkM f bs >>= f - walkM f (Span attr xs) = Span attr <$> walkM f xs >>= f - - query f (Str xs) = f (Str xs) - query f (Emph xs) = f (Emph xs) <> query f xs - query f (Strong xs) = f (Strong xs) <> query f xs - query f (Strikeout xs) = f (Strikeout xs) <> query f xs - query f (Subscript xs) = f (Subscript xs) <> query f xs - query f (Superscript xs)= f (Superscript xs) <> query f xs - query f (SmallCaps xs) = f (SmallCaps xs) <> query f xs - query f (Quoted qt xs) = f (Quoted qt xs) <> query f xs - query f (Cite cs xs) = f (Cite cs xs) <> query f cs <> query f xs - query f (Code attr s) = f (Code attr s) - query f Space = f Space - query f SoftBreak = f SoftBreak - query f LineBreak = f LineBreak - query f (Math mt s) = f (Math mt s) - query f (RawInline t s) = f (RawInline t s) - query f (Link atr xs t) = f (Link atr xs t) <> query f xs - query f (Image atr xs t)= f (Image atr xs t) <> query f xs - query f (Note bs) = f (Note bs) <> query f bs - query f (Span attr xs) = f (Span attr xs) <> query f xs + walkM f x = walkInlineM f x >>= f + query f x = f x <> queryInline f x + +instance OVERLAPS + Walkable [Inline] [Inline] where + walkM f = T.traverse (walkInlineM f) >=> f + query f inlns = f inlns <> mconcat (map (queryInline f) inlns) + +instance Walkable [Inline] Inline where + walkM f = walkInlineM f + query f = queryInline f instance Walkable Inline Block where - walk f (Para xs) = Para $ walk f xs - walk f (Plain xs) = Plain $ walk f xs - walk f (LineBlock xs) = LineBlock $ walk f xs - walk _ (CodeBlock attr s) = CodeBlock attr s - walk _ (RawBlock t s) = RawBlock t s - walk f (BlockQuote bs) = BlockQuote $ walk f bs - walk f (OrderedList a cs) = OrderedList a $ walk f cs - walk f (BulletList cs) = BulletList $ walk f cs - walk f (DefinitionList xs) = DefinitionList $ walk f xs - walk f (Header lev attr xs) = Header lev attr $ walk f xs - walk _ HorizontalRule = HorizontalRule - walk f (Table capt as ws hs rs) = Table (walk f capt) as ws (walk f hs) (walk f rs) - walk f (Div attr bs) = Div attr (walk f bs) - walk _ Null = Null - - walkM f (Para xs) = Para <$> walkM f xs - walkM f (Plain xs) = Plain <$> walkM f xs - walkM f (LineBlock xs) = LineBlock <$> walkM f xs - walkM _ (CodeBlock attr s) = return $ CodeBlock attr s - walkM _ (RawBlock t s) = return $ RawBlock t s - walkM f (BlockQuote bs) = BlockQuote <$> walkM f bs - walkM f (OrderedList a cs) = OrderedList a <$> walkM f cs - walkM f (BulletList cs) = BulletList <$> walkM f cs - walkM f (DefinitionList xs) = DefinitionList <$> walkM f xs - walkM f (Header lev attr xs) = Header lev attr <$> walkM f xs - walkM _ HorizontalRule = return HorizontalRule - walkM f (Table capt as ws hs rs) = do - capt' <- walkM f capt - hs' <- walkM f hs - rs' <- walkM f rs - return $ Table capt' as ws hs' rs' - walkM f (Div attr bs) = Div attr <$> (walkM f bs) - walkM _ Null = return Null - - query f (Para xs) = query f xs - query f (Plain xs) = query f xs - query f (LineBlock xs) = query f xs - query _ (CodeBlock _ _) = mempty - query _ (RawBlock _ _) = mempty - query f (BlockQuote bs) = query f bs - query f (OrderedList _ cs) = query f cs - query f (BulletList cs) = query f cs - query f (DefinitionList xs) = query f xs - query f (Header _ _ xs) = query f xs - query _ HorizontalRule = mempty - query f (Table capt _ _ hs rs) = query f capt <> query f hs <> query f rs - query f (Div _ bs) = query f bs - query _ Null = mempty + walkM f = walkBlockM f + query f = queryBlock f + +instance Walkable [Inline] Block where + walkM f = walkBlockM f + query f = queryBlock f instance Walkable Block Block where - walk f (Para xs) = f $ Para $ walk f xs - walk f (Plain xs) = f $ Plain $ walk f xs - walk f (LineBlock xs) = f $ LineBlock $ walk f xs - walk f (CodeBlock attr s) = f $ CodeBlock attr s - walk f (RawBlock t s) = f $ RawBlock t s - walk f (BlockQuote bs) = f $ BlockQuote $ walk f bs - walk f (OrderedList a cs) = f $ OrderedList a $ walk f cs - walk f (BulletList cs) = f $ BulletList $ walk f cs - walk f (DefinitionList xs) = f $ DefinitionList $ walk f xs - walk f (Header lev attr xs) = f $ Header lev attr $ walk f xs - walk f HorizontalRule = f $ HorizontalRule - walk f (Table capt as ws hs rs) = f $ Table (walk f capt) as ws (walk f hs) - (walk f rs) - walk f (Div attr bs) = f $ Div attr (walk f bs) - walk _ Null = Null - - walkM f (Para xs) = Para <$> walkM f xs >>= f - walkM f (Plain xs) = Plain <$> walkM f xs >>= f - walkM f (LineBlock xs) = LineBlock <$> walkM f xs >>= f - walkM f (CodeBlock attr s) = f $ CodeBlock attr s - walkM f (RawBlock t s) = f $ RawBlock t s - walkM f (BlockQuote bs) = BlockQuote <$> walkM f bs >>= f - walkM f (OrderedList a cs) = OrderedList a <$> walkM f cs >>= f - walkM f (BulletList cs) = BulletList <$> walkM f cs >>= f - walkM f (DefinitionList xs) = DefinitionList <$> walkM f xs >>= f - walkM f (Header lev attr xs) = Header lev attr <$> walkM f xs >>= f - walkM f HorizontalRule = f $ HorizontalRule - walkM f (Table capt as ws hs rs) = do capt' <- walkM f capt - hs' <- walkM f hs - rs' <- walkM f rs - f $ Table capt' as ws hs' rs' - walkM f (Div attr bs) = Div attr <$> walkM f bs >>= f - walkM f Null = f Null - - query f (Para xs) = f (Para xs) <> query f xs - query f (Plain xs) = f (Plain xs) <> query f xs - query f (LineBlock xs) = f (LineBlock xs) <> query f xs - query f (CodeBlock attr s) = f $ CodeBlock attr s - query f (RawBlock t s) = f $ RawBlock t s - query f (BlockQuote bs) = f (BlockQuote bs) <> query f bs - query f (OrderedList a cs) = f (OrderedList a cs) <> query f cs - query f (BulletList cs) = f (BulletList cs) <> query f cs - query f (DefinitionList xs) = f (DefinitionList xs) <> query f xs - query f (Header lev attr xs) = f (Header lev attr xs) <> query f xs - query f HorizontalRule = f $ HorizontalRule - query f (Table capt as ws hs rs) = f (Table capt as ws hs rs) <> - query f capt <> query f hs <> query f rs - query f (Div attr bs) = f (Div attr bs) <> query f bs - query f Null = f Null + walkM f x = walkBlockM f x >>= f + query f x = f x <> queryBlock f x + +instance Walkable [Block] Block where + walkM f = walkBlockM f + query f = queryBlock f + +instance OVERLAPS + Walkable [Block] [Block] where + walkM f = T.traverse (walkBlockM f) >=> f + query f blks = f blks <> mconcat (map (queryBlock f) blks) instance Walkable Block Inline where - walk _ (Str xs) = Str xs - walk f (Emph xs) = Emph (walk f xs) - walk f (Strong xs) = Strong (walk f xs) - walk f (Strikeout xs) = Strikeout (walk f xs) - walk f (Subscript xs) = Subscript (walk f xs) - walk f (Superscript xs)= Superscript (walk f xs) - walk f (SmallCaps xs) = SmallCaps (walk f xs) - walk f (Quoted qt xs) = Quoted qt (walk f xs) - walk f (Cite cs xs) = Cite (walk f cs) (walk f xs) - walk _ (Code attr s) = Code attr s - walk _ Space = Space - walk _ SoftBreak = SoftBreak - walk _ LineBreak = LineBreak - walk _ (Math mt s) = Math mt s - walk _ (RawInline t s) = RawInline t s - walk f (Link atr xs t) = Link atr (walk f xs) t - walk f (Image atr xs t)= Image atr (walk f xs) t - walk f (Note bs) = Note (walk f bs) - walk f (Span attr xs) = Span attr (walk f xs) - - walkM _ (Str xs) = return $ Str xs - walkM f (Emph xs) = Emph <$> walkM f xs - walkM f (Strong xs) = Strong <$> walkM f xs - walkM f (Strikeout xs) = Strikeout <$> walkM f xs - walkM f (Subscript xs) = Subscript <$> walkM f xs - walkM f (Superscript xs)= Superscript <$> walkM f xs - walkM f (SmallCaps xs) = SmallCaps <$> walkM f xs - walkM f (Quoted qt xs) = Quoted qt <$> walkM f xs - walkM f (Cite cs xs) = do cs' <- walkM f cs - xs' <- walkM f xs - return $ Cite cs' xs' - walkM _ (Code attr s) = return $ Code attr s - walkM _ Space = return $ Space - walkM _ SoftBreak = return $ SoftBreak - walkM _ LineBreak = return $ LineBreak - walkM _ (Math mt s) = return $ Math mt s - walkM _ (RawInline t s) = return $ RawInline t s - walkM f (Link atr xs t) = (\lab -> Link atr lab t) <$> walkM f xs - walkM f (Image atr xs t)= (\lab -> Image atr lab t) <$> walkM f xs - walkM f (Note bs) = Note <$> walkM f bs - walkM f (Span attr xs) = Span attr <$> walkM f xs - - query _ (Str _) = mempty - query f (Emph xs) = query f xs - query f (Strong xs) = query f xs - query f (Strikeout xs) = query f xs - query f (Subscript xs) = query f xs - query f (Superscript xs)= query f xs - query f (SmallCaps xs) = query f xs - query f (Quoted _ xs) = query f xs - query f (Cite cs xs) = query f cs <> query f xs - query _ (Code _ _) = mempty - query _ Space = mempty - query _ SoftBreak = mempty - query _ LineBreak = mempty - query _ (Math _ _) = mempty - query _ (RawInline _ _) = mempty - query f (Link _ xs _) = query f xs - query f (Image _ xs _) = query f xs - query f (Note bs) = query f bs - query f (Span _ xs) = query f xs + walkM f = walkInlineM f + query f = queryInline f + +instance Walkable [Block] Inline where + walkM f = walkInlineM f + query f = queryInline f instance Walkable Block Pandoc where - walk f (Pandoc m bs) = Pandoc (walk f m) (walk f bs) - walkM f (Pandoc m bs) = do m' <- walkM f m - bs' <- walkM f bs - return $ Pandoc m' bs' - query f (Pandoc m bs) = query f m <> query f bs + walkM = walkPandocM + query = queryPandoc + +instance Walkable [Block] Pandoc where + walkM = walkPandocM + query = queryPandoc instance Walkable Inline Pandoc where - walk f (Pandoc m bs) = Pandoc (walk f m) (walk f bs) - walkM f (Pandoc m bs) = do m' <- walkM f m - bs' <- walkM f bs - return $ Pandoc m' bs' - query f (Pandoc m bs) = query f m <> query f bs + walkM = walkPandocM + query = queryPandoc + +instance Walkable [Inline] Pandoc where + walkM = walkPandocM + query = queryPandoc instance Walkable Pandoc Pandoc where - walk f = f walkM f = f query f = f instance Walkable Meta Meta where - walk f = f walkM f = f query f = f instance Walkable Inline Meta where - walk f (Meta metamap) = Meta $ walk f metamap + walkM f (Meta metamap) = Meta <$> walkM f metamap + query f (Meta metamap) = query f metamap + +instance Walkable [Inline] Meta where walkM f (Meta metamap) = Meta <$> walkM f metamap query f (Meta metamap) = query f metamap instance Walkable Block Meta where - walk f (Meta metamap) = Meta $ walk f metamap + walkM f (Meta metamap) = Meta <$> walkM f metamap + query f (Meta metamap) = query f metamap + +instance Walkable [Block] Meta where walkM f (Meta metamap) = Meta <$> walkM f metamap query f (Meta metamap) = query f metamap instance Walkable Inline MetaValue where - walk f (MetaList xs) = MetaList $ walk f xs - walk _ (MetaBool b) = MetaBool b - walk _ (MetaString s) = MetaString s - walk f (MetaInlines xs) = MetaInlines $ walk f xs - walk f (MetaBlocks bs) = MetaBlocks $ walk f bs - walk f (MetaMap m) = MetaMap $ walk f m - - walkM f (MetaList xs) = MetaList <$> walkM f xs - walkM _ (MetaBool b) = return $ MetaBool b - walkM _ (MetaString s) = return $ MetaString s - walkM f (MetaInlines xs) = MetaInlines <$> walkM f xs - walkM f (MetaBlocks bs) = MetaBlocks <$> walkM f bs - walkM f (MetaMap m) = MetaMap <$> walkM f m - - query f (MetaList xs) = query f xs - query _ (MetaBool _) = mempty - query _ (MetaString _) = mempty - query f (MetaInlines xs) = query f xs - query f (MetaBlocks bs) = query f bs - query f (MetaMap m) = query f m + walkM = walkMetaValueM + query = queryMetaValue + +instance Walkable [Inline] MetaValue where + walkM = walkMetaValueM + query = queryMetaValue instance Walkable Block MetaValue where - walk f (MetaList xs) = MetaList $ walk f xs - walk _ (MetaBool b) = MetaBool b - walk _ (MetaString s) = MetaString s - walk f (MetaInlines xs) = MetaInlines $ walk f xs - walk f (MetaBlocks bs) = MetaBlocks $ walk f bs - walk f (MetaMap m) = MetaMap $ walk f m - - walkM f (MetaList xs) = MetaList <$> walkM f xs - walkM _ (MetaBool b) = return $ MetaBool b - walkM _ (MetaString s) = return $ MetaString s - walkM f (MetaInlines xs) = MetaInlines <$> walkM f xs - walkM f (MetaBlocks bs) = MetaBlocks <$> walkM f bs - walkM f (MetaMap m) = MetaMap <$> walkM f m - - query f (MetaList xs) = query f xs - query _ (MetaBool _) = mempty - query _ (MetaString _) = mempty - query f (MetaInlines xs) = query f xs - query f (MetaBlocks bs) = query f bs - query f (MetaMap m) = query f m + walkM = walkMetaValueM + query = queryMetaValue + +instance Walkable [Block] MetaValue where + walkM = walkMetaValueM + query = queryMetaValue instance Walkable Inline Citation where - walk f (Citation id' pref suff mode notenum hash) = - Citation id' (walk f pref) (walk f suff) mode notenum hash - walkM f (Citation id' pref suff mode notenum hash) = - do pref' <- walkM f pref - suff' <- walkM f suff - return $ Citation id' pref' suff' mode notenum hash - query f (Citation _ pref suff _ _ _) = - query f pref <> query f suff + walkM = walkCitationM + query = queryCitation + +instance Walkable [Inline] Citation where + walkM = walkCitationM + query = queryCitation instance Walkable Block Citation where - walk f (Citation id' pref suff mode notenum hash) = - Citation id' (walk f pref) (walk f suff) mode notenum hash - walkM f (Citation id' pref suff mode notenum hash) = + walkM = walkCitationM + query = queryCitation + +instance Walkable [Block] Citation where + walkM = walkCitationM + query = queryCitation + +walkInlineM :: (Walkable a Citation, Walkable a [Block], + Walkable a [Inline], Monad m, Applicative m, Functor m) + => (a -> m a) -> Inline -> m Inline +walkInlineM _ (Str xs) = return (Str xs) +walkInlineM f (Emph xs) = Emph <$> walkM f xs +walkInlineM f (Strong xs) = Strong <$> walkM f xs +walkInlineM f (Strikeout xs) = Strikeout <$> walkM f xs +walkInlineM f (Subscript xs) = Subscript <$> walkM f xs +walkInlineM f (Superscript xs) = Superscript <$> walkM f xs +walkInlineM f (SmallCaps xs) = SmallCaps <$> walkM f xs +walkInlineM f (Quoted qt xs) = Quoted qt <$> walkM f xs +walkInlineM f (Link atr xs t) = Link atr <$> walkM f xs <*> pure t +walkInlineM f (Image atr xs t) = Image atr <$> walkM f xs <*> pure t +walkInlineM f (Note bs) = Note <$> walkM f bs +walkInlineM f (Span attr xs) = Span attr <$> walkM f xs +walkInlineM f (Cite cs xs) = Cite <$> walkM f cs <*> walkM f xs +walkInlineM _ LineBreak = return LineBreak +walkInlineM _ SoftBreak = return SoftBreak +walkInlineM _ Space = return Space +walkInlineM _ x@Code {} = return x +walkInlineM _ x@Math {} = return x +walkInlineM _ x@RawInline {} = return x + +walkBlockM :: (Walkable a [Block], Walkable a [Inline], Monad m, + Applicative m, Functor m) + => (a -> m a) -> Block -> m Block +walkBlockM f (Para xs) = Para <$> walkM f xs +walkBlockM f (Plain xs) = Plain <$> walkM f xs +walkBlockM f (LineBlock xs) = LineBlock <$> walkM f xs +walkBlockM f (BlockQuote xs) = BlockQuote <$> walkM f xs +walkBlockM f (OrderedList a cs) = OrderedList a <$> walkM f cs +walkBlockM f (BulletList cs) = BulletList <$> walkM f cs +walkBlockM f (DefinitionList xs) = DefinitionList <$> walkM f xs +walkBlockM f (Header lev attr xs) = Header lev attr <$> walkM f xs +walkBlockM f (Div attr bs') = Div attr <$> walkM f bs' +walkBlockM _ x@CodeBlock {} = return x +walkBlockM _ x@RawBlock {} = return x +walkBlockM _ HorizontalRule = return HorizontalRule +walkBlockM _ Null = return Null +walkBlockM f (Table capt as ws hs rs) = do capt' <- walkM f capt + hs' <- walkM f hs + rs' <- walkM f rs + return $ Table capt' as ws hs' rs' + +walkMetaValueM :: (Walkable a MetaValue, Walkable a [Block], + Walkable a [Inline], Monad f, Applicative f, Functor f) + => (a -> f a) -> MetaValue -> f MetaValue +walkMetaValueM f (MetaList xs) = MetaList <$> walkM f xs +walkMetaValueM _ (MetaBool b) = return $ MetaBool b +walkMetaValueM _ (MetaString s) = return $ MetaString s +walkMetaValueM f (MetaInlines xs) = MetaInlines <$> walkM f xs +walkMetaValueM f (MetaBlocks bs) = MetaBlocks <$> walkM f bs +walkMetaValueM f (MetaMap m) = MetaMap <$> walkM f m + +queryInline :: (Walkable a Citation, Walkable a [Block], + Walkable a [Inline], Monoid c) + => (a -> c) -> Inline -> c +queryInline _ (Str _) = mempty +queryInline f (Emph xs) = query f xs +queryInline f (Strong xs) = query f xs +queryInline f (Strikeout xs) = query f xs +queryInline f (Subscript xs) = query f xs +queryInline f (Superscript xs)= query f xs +queryInline f (SmallCaps xs) = query f xs +queryInline f (Quoted _ xs) = query f xs +queryInline f (Cite cs xs) = query f cs <> query f xs +queryInline _ (Code _ _) = mempty +queryInline _ Space = mempty +queryInline _ SoftBreak = mempty +queryInline _ LineBreak = mempty +queryInline _ (Math _ _) = mempty +queryInline _ (RawInline _ _) = mempty +queryInline f (Link _ xs _) = query f xs +queryInline f (Image _ xs _) = query f xs +queryInline f (Note bs) = query f bs +queryInline f (Span _ xs) = query f xs + +queryBlock :: (Walkable a Citation, Walkable a [Block], + Walkable a [Inline], Monoid c) + => (a -> c) -> Block -> c +queryBlock f (Para xs) = query f xs +queryBlock f (Plain xs) = query f xs +queryBlock f (LineBlock xs) = query f xs +queryBlock _ (CodeBlock _ _) = mempty +queryBlock _ (RawBlock _ _) = mempty +queryBlock f (BlockQuote bs) = query f bs +queryBlock f (OrderedList _ cs) = query f cs +queryBlock f (BulletList cs) = query f cs +queryBlock f (DefinitionList xs) = query f xs +queryBlock f (Header _ _ xs) = query f xs +queryBlock _ HorizontalRule = mempty +queryBlock f (Table capt _ _ hs rs) = query f capt <> query f hs <> query f rs +queryBlock f (Div _ bs) = query f bs +queryBlock _ Null = mempty + +queryMetaValue :: (Walkable a MetaValue, Walkable a [Block], + Walkable a [Inline], Monoid c) + => (a -> c) -> MetaValue -> c +queryMetaValue f (MetaList xs) = query f xs +queryMetaValue _ (MetaBool _) = mempty +queryMetaValue _ (MetaString _) = mempty +queryMetaValue f (MetaInlines xs) = query f xs +queryMetaValue f (MetaBlocks bs) = query f bs +queryMetaValue f (MetaMap m) = query f m + +walkCitationM :: (Walkable a [Inline], Monad m, Applicative m, Functor m) + => (a -> m a) -> Citation -> m Citation +walkCitationM f (Citation id' pref suff mode notenum hash) = do pref' <- walkM f pref suff' <- walkM f suff return $ Citation id' pref' suff' mode notenum hash - query f (Citation _ pref suff _ _ _) = - query f pref <> query f suff + +queryCitation :: (Walkable a [Inline], Monoid c) + => (a -> c) -> Citation -> c +queryCitation f (Citation _ pref suff _ _ _) = query f pref <> query f suff + +walkPandocM :: (Walkable a Meta, Walkable a [Block], Monad m, + Applicative m, Functor m) + => (a -> m a) -> Pandoc -> m Pandoc +walkPandocM f (Pandoc m bs) = do m' <- walkM f m + bs' <- walkM f bs + return $ Pandoc m' bs' + +queryPandoc :: (Walkable a Meta, Walkable a [Block], Monoid c) + => (a -> c) -> Pandoc -> c +queryPandoc f (Pandoc m bs) = query f m <> query f bs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.17.0.5/benchmark/bench.hs new/pandoc-types-1.17.4.2/benchmark/bench.hs --- old/pandoc-types-1.17.0.5/benchmark/bench.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/pandoc-types-1.17.4.2/benchmark/bench.hs 2017-10-26 19:38:06.000000000 +0200 @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} + +import Criterion.Main (bench, defaultMain, nf) +import Text.Pandoc.Definition (Pandoc, Inline (Str)) +import Text.Pandoc.Walk (walk) +import Text.Pandoc.Builder + +main :: IO () +main = do + defaultMain [ + bench "simple walk" $ nf (walk prependZeroWidthSpace) mydoc + , bench "walk concatMap" $ nf (walk $ concatMap prependZeroWidthSpace') mydoc + , bench "walk lists" $ nf (walk prependZeroWidthSpace'') mydoc + ] + +prependZeroWidthSpace :: Inline -> Inline +prependZeroWidthSpace (Str s) = Str ('\8203' : s) +prependZeroWidthSpace x = x + +prependZeroWidthSpace' :: Inline -> [Inline] +prependZeroWidthSpace' (Str s) = [Str ('\8203' : s)] +prependZeroWidthSpace' x = [x] + +prependZeroWidthSpace'' :: [Inline] -> [Inline] +prependZeroWidthSpace'' (Str s : xs) = + (Str ('\8203' : s) : prependZeroWidthSpace'' xs) +prependZeroWidthSpace'' (x : xs) = + x : prependZeroWidthSpace'' xs +prependZeroWidthSpace'' [] = [] + +mydoc :: Pandoc +mydoc = setTitle "My title" $ doc $ + mconcat $ replicate 50 $ + para "This is the first paragraph" <> + para ("And " <> emph "another" <> ".") <> + bulletList [ para "item one" <> para "continuation" + , plain ("item two and a " <> + link "/url" "go to url" "link") + ] diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.17.0.5/changelog new/pandoc-types-1.17.4.2/changelog --- old/pandoc-types-1.17.0.5/changelog 2017-01-16 08:29:49.000000000 +0100 +++ new/pandoc-types-1.17.4.2/changelog 2018-03-16 23:35:49.000000000 +0100 @@ -1,3 +1,61 @@ +[1.17.4.2] + + * Fix compiler warnings. + +[1.17.4.1] + + * Import Semigroups when needed rather than using CPP. + * Bump criterion upper bound. + +[1.17.4] + + * Add Semigroup instances for Pandoc, Meta, Inlines, Blocks + (if base >= 4.9). This is needed for the library to compile + with ghc 8.4. + * Bumped criterion upper bound. + +[1.17.3.1] + + * Bumped upper bounds for criterion and QuickCheck. + +[1.17.3] + + * Added Walkable instances for `[Inline] Inline` and `[Block] Block`. + +[1.17.2] + + * Provide default implementation for walk (Albert Krewinkel). + The implementations for `walk` and `walkM` are very similar, so a + default method is provided which implements the former in terms of the + latter. This change should not affect performance, as the `Identity` + functor, which is used in the default definition, is a newtype that + should be eliminated at compile time. (This requires a dependency + on transformers for ghc 7.8.x.) + * Force optimizations when compiling Walk module (Albert Krewinkel). + * Add `Applicative m` to the context of walkM (Albert Krewinkel). + The acceptance of AMP makes this a natural change. + * Add `Walkable [Block]` and `Walkable [Inline]` instances (Albert + Krewinkel). + * Factored out duplicate code in Walk. + * Added benchmark. + * Text.Pandoc.JSON: Use `walk` instead of `bottomUp` in the + `ToJSONFilter` instance for `a -> [a]`. Note that behavior will be + slightly different, since bottomUp's treatment of a function `[a] -> [a]` + is to apply it to each sublist of a list, while walk applies it only to + maximal sublists. Usually the latter behavior is what is wanted, and the + former can be simulated when needed. But there may be existing filters + that need to be rewritten in light of the new behavior. + +[1.17.1] + + * Better consistency in simpleTable and table (jgm/pandoc#3648). + If `headers` is empty, we populate it with empty cells, using the rows + to determine number of columns. We also ensure that there are numcols + alignments and column widths. + * Make sure Div and Span occur in Arbitrary instances. + * Bump dependency upper bounds. + * Removed unused mapConst. + [1.17.0.5] * Allow aeson 1.1. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.17.0.5/pandoc-types.cabal new/pandoc-types-1.17.4.2/pandoc-types.cabal --- old/pandoc-types-1.17.0.5/pandoc-types.cabal 2017-01-16 08:28:31.000000000 +0100 +++ new/pandoc-types-1.17.4.2/pandoc-types.cabal 2018-03-16 23:34:49.000000000 +0100 @@ -1,5 +1,5 @@ Name: pandoc-types -Version: 1.17.0.5 +Version: 1.17.4.2 Synopsis: Types for representing a structured document Description: @Text.Pandoc.Definition@ defines the 'Pandoc' data structure, which is used by pandoc to represent @@ -28,7 +28,7 @@ Author: John MacFarlane Maintainer: [email protected] Bug-Reports: https://github.com/jgm/pandoc-types/issues -Copyright: (c) 2006-2015 John MacFarlane +Copyright: (c) 2006-2017 John MacFarlane Category: Text Build-type: Simple Cabal-version: >=1.8 @@ -48,15 +48,19 @@ Other-modules: Paths_pandoc_types Build-depends: base >= 4 && < 5, containers >= 0.3, - syb >= 0.1 && < 0.7, + syb >= 0.1 && < 0.8, ghc-prim >= 0.2, bytestring >= 0.9 && < 0.11, - aeson >= 0.6.2 && < 1.2, + aeson >= 0.6.2 && < 1.4, + transformers >= 0.2 && < 0.6, QuickCheck >= 2 + if !impl(ghc >= 8.0) + Build-depends: semigroups == 0.18.* if impl(ghc < 7.10) Build-depends: deepseq-generics >= 0.1 && < 0.2 else Build-depends: deepseq >= 1.4.1 && < 1.5 + ghc-options: -Wall test-suite test-pandoc-types type: exitcode-stdio-1.0 @@ -65,13 +69,22 @@ build-depends: base, pandoc-types, syb, - aeson >= 0.6.2 && < 1.2, + aeson >= 0.6.2 && < 1.4, containers >= 0.3, bytestring >= 0.9 && < 0.11, test-framework >= 0.3 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2.9 && < 0.4, - QuickCheck >= 2.4 && < 2.10, - HUnit >= 1.2 && < 1.6, + QuickCheck >= 2.4 && < 2.12, + HUnit >= 1.2 && < 1.7, string-qq == 0.0.2 - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -O2 + +benchmark benchmark-pandoc-types + type: exitcode-stdio-1.0 + main-is: bench.hs + hs-source-dirs: benchmark + build-depends: pandoc-types, + base >= 4.2 && < 5, + criterion >= 1.0 && < 1.5 + ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -O2 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.17.0.5/test/test-pandoc-types.hs new/pandoc-types-1.17.4.2/test/test-pandoc-types.hs --- old/pandoc-types-1.17.0.5/test/test-pandoc-types.hs 2017-01-16 08:25:44.000000000 +0100 +++ new/pandoc-types-1.17.4.2/test/test-pandoc-types.hs 2017-10-26 19:38:06.000000000 +0200 @@ -1,11 +1,11 @@ -{-# LANGUAGE OverloadedStrings, QuasiQuotes, FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings, QuasiQuotes, FlexibleContexts, CPP #-} +import Text.Pandoc.Arbitrary () import Text.Pandoc.Definition import Text.Pandoc.Walk -import Text.Pandoc.Arbitrary() import Data.Generics +import Data.List (tails) import Test.HUnit (Assertion, assertEqual, assertFailure) -import Text.Pandoc.Arbitrary () import Data.Char (toUpper) import Data.Aeson (FromJSON, ToJSON, encode, decode) import Test.Framework @@ -14,33 +14,71 @@ import qualified Data.Map as M import Data.String.QQ import Data.ByteString.Lazy (ByteString) +#if MIN_VERSION_base(4,8,0) +#else +import Data.Monoid +#endif +import qualified Data.Monoid as Monoid + p_walk :: (Typeable a, Walkable a Pandoc) => (a -> a) -> Pandoc -> Bool p_walk f d = everywhere (mkT f) d == walk f d +p_walkList :: (Typeable a, Walkable [a] Pandoc) + => ([a] -> [a]) -> Pandoc -> Bool +p_walkList f d = everywhere (mkT f) d == walk (foldr g []) d + where g x ys = f (x:ys) + p_query :: (Eq a, Typeable a1, Monoid a, Walkable a1 Pandoc) => (a1 -> a) -> Pandoc -> Bool p_query f d = everything mappend (mempty `mkQ` f) d == query f d +p_queryList :: (Eq a, Typeable a1, Monoid a, Walkable [a1] Pandoc) + => ([a1] -> a) -> Pandoc -> Bool +p_queryList f d = everything mappend (mempty `mkQ` f) d == + query (mconcat . map f . tails) d + inlineTrans :: Inline -> Inline inlineTrans (Str xs) = Str $ map toUpper xs inlineTrans (Emph xs) = Strong xs inlineTrans x = x +inlinesTrans :: [Inline] -> [Inline] +inlinesTrans ys | all whitespaceInline ys = [] + where + whitespaceInline Space = True + whitespaceInline LineBreak = True + whitespaceInline SoftBreak = True + whitespaceInline (Str "") = True + whitespaceInline _ = False +inlinesTrans ys = ys + blockTrans :: Block -> Block blockTrans (Plain xs) = Para xs blockTrans (BlockQuote xs) = Div ("",["special"],[]) xs blockTrans x = x +blocksTrans :: [Block] -> [Block] +blocksTrans [CodeBlock {}] = [] +blocksTrans [BlockQuote xs] = xs +blocksTrans [Div _ xs] = xs +blocksTrans xs = xs + inlineQuery :: Inline -> String inlineQuery (Str xs) = xs inlineQuery _ = "" +inlinesQuery :: [Inline] -> Monoid.Sum Int +inlinesQuery = Monoid.Sum . length + blockQuery :: Block -> [Int] blockQuery (Header lev _ _) = [lev] blockQuery _ = [] +blocksQuery :: [Block] -> Monoid.Sum Int +blocksQuery = Monoid.Sum . length + prop_roundtrip :: Pandoc -> Bool prop_roundtrip doc = case decode $ encode doc :: (Maybe Pandoc) of @@ -332,6 +370,10 @@ , testProperty "p_walk blockTrans" (p_walk blockTrans) , testProperty "p_query inlineQuery" (p_query inlineQuery) , testProperty "p_query blockQuery" (p_query blockQuery) + , testProperty "p_walkList inlinesTrans" (p_walkList inlinesTrans) + , testProperty "p_queryList inlinesQuery" (p_queryList inlinesQuery) + , testProperty "p_walkList blocksTrans" (p_walkList blocksTrans) + , testProperty "p_queryList blocksQuery" (p_queryList blocksQuery) ] , testGroup "JSON" [ testGroup "encoding/decoding properties" ++++++ pandoc-types.cabal ++++++ --- /var/tmp/diff_new_pack.xormqC/_old 2018-05-30 12:26:40.147594252 +0200 +++ /var/tmp/diff_new_pack.xormqC/_new 2018-05-30 12:26:40.151594116 +0200 @@ -1,6 +1,6 @@ Name: pandoc-types -Version: 1.17.0.5 -x-revision: 4 +Version: 1.17.4.2 +x-revision: 1 Synopsis: Types for representing a structured document Description: @Text.Pandoc.Definition@ defines the 'Pandoc' data structure, which is used by pandoc to represent @@ -29,7 +29,7 @@ Author: John MacFarlane Maintainer: [email protected] Bug-Reports: https://github.com/jgm/pandoc-types/issues -Copyright: (c) 2006-2015 John MacFarlane +Copyright: (c) 2006-2017 John MacFarlane Category: Text Build-type: Simple Cabal-version: >=1.8 @@ -47,17 +47,21 @@ Text.Pandoc.JSON Text.Pandoc.Arbitrary Other-modules: Paths_pandoc_types - Build-depends: base >= 4 && < 5, + Build-depends: base >= 4.8 && < 5, containers >= 0.3, syb >= 0.1 && < 0.8, ghc-prim >= 0.2, bytestring >= 0.9 && < 0.11, - aeson >= 0.6.2 && < 1.3, + aeson >= 0.6.2 && < 1.4, + transformers >= 0.2 && < 0.6, QuickCheck >= 2 + if !impl(ghc >= 8.0) + Build-depends: semigroups == 0.18.* if impl(ghc < 7.10) Build-depends: deepseq-generics >= 0.1 && < 0.2 else Build-depends: deepseq >= 1.4.1 && < 1.5 + ghc-options: -Wall test-suite test-pandoc-types type: exitcode-stdio-1.0 @@ -66,13 +70,22 @@ build-depends: base, pandoc-types, syb, - aeson >= 0.6.2 && < 1.3, + aeson >= 0.6.2 && < 1.4, containers >= 0.3, bytestring >= 0.9 && < 0.11, test-framework >= 0.3 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2.9 && < 0.4, - QuickCheck >= 2.4 && < 2.11, + QuickCheck >= 2.4 && < 2.12, HUnit >= 1.2 && < 1.7, string-qq == 0.0.2 - ghc-options: -threaded -rtsopts -with-rtsopts=-N + ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -O2 + +benchmark benchmark-pandoc-types + type: exitcode-stdio-1.0 + main-is: bench.hs + hs-source-dirs: benchmark + build-depends: pandoc-types, + base >= 4.2 && < 5, + criterion >= 1.0 && < 1.5 + ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -O2
