Hello community, here is the log from the commit of package ghc-pandoc-types for openSUSE:Factory checked in at 2017-03-03 17:51:29 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-pandoc-types (Old) and /work/SRC/openSUSE:Factory/.ghc-pandoc-types.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-pandoc-types" Fri Mar 3 17:51:29 2017 rev:12 rq:461669 version:1.17.0.5 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-pandoc-types/ghc-pandoc-types.changes 2016-09-05 21:20:37.000000000 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-pandoc-types.new/ghc-pandoc-types.changes 2017-03-03 17:51:30.258058199 +0100 @@ -1,0 +2,5 @@ +Sun Feb 12 14:17:22 UTC 2017 - [email protected] + +- Update to version 1.17.0.5 with cabal2obs. + +------------------------------------------------------------------- Old: ---- pandoc-types-1.16.1.1.tar.gz New: ---- pandoc-types-1.17.0.5.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-pandoc-types.spec ++++++ --- /var/tmp/diff_new_pack.vLkiBD/_old 2017-03-03 17:51:30.961958782 +0100 +++ /var/tmp/diff_new_pack.vLkiBD/_new 2017-03-03 17:51:30.965958217 +0100 @@ -1,7 +1,7 @@ # # spec file for package ghc-pandoc-types # -# 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 @@ -17,8 +17,9 @@ %global pkg_name pandoc-types +%bcond_with tests Name: ghc-%{pkg_name} -Version: 1.16.1.1 +Version: 1.17.0.5 Release: 0 Summary: Types for representing a structured document License: GPL-2.0 @@ -26,6 +27,7 @@ Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-QuickCheck-devel BuildRequires: ghc-aeson-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-containers-devel @@ -33,6 +35,13 @@ BuildRequires: ghc-rpm-macros BuildRequires: ghc-syb-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build +%if %{with tests} +BuildRequires: ghc-HUnit-devel +BuildRequires: ghc-string-qq-devel +BuildRequires: ghc-test-framework-devel +BuildRequires: ghc-test-framework-hunit-devel +BuildRequires: ghc-test-framework-quickcheck2-devel +%endif %description 'Text.Pandoc.Definition' defines the 'Pandoc' data structure, which is used by @@ -73,6 +82,9 @@ %install %ghc_lib_install +%check +%cabal_test + %post devel %ghc_pkg_recache ++++++ pandoc-types-1.16.1.1.tar.gz -> pandoc-types-1.17.0.5.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.16.1.1/Text/Pandoc/Arbitrary.hs new/pandoc-types-1.17.0.5/Text/Pandoc/Arbitrary.hs --- old/pandoc-types-1.16.1.1/Text/Pandoc/Arbitrary.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/pandoc-types-1.17.0.5/Text/Pandoc/Arbitrary.hs 2016-10-13 20:56:56.000000000 +0200 @@ -0,0 +1,195 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-} +-- provides Arbitrary instance for Pandoc types +module Text.Pandoc.Arbitrary () +where +import Test.QuickCheck +import Control.Monad (forM, liftM, liftM2) +import Text.Pandoc.Definition +import Text.Pandoc.Builder + +realString :: Gen String +realString = resize 8 $ listOf $ frequency [ (9, elements [' '..'\127']) + , (1, elements ['\128'..'\9999']) ] + +arbAttr :: Gen Attr +arbAttr = do + id' <- elements ["","loc"] + classes <- elements [[],["haskell"],["c","numberLines"]] + keyvals <- elements [[],[("start","22")],[("a","11"),("b_2","a b c")]] + return (id',classes,keyvals) + +instance Arbitrary Inlines where + arbitrary = liftM (fromList :: [Inline] -> Inlines) arbitrary + +instance Arbitrary Blocks where + arbitrary = liftM (fromList :: [Block] -> Blocks) arbitrary + +instance Arbitrary Inline where + arbitrary = resize 3 $ arbInline 2 + +arbInlines :: Int -> Gen [Inline] +arbInlines n = listOf1 (arbInline n) `suchThat` (not . startsWithSpace) + where startsWithSpace (Space:_) = True + startsWithSpace _ = False + +-- restrict to 3 levels of nesting max; otherwise we get +-- bogged down in indefinitely large structures +arbInline :: Int -> Gen Inline +arbInline n = frequency $ [ (60, liftM Str realString) + , (60, return Space) + , (10, liftM2 Code arbAttr realString) + , (5, elements [ RawInline (Format "html") "<a id=\"eek\">" + , RawInline (Format "latex") "\\my{command}" ]) + ] ++ [ x | x <- nesters, n > 1] + where nesters = [ (10, liftM Emph $ arbInlines (n-1)) + , (10, liftM Strong $ arbInlines (n-1)) + , (10, liftM Strikeout $ arbInlines (n-1)) + , (10, liftM Superscript $ arbInlines (n-1)) + , (10, liftM Subscript $ arbInlines (n-1)) + , (10, liftM SmallCaps $ arbInlines (n-1)) + , (10, do x1 <- arbitrary + x2 <- arbInlines (n-1) + return $ Quoted x1 x2) + , (10, do x1 <- arbitrary + x2 <- realString + return $ Math x1 x2) + , (10, do x0 <- arbAttr + x1 <- arbInlines (n-1) + x3 <- realString + x2 <- realString + return $ Link x0 x1 (x2,x3)) + , (10, do x0 <- arbAttr + x1 <- arbInlines (n-1) + x3 <- realString + x2 <- realString + return $ Image x0 x1 (x2,x3)) + , (2, liftM2 Cite arbitrary (arbInlines 1)) + , (2, liftM Note $ resize 3 $ listOf1 $ arbBlock (n-1)) + ] + +instance Arbitrary Block where + arbitrary = resize 3 $ arbBlock 2 + +arbBlock :: Int -> Gen Block +arbBlock n = frequency $ [ (10, liftM Plain $ arbInlines (n-1)) + , (15, liftM Para $ arbInlines (n-1)) + , (5, liftM2 CodeBlock arbAttr realString) + , (3, liftM LineBlock $ + liftM2 (:) + (arbInlines $ (n - 1) `mod` 3) + (forM [1..((n - 1) `div` 3)] + (const $ arbInlines 3))) + , (2, elements [ RawBlock (Format "html") + "<div>\n*&*\n</div>" + , RawBlock (Format "latex") + "\\begin[opt]{env}\nhi\n{\\end{env}" + ]) + , (5, do x1 <- choose (1 :: Int, 6) + x2 <- arbInlines (n-1) + return (Header x1 nullAttr x2)) + , (2, return HorizontalRule) + ] ++ [x | x <- nesters, n > 0] + where nesters = [ (5, liftM BlockQuote $ listOf1 $ arbBlock (n-1)) + , (5, do x2 <- arbitrary + x3 <- arbitrary + x1 <- arbitrary `suchThat` (> 0) + x4 <- listOf1 $ listOf1 $ arbBlock (n-1) + return $ OrderedList (x1,x2,x3) x4 ) + , (5, liftM BulletList $ (listOf1 $ listOf1 $ arbBlock (n-1))) + , (5, do items <- listOf1 $ do + x1 <- listOf1 $ listOf1 $ arbBlock (n-1) + x2 <- arbInlines (n-1) + return (x2,x1) + return $ DefinitionList items) + , (2, do rs <- choose (1 :: Int, 4) + cs <- choose (1 :: Int, 4) + x1 <- arbInlines (n-1) + x2 <- vector cs + x3 <- vectorOf cs $ elements [0, 0.25] + x4 <- vectorOf cs $ listOf $ arbBlock (n-1) + x5 <- vectorOf rs $ vectorOf cs + $ listOf $ arbBlock (n-1) + return (Table x1 x2 x3 x4 x5)) + ] + +instance Arbitrary Pandoc where + arbitrary = resize 8 $ liftM2 Pandoc arbitrary arbitrary + +instance Arbitrary CitationMode where + arbitrary + = do x <- choose (0 :: Int, 2) + case x of + 0 -> return AuthorInText + 1 -> return SuppressAuthor + 2 -> return NormalCitation + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance Arbitrary Citation where + arbitrary + = do x1 <- listOf $ elements $ ['a'..'z'] ++ ['0'..'9'] ++ ['_'] + x2 <- arbInlines 1 + x3 <- arbInlines 1 + x4 <- arbitrary + x5 <- arbitrary + x6 <- arbitrary + return (Citation x1 x2 x3 x4 x5 x6) + +instance Arbitrary MathType where + arbitrary + = do x <- choose (0 :: Int, 1) + case x of + 0 -> return DisplayMath + 1 -> return InlineMath + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance Arbitrary QuoteType where + arbitrary + = do x <- choose (0 :: Int, 1) + case x of + 0 -> return SingleQuote + 1 -> return DoubleQuote + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance Arbitrary Meta where + arbitrary + = do (x1 :: Inlines) <- arbitrary + (x2 :: [Inlines]) <- liftM (filter (not . isNull)) arbitrary + (x3 :: Inlines) <- arbitrary + return $ setMeta "title" x1 + $ setMeta "author" x2 + $ setMeta "date" x3 + $ nullMeta + +instance Arbitrary Alignment where + arbitrary + = do x <- choose (0 :: Int, 3) + case x of + 0 -> return AlignLeft + 1 -> return AlignRight + 2 -> return AlignCenter + 3 -> return AlignDefault + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance Arbitrary ListNumberStyle where + arbitrary + = do x <- choose (0 :: Int, 6) + case x of + 0 -> return DefaultStyle + 1 -> return Example + 2 -> return Decimal + 3 -> return LowerRoman + 4 -> return UpperRoman + 5 -> return LowerAlpha + 6 -> return UpperAlpha + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" + +instance Arbitrary ListNumberDelim where + arbitrary + = do x <- choose (0 :: Int, 3) + case x of + 0 -> return DefaultDelim + 1 -> return Period + 2 -> return OneParen + 3 -> return TwoParens + _ -> error "FATAL ERROR: Arbitrary instance, logic bug" diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.16.1.1/Text/Pandoc/Builder.hs new/pandoc-types-1.17.0.5/Text/Pandoc/Builder.hs --- old/pandoc-types-1.16.1.1/Text/Pandoc/Builder.hs 2016-08-20 22:37:38.000000000 +0200 +++ new/pandoc-types-1.17.0.5/Text/Pandoc/Builder.hs 2016-10-17 20:27:07.000000000 +0200 @@ -147,6 +147,7 @@ -- * Block list builders , para , plain + , lineBlock , codeBlockWith , codeBlock , rawBlock @@ -166,16 +167,14 @@ import Text.Pandoc.Definition import Data.String import Data.Monoid -import Data.Maybe (fromMaybe) import qualified Data.Map as M import Data.Sequence (Seq, (|>), viewr, viewl, ViewR(..), ViewL(..)) import qualified Data.Sequence as Seq +import Data.Traversable (Traversable) import Data.Foldable (Foldable) import qualified Data.Foldable as F -import Data.List (groupBy, intersperse) +import Data.List (groupBy) import Data.Data -import Data.Typeable -import Data.Traversable import Control.Arrow ((***)) import GHC.Generics (Generic) @@ -430,6 +429,9 @@ then mempty else singleton . Plain . toList $ ils +lineBlock :: [Inlines] -> Blocks +lineBlock = singleton . LineBlock . map toList + -- | A code block with attributes. codeBlockWith :: Attr -> String -> Blocks codeBlockWith attrs = singleton . CodeBlock attrs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.16.1.1/Text/Pandoc/Definition.hs new/pandoc-types-1.17.0.5/Text/Pandoc/Definition.hs --- old/pandoc-types-1.16.1.1/Text/Pandoc/Definition.hs 2016-08-20 22:37:38.000000000 +0200 +++ new/pandoc-types-1.17.0.5/Text/Pandoc/Definition.hs 2016-12-21 02:48:37.000000000 +0100 @@ -1,4 +1,5 @@ -{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleContexts, CPP #-} +{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric, +FlexibleContexts, GeneralizedNewtypeDeriving, PatternGuards, CPP #-} {- Copyright (c) 2006-2016, John MacFarlane @@ -74,21 +75,21 @@ import Data.Generics (Data, Typeable) import Data.Ord (comparing) -import Data.Aeson (FromJSON(..), ToJSON(..)) +import Data.Aeson hiding (Null) import qualified Data.Aeson.Types as Aeson -import Control.Monad (guard) import qualified Data.Map as M -import GHC.Generics (Generic, Rep (..)) +import GHC.Generics (Generic) import Data.String import Data.Char (toLower) -import Data.Monoid #if MIN_VERSION_base(4,8,0) import Control.DeepSeq #else +import Data.Monoid +import Control.Applicative ((<$>), (<*>)) import Control.DeepSeq.Generics #endif import Paths_pandoc_types (version) -import Data.Version (Version) +import Data.Version (Version, versionBranch) data Pandoc = Pandoc Meta [Block] deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) @@ -196,7 +197,7 @@ -- | Formats for raw blocks newtype Format = Format String - deriving (Read, Show, Typeable, Data, Generic) + deriving (Read, Show, Typeable, Data, Generic, ToJSON, FromJSON) instance IsString Format where fromString f = Format $ map toLower f @@ -211,6 +212,7 @@ data Block = Plain [Inline] -- ^ Plain text, not a paragraph | Para [Inline] -- ^ Paragraph + | LineBlock [[Inline]] -- ^ Multiple non-breaking lines | CodeBlock Attr String -- ^ Code block (literal) with attributes | RawBlock Format String -- ^ Raw block | BlockQuote [Block] -- ^ Block quote (list of blocks) @@ -280,99 +282,296 @@ data CitationMode = AuthorInText | SuppressAuthor | NormalCitation deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) --- derive generic instances of FromJSON, ToJSON: -jsonOpts :: Aeson.Options -jsonOpts = Aeson.defaultOptions{ - Aeson.fieldLabelModifier = id - , Aeson.constructorTagModifier = id - , Aeson.allNullaryToStringTag = False - , Aeson.omitNothingFields = False - , Aeson.sumEncoding = Aeson.TaggedObject "t" "c" - } - -#if MIN_VERSION_aeson(1,0,0) -toJSON' :: (Generic a, Aeson.GToJSON Aeson.Zero (Rep a)) - => a -> Aeson.Value -#else -toJSON' :: (Generic a, Aeson.GToJSON (Rep a)) - => a -> Aeson.Value -#endif -toJSON' = Aeson.genericToJSON jsonOpts +-- ToJSON/FromJSON instances. We do this by hand instead of deriving +-- from generics, so we can have more control over the format. -#if MIN_VERSION_aeson(1,0,0) -parseJSON' :: (Generic a, Aeson.GFromJSON Aeson.Zero (Rep a)) - => Aeson.Value -> Aeson.Parser a -#else -parseJSON' :: (Generic a, Aeson.GFromJSON (Rep a)) - => Aeson.Value -> Aeson.Parser a -#endif -parseJSON' = Aeson.genericParseJSON jsonOpts +taggedNoContent :: [Char] -> Value +taggedNoContent x = object [ "t" .= x ] + +tagged :: ToJSON a => [Char] -> a -> Value +tagged x y = object [ "t" .= x, "c" .= y ] -instance FromJSON MetaValue - where parseJSON = parseJSON' -instance ToJSON MetaValue - where toJSON = toJSON' - -instance FromJSON Meta - where parseJSON = parseJSON' -instance ToJSON Meta - where toJSON = toJSON' - -instance FromJSON CitationMode - where parseJSON = parseJSON' -instance ToJSON CitationMode - where toJSON = toJSON' - -instance FromJSON Citation - where parseJSON = parseJSON' -instance ToJSON Citation - where toJSON = toJSON' - -instance FromJSON QuoteType - where parseJSON = parseJSON' -instance ToJSON QuoteType - where toJSON = toJSON' - -instance FromJSON MathType - where parseJSON = parseJSON' -instance ToJSON MathType - where toJSON = toJSON' - -instance FromJSON ListNumberStyle - where parseJSON = parseJSON' -instance ToJSON ListNumberStyle - where toJSON = toJSON' - -instance FromJSON ListNumberDelim - where parseJSON = parseJSON' -instance ToJSON ListNumberDelim - where toJSON = toJSON' - -instance FromJSON Alignment - where parseJSON = parseJSON' -instance ToJSON Alignment - where toJSON = toJSON' - -instance FromJSON Format - where parseJSON = parseJSON' -instance ToJSON Format - where toJSON = toJSON' - -instance FromJSON Inline - where parseJSON = parseJSON' -instance ToJSON Inline - where toJSON = toJSON' - -instance FromJSON Block - where parseJSON = parseJSON' -instance ToJSON Block - where toJSON = toJSON' - -instance FromJSON Pandoc - where parseJSON = parseJSON' -instance ToJSON Pandoc - where toJSON = toJSON' +instance FromJSON MetaValue where + parseJSON (Object v) = do + t <- v .: "t" :: Aeson.Parser Value + case t of + "MetaMap" -> MetaMap <$> (v .: "c") + "MetaList" -> MetaList <$> (v .: "c") + "MetaBool" -> MetaBool <$> (v .: "c") + "MetaString" -> MetaString <$> (v .: "c") + "MetaInlines" -> MetaInlines <$> (v .: "c") + "MetaBlocks" -> MetaBlocks <$> (v .: "c") + _ -> mempty + parseJSON _ = mempty +instance ToJSON MetaValue where + toJSON (MetaMap mp) = tagged "MetaMap" mp + toJSON (MetaList lst) = tagged "MetaList" lst + toJSON (MetaBool bool) = tagged "MetaBool" bool + toJSON (MetaString s) = tagged "MetaString" s + toJSON (MetaInlines ils) = tagged "MetaInlines" ils + toJSON (MetaBlocks blks) = tagged "MetaBlocks" blks + +instance FromJSON Meta where + parseJSON j = Meta <$> parseJSON j +instance ToJSON Meta where + toJSON meta = toJSON $ unMeta meta + +instance FromJSON CitationMode where + parseJSON (Object v) = do + t <- v .: "t" :: Aeson.Parser Value + case t of + "AuthorInText" -> return AuthorInText + "SuppressAuthor" -> return SuppressAuthor + "NormalCitation" -> return NormalCitation + _ -> mempty + parseJSON _ = mempty +instance ToJSON CitationMode where + toJSON cmode = taggedNoContent s + where s = case cmode of + AuthorInText -> "AuthorInText" + SuppressAuthor -> "SuppressAuthor" + NormalCitation -> "NormalCitation" + + +instance FromJSON Citation where + parseJSON (Object v) = do + citationId' <- v .: "citationId" + citationPrefix' <- v .: "citationPrefix" + citationSuffix' <- v .: "citationSuffix" + citationMode' <- v .: "citationMode" + citationNoteNum' <- v .: "citationNoteNum" + citationHash' <- v .: "citationHash" + return Citation { citationId = citationId' + , citationPrefix = citationPrefix' + , citationSuffix = citationSuffix' + , citationMode = citationMode' + , citationNoteNum = citationNoteNum' + , citationHash = citationHash' + } + parseJSON _ = mempty +instance ToJSON Citation where + toJSON cit = + object [ "citationId" .= citationId cit + , "citationPrefix" .= citationPrefix cit + , "citationSuffix" .= citationSuffix cit + , "citationMode" .= citationMode cit + , "citationNoteNum" .= citationNoteNum cit + , "citationHash" .= citationHash cit + ] + +instance FromJSON QuoteType where + parseJSON (Object v) = do + t <- v .: "t" :: Aeson.Parser Value + case t of + "SingleQuote" -> return SingleQuote + "DoubleQuote" -> return DoubleQuote + _ -> mempty + parseJSON _ = mempty +instance ToJSON QuoteType where + toJSON qtype = taggedNoContent s + where s = case qtype of + SingleQuote -> "SingleQuote" + DoubleQuote -> "DoubleQuote" + + +instance FromJSON MathType where + parseJSON (Object v) = do + t <- v .: "t" :: Aeson.Parser Value + case t of + "DisplayMath" -> return DisplayMath + "InlineMath" -> return InlineMath + _ -> mempty + parseJSON _ = mempty +instance ToJSON MathType where + toJSON mtype = taggedNoContent s + where s = case mtype of + DisplayMath -> "DisplayMath" + InlineMath -> "InlineMath" + +instance FromJSON ListNumberStyle where + parseJSON (Object v) = do + t <- v .: "t" :: Aeson.Parser Value + case t of + "DefaultStyle" -> return DefaultStyle + "Example" -> return Example + "Decimal" -> return Decimal + "LowerRoman" -> return LowerRoman + "UpperRoman" -> return UpperRoman + "LowerAlpha" -> return LowerAlpha + "UpperAlpha" -> return UpperAlpha + _ -> mempty + parseJSON _ = mempty +instance ToJSON ListNumberStyle where + toJSON lsty = taggedNoContent s + where s = case lsty of + DefaultStyle -> "DefaultStyle" + Example -> "Example" + Decimal -> "Decimal" + LowerRoman -> "LowerRoman" + UpperRoman -> "UpperRoman" + LowerAlpha -> "LowerAlpha" + UpperAlpha -> "UpperAlpha" + +instance FromJSON ListNumberDelim where + parseJSON (Object v) = do + t <- v .: "t" :: Aeson.Parser Value + case t of + "DefaultDelim" -> return DefaultDelim + "Period" -> return Period + "OneParen" -> return OneParen + "TwoParens" -> return TwoParens + _ -> mempty + parseJSON _ = mempty +instance ToJSON ListNumberDelim where + toJSON delim = taggedNoContent s + where s = case delim of + DefaultDelim -> "DefaultDelim" + Period -> "Period" + OneParen -> "OneParen" + TwoParens -> "TwoParens" + +instance FromJSON Alignment where + parseJSON (Object v) = do + t <- v .: "t" :: Aeson.Parser Value + case t of + "AlignLeft" -> return AlignLeft + "AlignRight" -> return AlignRight + "AlignCenter" -> return AlignCenter + "AlignDefault" -> return AlignDefault + _ -> mempty + parseJSON _ = mempty +instance ToJSON Alignment where + toJSON delim = taggedNoContent s + where s = case delim of + AlignLeft -> "AlignLeft" + AlignRight -> "AlignRight" + AlignCenter -> "AlignCenter" + AlignDefault -> "AlignDefault" + + +instance FromJSON Inline where + parseJSON (Object v) = do + t <- v .: "t" :: Aeson.Parser Value + case t of + "Str" -> Str <$> v .: "c" + "Emph" -> Emph <$> v .: "c" + "Strong" -> Strong <$> v .: "c" + "Strikeout" -> Strikeout <$> v .: "c" + "Superscript" -> Superscript <$> v .: "c" + "Subscript" -> Subscript <$> v .: "c" + "SmallCaps" -> SmallCaps <$> v .: "c" + "Quoted" -> do (qt, ils) <- v .: "c" + return $ Quoted qt ils + "Cite" -> do (cits, ils) <- v .: "c" + return $ Cite cits ils + "Code" -> do (attr, s) <- v .: "c" + return $ Code attr s + "Space" -> return Space + "SoftBreak" -> return SoftBreak + "LineBreak" -> return LineBreak + "Math" -> do (mtype, s) <- v .: "c" + return $ Math mtype s + "RawInline" -> do (fmt, s) <- v .: "c" + return $ RawInline fmt s + "Link" -> do (attr, ils, tgt) <- v .: "c" + return $ Link attr ils tgt + "Image" -> do (attr, ils, tgt) <- v .: "c" + return $ Image attr ils tgt + "Note" -> Note <$> v .: "c" + "Span" -> do (attr, ils) <- v .: "c" + return $ Span attr ils + _ -> mempty + parseJSON _ = mempty + +instance ToJSON Inline where + toJSON (Str s) = tagged "Str" s + toJSON (Emph ils) = tagged "Emph" ils + toJSON (Strong ils) = tagged "Strong" ils + toJSON (Strikeout ils) = tagged "Strikeout" ils + toJSON (Superscript ils) = tagged "Superscript" ils + toJSON (Subscript ils) = tagged "Subscript" ils + toJSON (SmallCaps ils) = tagged "SmallCaps" ils + toJSON (Quoted qtype ils) = tagged "Quoted" (qtype, ils) + toJSON (Cite cits ils) = tagged "Cite" (cits, ils) + toJSON (Code attr s) = tagged "Code" (attr, s) + toJSON Space = taggedNoContent "Space" + toJSON SoftBreak = taggedNoContent "SoftBreak" + toJSON LineBreak = taggedNoContent "LineBreak" + toJSON (Math mtype s) = tagged "Math" (mtype, s) + toJSON (RawInline fmt s) = tagged "RawInline" (fmt, s) + toJSON (Link attr ils target) = tagged "Link" (attr, ils, target) + toJSON (Image attr ils target) = tagged "Image" (attr, ils, target) + toJSON (Note blks) = tagged "Note" blks + toJSON (Span attr ils) = tagged "Span" (attr, ils) + +instance FromJSON Block where + parseJSON (Object v) = do + t <- v .: "t" :: Aeson.Parser Value + case t of + "Plain" -> Plain <$> v .: "c" + "Para" -> Para <$> v .: "c" + "LineBlock" -> LineBlock <$> v .: "c" + "CodeBlock" -> do (attr, s) <- v .: "c" + return $ CodeBlock attr s + "RawBlock" -> do (fmt, s) <- v .: "c" + return $ RawBlock fmt s + "BlockQuote" -> BlockQuote <$> v .: "c" + "OrderedList" -> do (attr, items) <- v .: "c" + return $ OrderedList attr items + "BulletList" -> BulletList <$> v .: "c" + "DefinitionList" -> DefinitionList <$> v .: "c" + "Header" -> do (n, attr, ils) <- v .: "c" + return $ Header n attr ils + "HorizontalRule" -> return $ HorizontalRule + "Table" -> do (cpt, align, wdths, hdr, rows) <- v .: "c" + return $ Table cpt align wdths hdr rows + "Div" -> do (attr, blks) <- v .: "c" + return $ Div attr blks + "Null" -> return $ Null + _ -> mempty + parseJSON _ = mempty +instance ToJSON Block where + toJSON (Plain ils) = tagged "Plain" ils + toJSON (Para ils) = tagged "Para" ils + toJSON (LineBlock lns) = tagged "LineBlock" lns + toJSON (CodeBlock attr s) = tagged "CodeBlock" (attr, s) + toJSON (RawBlock fmt s) = tagged "RawBlock" (fmt, s) + toJSON (BlockQuote blks) = tagged "BlockQuote" blks + toJSON (OrderedList listAttrs blksList) = tagged "OrderedList" (listAttrs, blksList) + toJSON (BulletList blksList) = tagged "BulletList" blksList + toJSON (DefinitionList defs) = tagged "DefinitionList" defs + toJSON (Header n attr ils) = tagged "Header" (n, attr, ils) + toJSON HorizontalRule = taggedNoContent "HorizontalRule" + toJSON (Table caption aligns widths cells rows) = + tagged "Table" (caption, aligns, widths, cells, rows) + toJSON (Div attr blks) = tagged "Div" (attr, blks) + toJSON Null = taggedNoContent "Null" + +instance FromJSON Pandoc where + parseJSON (Object v) = do + mbJVersion <- v .:? "pandoc-api-version" :: Aeson.Parser (Maybe [Int]) + case mbJVersion of + Just jVersion | x : y : _ <- jVersion + , x' : y' : _ <- versionBranch pandocTypesVersion + , x == x' + , y == y' -> Pandoc <$> v .: "meta" <*> v .: "blocks" + | otherwise -> + fail $ mconcat [ "Incompatible API versions: " + , "encoded with " + , show jVersion + , " but attempted to decode with " + , show $ versionBranch pandocTypesVersion + , "." + ] + _ -> fail "JSON missing pandoc-api-version." + parseJSON _ = mempty +instance ToJSON Pandoc where + toJSON (Pandoc meta blks) = + object [ "pandoc-api-version" .= versionBranch pandocTypesVersion + , "meta" .= meta + , "blocks" .= blks + ] -- Instances for deepseq #if MIN_VERSION_base(4,8,0) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.16.1.1/Text/Pandoc/Generic.hs new/pandoc-types-1.17.0.5/Text/Pandoc/Generic.hs --- old/pandoc-types-1.16.1.1/Text/Pandoc/Generic.hs 2016-08-20 22:37:38.000000000 +0200 +++ new/pandoc-types-1.17.0.5/Text/Pandoc/Generic.hs 2016-10-17 20:27:07.000000000 +0200 @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {- Copyright (c) 2006-2016, John MacFarlane @@ -119,7 +120,10 @@ module Text.Pandoc.Generic where import Data.Generics +#if MIN_VERSION_base(4,8,0) +#else import Data.Monoid +#endif -- | Applies a transformation on @a@s to matching elements in a @b@, -- moving from the bottom of the structure up. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.16.1.1/Text/Pandoc/JSON.hs new/pandoc-types-1.17.0.5/Text/Pandoc/JSON.hs --- old/pandoc-types-1.16.1.1/Text/Pandoc/JSON.hs 2016-08-20 22:37:38.000000000 +0200 +++ new/pandoc-types-1.17.0.5/Text/Pandoc/JSON.hs 2016-10-01 23:07:37.000000000 +0200 @@ -77,7 +77,6 @@ import Text.Pandoc.Generic import Data.Maybe (listToMaybe) import Data.Data -import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Aeson import System.Environment (getArgs) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.16.1.1/Text/Pandoc/Walk.hs new/pandoc-types-1.17.0.5/Text/Pandoc/Walk.hs --- old/pandoc-types-1.16.1.1/Text/Pandoc/Walk.hs 2016-08-20 22:37:38.000000000 +0200 +++ new/pandoc-types-1.17.0.5/Text/Pandoc/Walk.hs 2016-10-26 22:08:11.000000000 +0200 @@ -1,4 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, CPP #-} +#if MIN_VERSION_base(4,9,0) +{-# OPTIONS_GHC -fno-warn-redundant-constraints #-} +#endif #if MIN_VERSION_base(4,8,0) #define OVERLAPS {-# OVERLAPPING #-} #else @@ -86,16 +89,17 @@ module Text.Pandoc.Walk (Walkable(..)) where -import Control.Applicative ((<$>), (<*>)) +import Control.Applicative ((<$>)) import Text.Pandoc.Definition import Text.Pandoc.Builder ((<>)) import qualified Data.Traversable as T -import Data.Traversable (Traversable, traverse) +import Data.Traversable (Traversable) import qualified Data.Foldable as F -import Data.Foldable (Foldable, foldMap) -import qualified Data.Map as M +import Data.Foldable (Foldable) +#if MIN_VERSION_base(4,8,0) +#else import Data.Monoid - +#endif class Walkable a b where -- | @walk f x@ walks the structure @x@ (bottom up) and replaces every @@ -186,53 +190,57 @@ instance Walkable Inline Block where walk f (Para xs) = Para $ walk f xs walk f (Plain xs) = Plain $ walk f xs - walk f (CodeBlock attr s) = CodeBlock attr s - walk f (RawBlock t s) = RawBlock t s + 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 f HorizontalRule = HorizontalRule + 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 f Null = Null + walk _ Null = Null walkM f (Para xs) = Para <$> walkM f xs walkM f (Plain xs) = Plain <$> walkM f xs - walkM f (CodeBlock attr s) = return $ CodeBlock attr s - walkM f (RawBlock t s) = return $ RawBlock t s + 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 f HorizontalRule = return HorizontalRule + 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 f Null = return Null + walkM _ Null = return Null query f (Para xs) = query f xs query f (Plain xs) = query f xs - query f (CodeBlock attr s) = mempty - query f (RawBlock t s) = mempty + query f (LineBlock xs) = query f xs + query _ (CodeBlock _ _) = mempty + query _ (RawBlock _ _) = mempty query f (BlockQuote bs) = query f bs - query f (OrderedList a cs) = query f cs + query f (OrderedList _ cs) = query f cs query f (BulletList cs) = query f cs query f (DefinitionList xs) = query f xs - query f (Header lev attr xs) = query f xs - query f HorizontalRule = mempty - query f (Table capt as ws hs rs) = query f capt <> query f hs <> query f rs - query f (Div attr bs) = query f bs - query f Null = mempty + 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 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 @@ -244,10 +252,11 @@ 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 f Null = Null + 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 @@ -265,6 +274,7 @@ 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 @@ -279,7 +289,7 @@ query f Null = f Null instance Walkable Block Inline where - walk f (Str xs) = Str xs + 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) @@ -288,18 +298,18 @@ 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 f (Code attr s) = Code attr s - walk f Space = Space - walk f SoftBreak = SoftBreak - walk f LineBreak = LineBreak - walk f (Math mt s) = Math mt s - walk f (RawInline t s) = RawInline t s + 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 f (Str xs) = return $ Str 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 @@ -310,36 +320,36 @@ walkM f (Cite cs xs) = do cs' <- walkM f cs xs' <- walkM f xs return $ Cite cs' xs' - walkM f (Code attr s) = return $ Code attr s - walkM f Space = return $ Space - walkM f SoftBreak = return $ SoftBreak - walkM f LineBreak = return $ LineBreak - walkM f (Math mt s) = return $ Math mt s - walkM f (RawInline t s) = return $ RawInline t s + 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 f (Str xs) = mempty + 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 qt xs) = query f xs + query f (Quoted _ xs) = query f xs query f (Cite cs xs) = query f cs <> query f xs - query f (Code attr s) = mempty - query f Space = mempty - query f SoftBreak = mempty - query f LineBreak = mempty - query f (Math mt s) = mempty - query f (RawInline t s) = mempty - query f (Link atr xs t) = query f xs - query f (Image atr xs t)= 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 attr xs) = query f xs + query f (Span _ xs) = query f xs instance Walkable Block Pandoc where walk f (Pandoc m bs) = Pandoc (walk f m) (walk f bs) @@ -377,44 +387,44 @@ instance Walkable Inline MetaValue where walk f (MetaList xs) = MetaList $ walk f xs - walk f (MetaBool b) = MetaBool b - walk f (MetaString s) = MetaString s + 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 f (MetaBool b) = return $ MetaBool b - walkM f (MetaString s) = return $ MetaString s + 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 f (MetaBool b) = mempty - query f (MetaString s) = mempty + 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 instance Walkable Block MetaValue where walk f (MetaList xs) = MetaList $ walk f xs - walk f (MetaBool b) = MetaBool b - walk f (MetaString s) = MetaString s + 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 f (MetaBool b) = return $ MetaBool b - walkM f (MetaString s) = return $ MetaString s + 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 f (MetaBool b) = mempty - query f (MetaString s) = mempty + 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 @@ -426,7 +436,7 @@ do pref' <- walkM f pref suff' <- walkM f suff return $ Citation id' pref' suff' mode notenum hash - query f (Citation id' pref suff mode notenum hash) = + query f (Citation _ pref suff _ _ _) = query f pref <> query f suff instance Walkable Block Citation where @@ -436,5 +446,5 @@ do pref' <- walkM f pref suff' <- walkM f suff return $ Citation id' pref' suff' mode notenum hash - query f (Citation id' pref suff mode notenum hash) = + query f (Citation _ pref suff _ _ _) = query f pref <> query f suff diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.16.1.1/changelog new/pandoc-types-1.17.0.5/changelog --- old/pandoc-types-1.16.1.1/changelog 2016-08-20 22:37:38.000000000 +0200 +++ new/pandoc-types-1.17.0.5/changelog 2017-01-16 08:29:49.000000000 +0100 @@ -1,3 +1,60 @@ +[1.17.0.5] + + * Allow aeson 1.1. + * Added tests for Walk (originally from pandoc). + * Renamed README -> README.md, fix link (Kolen Cheung). + +[1.17.0.4] + + * Re-add Functor constraint to walkM, needed for ghc 7.8. + * Turn off redundant-constraints warning for Walk (for ghc 8.0.1+). + * Added necessary Data.Traversable import. + * Allow HUnit 1.5. + +[1.17.0.3] + + * More ghc 7.8 compatibility imports. + +[1.17.0.2] + + * Added a necessary import from Data.Monoid (for ghc 7.8). + +[1.17.0.1] + + * Fix compiler warnings around Data.Monoid import on some platforms. + +[1.17] + + * Remimplement json encoding of inlines manually (Jesse Rosenthal). + This is the first step to doing manual encoding and decoding of pandoc + JSON. This will replace the current generic deriving, which can be a + moving target. + * Move Arbitrary instances for types from pandoc (Jesse Rosenthal). + * Remove empty arrays for leaf elements (Jesse Rosenthal). + Elements with no children (Space, SoftBreak, LineBreak, HorizontalRule, + Null) previously had an empty array for their "c" value. We remove that + here. This is a breaking change for the JSON format. + * New toplevel JSON format with api-version (Jesse Rosenthal). The version + number is the pandoc-types version. The toplevel format was previously: + + [{"unMeta": META}, [BLOCKS]] + + It is now: + + { + "pandoc-api-version" : [MAJ, MIN, REV], + "meta" : META, + "blocks": BLOCKS + } + + Decoding fails if the major and minor version numbers don't match. + * Add simple quickcheck tests to verify that roundtrip works properly + (Jesse Rosenthal). + * Add a LineBlock block element (Albert Krewinkel). + * Add explicit unit tests for encoding and decoding (Jesse Rosenthal). + * Fixed warnings in Walk, Builder. + * Test with travis and appveyor. + [1.16.1.1] * Allow aeson 1.0.*. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.16.1.1/pandoc-types.cabal new/pandoc-types-1.17.0.5/pandoc-types.cabal --- old/pandoc-types-1.16.1.1/pandoc-types.cabal 2016-08-20 22:37:38.000000000 +0200 +++ new/pandoc-types-1.17.0.5/pandoc-types.cabal 2017-01-16 08:28:31.000000000 +0100 @@ -1,5 +1,5 @@ Name: pandoc-types -Version: 1.16.1.1 +Version: 1.17.0.5 Synopsis: Types for representing a structured document Description: @Text.Pandoc.Definition@ defines the 'Pandoc' data structure, which is used by pandoc to represent @@ -31,8 +31,8 @@ Copyright: (c) 2006-2015 John MacFarlane Category: Text Build-type: Simple -Cabal-version: >=1.6 -Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2 +Cabal-version: >=1.8 +Tested-With: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 Extra-Source-Files: changelog Source-repository head type: git @@ -44,14 +44,34 @@ Text.Pandoc.Walk Text.Pandoc.Builder Text.Pandoc.JSON + Text.Pandoc.Arbitrary Other-modules: Paths_pandoc_types Build-depends: base >= 4 && < 5, containers >= 0.3, syb >= 0.1 && < 0.7, ghc-prim >= 0.2, bytestring >= 0.9 && < 0.11, - aeson >= 0.6.2 && < 1.1 + aeson >= 0.6.2 && < 1.2, + QuickCheck >= 2 if impl(ghc < 7.10) Build-depends: deepseq-generics >= 0.1 && < 0.2 else Build-depends: deepseq >= 1.4.1 && < 1.5 + +test-suite test-pandoc-types + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: test-pandoc-types.hs + build-depends: base, + pandoc-types, + syb, + aeson >= 0.6.2 && < 1.2, + 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, + string-qq == 0.0.2 + ghc-options: -threaded -rtsopts -with-rtsopts=-N diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/pandoc-types-1.16.1.1/test/test-pandoc-types.hs new/pandoc-types-1.17.0.5/test/test-pandoc-types.hs --- old/pandoc-types-1.16.1.1/test/test-pandoc-types.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/pandoc-types-1.17.0.5/test/test-pandoc-types.hs 2017-01-16 08:25:44.000000000 +0100 @@ -0,0 +1,404 @@ +{-# LANGUAGE OverloadedStrings, QuasiQuotes, FlexibleContexts #-} + +import Text.Pandoc.Definition +import Text.Pandoc.Walk +import Text.Pandoc.Arbitrary() +import Data.Generics +import Test.HUnit (Assertion, assertEqual, assertFailure) +import Text.Pandoc.Arbitrary () +import Data.Char (toUpper) +import Data.Aeson (FromJSON, ToJSON, encode, decode) +import Test.Framework +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.Framework.Providers.HUnit (testCase) +import qualified Data.Map as M +import Data.String.QQ +import Data.ByteString.Lazy (ByteString) + +p_walk :: (Typeable a, Walkable a Pandoc) + => (a -> a) -> Pandoc -> Bool +p_walk f d = everywhere (mkT f) d == walk f d + +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 + +inlineTrans :: Inline -> Inline +inlineTrans (Str xs) = Str $ map toUpper xs +inlineTrans (Emph xs) = Strong xs +inlineTrans x = x + +blockTrans :: Block -> Block +blockTrans (Plain xs) = Para xs +blockTrans (BlockQuote xs) = Div ("",["special"],[]) xs +blockTrans x = x + +inlineQuery :: Inline -> String +inlineQuery (Str xs) = xs +inlineQuery _ = "" + +blockQuery :: Block -> [Int] +blockQuery (Header lev _ _) = [lev] +blockQuery _ = [] + + +prop_roundtrip :: Pandoc -> Bool +prop_roundtrip doc = case decode $ encode doc :: (Maybe Pandoc) of + Just doc' -> doc == doc' + _ -> False + +testEncode :: ToJSON a => (a, ByteString) -> Assertion +testEncode (doc, j) = assertEqual "Encoding error" (encode doc) j + +testDecode' :: FromJSON a => (a, ByteString) -> Maybe a +testDecode' (_, j) = decode j + +testDecode :: (Show a, Eq a, FromJSON a) => (a, ByteString) -> Assertion +testDecode (doc, j) = + case testDecode' (doc, j) of + Just doc' -> assertEqual "Decoding error" doc' doc + Nothing -> assertFailure "Decoding error" + +testEncodeDecode :: (Show a, Eq a, ToJSON a, FromJSON a) + => String + -> (a, ByteString) + -> Test +testEncodeDecode msg pair = testGroup msg [ testCase "Encoding" $ testEncode pair + , testCase "Decoding" $ testDecode pair + ] + +t_metamap :: (MetaValue, ByteString) +t_metamap = ( MetaMap $ + M.fromList [("foo", MetaBool True)] + , [s|{"t":"MetaMap","c":{"foo":{"t":"MetaBool","c":true}}}|] + ) + +t_metalist :: (MetaValue, ByteString) +t_metalist = ( MetaList [MetaBool True, MetaString "baz"] + , [s|{"t":"MetaList","c":[{"t":"MetaBool","c":true},{"t":"MetaString","c":"baz"}]}|] + ) + +t_metabool :: (MetaValue, ByteString) +t_metabool = ( MetaBool False, [s|{"t":"MetaBool","c":false}|] ) + +t_metastring :: (MetaValue, ByteString) +t_metastring = ( MetaString "Hello", [s|{"t":"MetaString","c":"Hello"}|] ) + +t_metainlines :: (MetaValue, ByteString) +t_metainlines = ( MetaInlines [Space, SoftBreak] + , [s|{"t":"MetaInlines","c":[{"t":"Space"},{"t":"SoftBreak"}]}|] + ) + +t_metablocks :: (MetaValue, ByteString) +t_metablocks = ( MetaBlocks [Null,Null], [s|{"t":"MetaBlocks","c":[{"t":"Null"},{"t":"Null"}]}|]) + +t_singlequote :: (QuoteType, ByteString) +t_singlequote = (SingleQuote, [s|{"t":"SingleQuote"}|]) + +t_doublequote :: (QuoteType, ByteString) +t_doublequote = (DoubleQuote, [s|{"t":"DoubleQuote"}|]) + +t_authorintext :: (CitationMode, ByteString) +t_authorintext = (AuthorInText, [s|{"t":"AuthorInText"}|]) + +t_suppressauthor :: (CitationMode, ByteString) +t_suppressauthor = (SuppressAuthor, [s|{"t":"SuppressAuthor"}|]) + +t_normalcitation :: (CitationMode, ByteString) +t_normalcitation = (NormalCitation, [s|{"t":"NormalCitation"}|]) + +t_citation :: (Citation, ByteString) +t_citation = ( Citation { citationId = "jameson:unconscious", + citationPrefix = [Str "cf"], + citationSuffix = [Space,Str "123"], + citationMode = NormalCitation, + citationNoteNum = 0, + citationHash = 0} + , [s|{"citationSuffix":[{"t":"Space"},{"t":"Str","c":"123"}],"citationNoteNum":0,"citationMode":{"t":"NormalCitation"},"citationPrefix":[{"t":"Str","c":"cf"}],"citationId":"jameson:unconscious","citationHash":0}|] + ) + +t_displaymath :: (MathType, ByteString) +t_displaymath = ( DisplayMath, [s|{"t":"DisplayMath"}|]) + +t_inlinemath :: (MathType, ByteString) +t_inlinemath = ( InlineMath, [s|{"t":"InlineMath"}|]) + + +t_str :: (Inline, ByteString) +t_str = ( Str "Hello" + , [s|{"t":"Str","c":"Hello"}|] + ) + +t_emph :: (Inline, ByteString) +t_emph = ( Emph [Str "Hello"] + , [s|{"t":"Emph","c":[{"t":"Str","c":"Hello"}]}|] + ) + +t_strong :: (Inline, ByteString) +t_strong = ( Strong [Str "Hello"] + , [s|{"t":"Strong","c":[{"t":"Str","c":"Hello"}]}|] + ) + +t_strikeout :: (Inline, ByteString) +t_strikeout = ( Strikeout [Str "Hello"] + , [s|{"t":"Strikeout","c":[{"t":"Str","c":"Hello"}]}|] + ) + +t_superscript :: (Inline, ByteString) +t_superscript = ( Superscript [Str "Hello"] + , [s|{"t":"Superscript","c":[{"t":"Str","c":"Hello"}]}|] + ) + +t_subscript :: (Inline, ByteString) +t_subscript = ( Subscript [Str "Hello"] + , [s|{"t":"Subscript","c":[{"t":"Str","c":"Hello"}]}|] + ) + +t_smallcaps :: (Inline, ByteString) +t_smallcaps = ( SmallCaps [Str "Hello"] + , [s|{"t":"SmallCaps","c":[{"t":"Str","c":"Hello"}]}|] + ) + +t_quoted :: (Inline, ByteString) +t_quoted = ( Quoted SingleQuote [Str "Hello"] + , [s|{"t":"Quoted","c":[{"t":"SingleQuote"},[{"t":"Str","c":"Hello"}]]}|] + ) + +t_cite :: (Inline, ByteString) +t_cite = ( Cite [Citation { citationId = "jameson:unconscious" + , citationPrefix = [Str "cf"] + , citationSuffix = [Space,Str "12"] + , citationMode = NormalCitation + , citationNoteNum = 0 + , citationHash = 0}] + [ Str "[cf" + , Space + , Str "@jameson:unconscious" + , Space + , Str "12]"] + ,[s|{"t":"Cite","c":[[{"citationSuffix":[{"t":"Space"},{"t":"Str","c":"12"}],"citationNoteNum":0,"citationMode":{"t":"NormalCitation"},"citationPrefix":[{"t":"Str","c":"cf"}],"citationId":"jameson:unconscious","citationHash":0}],[{"t":"Str","c":"[cf"},{"t":"Space"},{"t":"Str","c":"@jameson:unconscious"},{"t":"Space"},{"t":"Str","c":"12]"}]]}|] + ) + +t_code :: (Inline, ByteString) +t_code = ( Code ("", [], [("language", "haskell")]) "foo bar" + , [s|{"t":"Code","c":[["",[],[["language","haskell"]]],"foo bar"]}|] + ) + +t_space :: (Inline, ByteString) +t_space = ( Space, [s|{"t":"Space"}|] ) + +t_softbreak :: (Inline, ByteString) +t_softbreak = ( SoftBreak, [s|{"t":"SoftBreak"}|] ) + +t_linebreak :: (Inline, ByteString) +t_linebreak = ( LineBreak, [s|{"t":"LineBreak"}|] ) + +t_rawinline :: (Inline, ByteString) +t_rawinline = ( RawInline (Format "tex") "\\foo{bar}" + , [s|{"t":"RawInline","c":["tex","\\foo{bar}"]}|] + ) + +t_link :: (Inline, ByteString) +t_link = ( Link ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) + [ Str "a", Space, Str "famous", Space, Str "site"] + ("https://www.google.com","google";) + , [s|{"t":"Link","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Str","c":"a"},{"t":"Space"},{"t":"Str","c":"famous"},{"t":"Space"},{"t":"Str","c":"site"}],["https://www.google.com","google"]]}|] + ) + +t_image :: (Inline, ByteString) +t_image = ( Image ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) + [ Str "a", Space, Str "famous", Space, Str "image"] + ("my_img.png","image") + , [s|{"t":"Image","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Str","c":"a"},{"t":"Space"},{"t":"Str","c":"famous"},{"t":"Space"},{"t":"Str","c":"image"}],["my_img.png","image"]]}|] + ) + +t_note :: (Inline, ByteString) +t_note = ( Note [Para [Str "Hello"]] + , [s|{"t":"Note","c":[{"t":"Para","c":[{"t":"Str","c":"Hello"}]}]}|] + ) + +t_span :: (Inline, ByteString) +t_span = ( Span ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) [Str "Hello"] + , [s|{"t":"Span","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Str","c":"Hello"}]]}|] + ) + +t_plain :: (Block, ByteString) +t_plain = ( Plain [Str "Hello"] + , [s|{"t":"Plain","c":[{"t":"Str","c":"Hello"}]}|] + ) + +t_para :: (Block, ByteString) +t_para = ( Para [Str "Hello"] + , [s|{"t":"Para","c":[{"t":"Str","c":"Hello"}]}|] + ) + +t_lineblock :: (Block, ByteString) +t_lineblock = ( LineBlock [[Str "Hello"], [Str "Moin"]] + , [s|{"t":"LineBlock","c":[[{"t":"Str","c":"Hello"}],[{"t":"Str","c":"Moin"}]]}|] + ) + +t_codeblock :: (Block, ByteString) +t_codeblock = ( CodeBlock ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) "Foo Bar" + , [s|{"t":"CodeBlock","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],"Foo Bar"]}|] + ) + +t_rawblock :: (Block, ByteString) +t_rawblock = ( RawBlock (Format "tex") "\\foo{bar}" + , [s|{"t":"RawBlock","c":["tex","\\foo{bar}"]}|] + ) + +t_blockquote :: (Block, ByteString) +t_blockquote = ( BlockQuote [Para [Str "Hello"]] + , [s|{"t":"BlockQuote","c":[{"t":"Para","c":[{"t":"Str","c":"Hello"}]}]}|] + ) + +t_orderedlist :: (Block, ByteString) +t_orderedlist = (OrderedList (1,Decimal,Period) + [[Para [Str "foo"]] + ,[Para [Str "bar"]]] + , [s|{"t":"OrderedList","c":[[1,{"t":"Decimal"},{"t":"Period"}],[[{"t":"Para","c":[{"t":"Str","c":"foo"}]}],[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]]}|] + ) + +t_bulletlist :: (Block, ByteString) +t_bulletlist = (BulletList + [[Para [Str "foo"]] + ,[Para [Str "bar"]]] + , [s|{"t":"BulletList","c":[[{"t":"Para","c":[{"t":"Str","c":"foo"}]}],[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]}|] + ) + +t_definitionlist :: (Block, ByteString) +t_definitionlist = (DefinitionList + [([Str "foo"], + [[Para [Str "bar"]]]) + ,([Str "fizz"], + [[Para [Str "pop"]]])] + , [s|{"t":"DefinitionList","c":[[[{"t":"Str","c":"foo"}],[[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]],[[{"t":"Str","c":"fizz"}],[[{"t":"Para","c":[{"t":"Str","c":"pop"}]}]]]]}|] + ) + +t_header :: (Block, ByteString) +t_header = ( Header 2 ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) [Str "Head"] + , [s|{"t":"Header","c":[2,["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Str","c":"Head"}]]}|] + ) + +t_table :: (Block, ByteString) +t_table = ( Table + [Str "Demonstration" + ,Space + ,Str "of" + ,Space + ,Str "simple" + ,Space + ,Str "table" + ,Space + ,Str "syntax."] + [AlignRight + ,AlignLeft + ,AlignCenter + ,AlignDefault] + [0.0,0.0,0.0,0.0] + [[Plain [Str "Right"]] + ,[Plain [Str "Left"]] + ,[Plain [Str "Center"]] + ,[Plain [Str "Default"]]] + [[[Plain [Str "12"]] + ,[Plain [Str "12"]] + ,[Plain [Str "12"]] + ,[Plain [Str "12"]]] + ,[[Plain [Str "123"]] + ,[Plain [Str "123"]] + ,[Plain [Str "123"]] + ,[Plain [Str "123"]]] + ,[[Plain [Str "1"]] + ,[Plain [Str "1"]] + ,[Plain [Str "1"]] + ,[Plain [Str "1"]]]] + , + [s|{"t":"Table","c":[[{"t":"Str","c":"Demonstration"},{"t":"Space"},{"t":"Str","c":"of"},{"t":"Space"},{"t":"Str","c":"simple"},{"t":"Space"},{"t":"Str","c":"table"},{"t":"Space"},{"t":"Str","c":"syntax."}],[{"t":"AlignRight"},{"t":"AlignLeft"},{"t":"AlignCenter"},{"t":"AlignDefault"}],[0,0,0,0],[[{"t":"Plain","c":[{"t":"Str","c":"Right"}]}],[{"t":"Plain","c":[{"t":"Str","c":"Left"}]}],[{"t":"Plain","c":[{"t":"Str","c":"Center"}]}],[{"t":"Plain","c":[{"t":"Str","c":"Default"}]}]],[[[{"t":"Plain","c":[{"t":"Str","c":"12"}]}],[{"t":"Plain","c":[{"t":"Str","c":"12"}]}],[{"t":"Plain","c":[{"t":"Str","c":"12"}]}],[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]],[[{"t":"Plain","c":[{"t":"Str","c":"123"}]}],[{"t":"Plain","c":[{"t":"Str","c":"123"}]}],[{"t":"Plain","c":[{"t":"Str","c":"123"}]}],[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]],[[{"t":"Plain","c":[{"t":"Str","c":"1"}]}],[{"t":"Plain","c":[{"t":"Str","c":"1"}]}],[{"t":"Plain","c":[{"t":"Str","c":"1"}]}],[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]]]]}|] + ) + +t_div :: (Block, ByteString) +t_div = ( Div ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) [Para [Str "Hello"]] + , [s|{"t":"Div","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Para","c":[{"t":"Str","c":"Hello"}]}]]}|] + ) + +t_null :: (Block, ByteString) +t_null = (Null, [s|{"t":"Null"}|]) + + +tests :: [Test] +tests = + [ testGroup "Walk" + [ testProperty "p_walk inlineTrans" (p_walk inlineTrans) + , testProperty "p_walk blockTrans" (p_walk blockTrans) + , testProperty "p_query inlineQuery" (p_query inlineQuery) + , testProperty "p_query blockQuery" (p_query blockQuery) + ] + , testGroup "JSON" + [ testGroup "encoding/decoding properties" + [ testProperty "round-trip" prop_roundtrip + ] + , testGroup "JSON encoding/decoding" + [ testGroup "Meta" + [ testEncodeDecode "MetaMap" t_metamap + , testEncodeDecode "MetaList" t_metalist + , testEncodeDecode "MetaBool" t_metabool + , testEncodeDecode "MetaString" t_metastring + , testEncodeDecode "MetaInlines" t_metainlines + , testEncodeDecode "MetaBlocks" t_metablocks + ] + , testGroup "QuoteType" + [ testEncodeDecode "SingleQuote" t_singlequote + , testEncodeDecode "DoubleQuote" t_doublequote + ] + , testGroup "CitationType" + [ testEncodeDecode "AuthorInText" t_authorintext + , testEncodeDecode "SuppressAuthor" t_suppressauthor + , testEncodeDecode "NormalCitation" t_normalcitation + ] + , testEncodeDecode "Citation" t_citation + , testGroup "MathType" + [ testEncodeDecode "DisplayMath" t_displaymath + , testEncodeDecode "InlineMath" t_inlinemath + ] + , testGroup "Inline" + [ testEncodeDecode "Str" t_str + , testEncodeDecode "Emph" t_emph + , testEncodeDecode "Strong" t_strong + , testEncodeDecode "Strikeout" t_strikeout + , testEncodeDecode "Superscript" t_superscript + , testEncodeDecode "Subscript" t_subscript + , testEncodeDecode "SmallCaps" t_smallcaps + , testEncodeDecode "Quoted" t_quoted + , testEncodeDecode "Cite" t_cite + , testEncodeDecode "Code" t_code + , testEncodeDecode "Space" t_space + , testEncodeDecode "SoftBreak" t_softbreak + , testEncodeDecode "LineBreak" t_linebreak + , testEncodeDecode "RawInline" t_rawinline + , testEncodeDecode "Link" t_link + , testEncodeDecode "Image" t_image + , testEncodeDecode "Note" t_note + , testEncodeDecode "Span" t_span + ] + , testGroup "Block" + [ testEncodeDecode "Plain" t_plain + , testEncodeDecode "Para" t_para + , testEncodeDecode "LineBlock" t_lineblock + , testEncodeDecode "CodeBlock" t_codeblock + , testEncodeDecode "RawBlock" t_rawblock + , testEncodeDecode "BlockQuote" t_blockquote + , testEncodeDecode "OrderedList" t_orderedlist + , testEncodeDecode "BulletList" t_bulletlist + , testEncodeDecode "DefinitionList" t_definitionlist + , testEncodeDecode "Header" t_header + , testEncodeDecode "Table" t_table + , testEncodeDecode "Div" t_div + , testEncodeDecode "Null" t_null + ] + ] + ] + ] + + +main :: IO () +main = defaultMain tests
