pandoc-types-1.23.1/0000755000000000000000000000000007346545000012375 5ustar0000000000000000pandoc-types-1.23.1/LICENSE0000644000000000000000000000277507346545000013415 0ustar0000000000000000Copyright (c) 2006-2023, John MacFarlane All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of John MacFarlane nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. pandoc-types-1.23.1/Setup.hs0000644000000000000000000000005607346545000014032 0ustar0000000000000000import Distribution.Simple main = defaultMain pandoc-types-1.23.1/benchmark/0000755000000000000000000000000007346545000014327 5ustar0000000000000000pandoc-types-1.23.1/benchmark/bench.hs0000644000000000000000000000236307346545000015746 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Criterion.Main (bench, defaultMain, nf) import Text.Pandoc.Walk (walk) import Text.Pandoc.Builder import qualified Data.Text as T main :: IO () main = 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 (T.cons '\8203' s) prependZeroWidthSpace x = x prependZeroWidthSpace' :: Inline -> [Inline] prependZeroWidthSpace' (Str s) = [Str (T.cons '\8203' s)] prependZeroWidthSpace' x = [x] prependZeroWidthSpace'' :: [Inline] -> [Inline] prependZeroWidthSpace'' (Str s : xs) = Str (T.cons '\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") ] pandoc-types-1.23.1/changelog0000644000000000000000000003303707346545000014255 0ustar0000000000000000[1.23.1] * Restore toJSONFilter instance for pure `a -> [a]`. This went missing after my ill-considered revision to #105, commit 183af9d9f1066be974ac55fd23a4c985999d3ce8 . See jgm/pandoc#8976. * Generalize ToJSONFilter instance. Previously a pure function `a -> a` could only be promoted to a filter in IO. Now we allow it to work with any instance of MonadIO. (This adds to #105.) * Allow bytestring 0.12. [1.23.0.1] * Allow aeson 2.2. * Remove dependency on string-qq (recbecca skinner). [1.23] * Remove Null constructor from Block (#91) [API change]. * ToJSONFilter: Add instance for MonadIO (#105, Willem Van Onsem) [API change]. * Add `Figure` block constructor (Albert Krewinkel, Aner Lucero, and Christian Despres) [API change]. The new Figure block represents a figure with attributes, caption, and arbitrary block content. [1.22.2.1] * Allow aeson 2.1.* and criterion 1.6. [1.22.2] * Use StrictData in Text.Pandoc.Definition. * Add Walkable Meta(Value) Pandoc instances (Travis Cardwell). [1.22.1] * Text.Pandoc.Builder: add simpleFigure, simpleFigureWith, and the SimpleFigure bidirectional pattern synonym (Aner Lucero) [API change]. * Allow bytestring 0.11 (Alexander Batischev). * Update stack resolver to lts-18.10 * Allow aeson 2+. Tested with aeson 2.0.1.0. * Allow transformers 0.6. * Fix incorrect table ColWidth documentation (#85, Nils Carlson). The documentation stated that the ColWidth represented the width of the column as a fraction of the table width when in represents a percentage of the text width. [1.22] * Deprecate isNull from Builder: null can serve just as well (#67). Use null instead of isNull in Arbitrary (Christian Despres, #84). * Use untagged JSON encoding for single-constructor types (#75, #76, Christian Despres). All of the single constructor types related to Table are now represented in JSON either as arrays (for multi-argument constructors) or as the representation of the inner type (for single argument constructors). This behaviour for newtype-defined and multi-argument non-record types is now consistent across the entire JSON interface, with the exception of Pandoc itself (which is represented as a JSON object with additional metadata). Multi-argument records (of which Citation is the only example) are still represented as objects with the record accessors as keys. * The Meta and Citation types now use derived JSON serialization (newtype and generic, respectively). The format remains the same as before (Christian Despres). * New serialization tests now test that Meta and the Table types are encoded properly in JSON (Christian Despres). * Use TH To/FromJSON instances (Christian Despres). * Remove unused Legacy modules (#80, Despres). They are not exported, and are not used internally. * Change the table builder to permit looser intermediate table heads (#77, Christian Despres). The table builder (and the normalizeTableBody function) now permit cells in the intermediate head of a TableBody to extend past the RowHeadColumns. This allows for intermediate tables to have subheadings that extend across the entire table. Formerly the table builder would treat the intermediate head like the intermediate body, and clip or drop cells that extended past the row head. * Update QuickCheck lower bound. * Fix redundant pattern match. [1.21] * Add Underline constructor (#68, Vaibhav Sagar). * Improve table types to allow col, rowspans and more (#65, Christian Despres). The additions include modification of the Block type, some newtypes related to tables, and changes to the table builders. The table builder is now aware of the new Table constructor, and normalizes the input table appropriately, so that when laid onto a grid the resulting table has no empty spaces, overlapping cells, or cells that extend beyond their section boundary. Three properties of normalization are checked: - Normalization is idempotent. - Each row of a normalized table is an initial segment of the corresponding row in the unnormalized table, modulo changed cell dimensions, dropped cells, and padding with empty cells. This is only checked for the first row of the TableBody, however, due to row head difficulties. - The sum of the cell lengths in the first row of every normalized table section is always equal to the total table width. `simpleTable` has been changed so that a null header list becomes a TableHead with a null body, not a TableHead with a single empty row. * Bump QuickCheck upper bound. * Change lower bound for QuickCheck to 2.10 (needed for `liftShrink2`). * Small code quality improvements (Joseph C. Sible, #69). * Allow aeson 1.5 (#72, Felix Yan). * Fixed documentation typo (Merlin Göttlinger). * Add COMPLETE pragmas to the pattern definitions (Christian Despres). [1.20] * Change all uses of String in type definitions to strict Text (Christian Despres) [API change]. The MetaValue instances using String have been kept, and parallel ones using Text were added. * Remove the Arbitrary Text orphan instance (Christian Despres). This instance should not have been in the Text.Pandoc.Arbitrary, since it would have been exported with the rest of the instances in that module. Instead, more shrink* functions were added to compensate for the absence of this instance. * Add Text.Pandoc.Legacy.Definition (Christian Despres). To ease the transition to Text, this module provides an interface compatible with the String one, so that any unqualified imports of Text.Pandoc.Definition in other packages can be replaced by Text.Pandoc.Legacy.Definition without other code changes. This is done with PatternSynonyms. Some of the constructors of the types Meta, MetaValue, Block, Inline, Format, and Citation required PatternSynonym handling. The Attr and Target types had to be redefined, and certain functions had to be rewritten to handle String or the old Attr and Target types in this module. This module otherwise exports the definitions in Text.Pandoc.Definition unchanged. This is not a perfect drop-in replacement, since some imports like Inline(..) will no longer work. This may also cause incomplete pattern warnings when used, since the coverage checker does not seem to be aware of PatternSynonyms. * Add Text.Pandoc.Legacy.Builder (Christian Despres). Like Text.Pandoc.Legacy.Definition, this modules provides a compatibility interface while the transition to Text takes place. Unlike that module, this module only requires redefining the ToMetaValue and HasMeta classes and a few functions so that they use the old types. No PatternSynonyms are required. * Change Semigroup/Monoid instance for Meta. Previously `<>` was left-biased, so if meta1 and meta2 both contained a field 'foo', the value from meta1 would be retained in `meta1 <> meta2`, and the value from meta2 ignored. This is counterintuitive and doesn't work well with pandoc; for example, we want to be able to override a value in an earlier `--metadata-file` with a later one on the command line. It also makes the behavior of metadata more like other things (such as reference links, where later definitions take precedence over earlier ones). Note that this change may break some current workflows, if one is relying on metadata fields that occur later in a document to be overridden by those occurring earlier. [1.17.6.1] * Relax version bound for string-qq. [1.17.6] * Walk: export walk and query helpers (Albert Krewinkel) [API change]. The `walk*M` and `query*` functions are helpful when defining new `Walkable` instances. * Allow QuickCheck 2.13. * Document meaning of Int in ListAttributes (#45). * Update copyright year spans to include 2019 (Albert Krewinkel). * Remove CPP instructions for GHC versions < 7.10 (Albert Krewinkel). * update list of GHC versions used for testing (Albert Krewinkel). * Fix compiler and hlint warnings (Pete Ryland). [1.17.5.4] * Put NFData in scope for ghc < 7.10. * Reduce deepseq lower bound for ghc < 7.10. [1.17.5.3] * For ghc < 7.10, constrain deepseq-generics to >= 0.2, which no longer exprots NFData from deepseq. Add deepseq dependency. [1.17.5.2] * Bump upper bound for deepseq-generics, QuickCheck, criterion. * Implement QuickCheck shrinking for Inlines and Blocks (Alexander Krotov). [1.17.5.1] * Declare the ToMetaValue instance for String as OVERLAPPING (#46). [1.17.5] * Bump upper bounds for aeson, base. * Allow building on older ghc versions (George Wilson). * Text.Pandoc.Arbitrary: generate SoftBreaks and LineBreaks (Alexander Krotov). * Pad table rows up to maximum row length, to guarantee that all rows have the same number of columns (see jgm/pandoc#4059, Francesco Occhipinti). * Make String an instance of ToMetaValue (Alexander Krotov). [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. * 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.*. [1.16.1] * Allow aeson 0.11.*. * Export pandocTypesVersion from Text.Pandoc.Definition. [1.16.0.1] * Use deepseq instead of deepseq-generics. deepseq now allows deriving generic NFData instances, so we don't need deepseq-generics. * Removed unneeded instance, use OVERLAPPING pragma for ghc 7.10. * Added CPP so that deepseq-generics is used for ghc < 7.10. * Added tested-with, generate .travis.yml using make_travis_yml.hs * Added stack.yaml [1.16] * Added Attr field to Image and Link. * Added SoftBreak constructor to Inline pandoc-types-1.23.1/pandoc-types.cabal0000644000000000000000000000762107346545000015775 0ustar0000000000000000cabal-version: 2.2 Name: pandoc-types version: 1.23.1 Synopsis: Types for representing a structured document Description: @Text.Pandoc.Definition@ defines the 'Pandoc' data structure, which is used by pandoc to represent structured documents. This module used to live in the pandoc package, but starting with pandoc 1.7, it has been split off, so that other packages can use it without drawing in all of pandoc's dependencies, and pandoc itself can depend on packages (like citeproc-hs) that use them. . @Text.Pandoc.Builder@ provides functions for building up @Pandoc@ structures programmatically. . @Text.Pandoc.Generic@ provides generic functions for manipulating Pandoc documents. . @Text.Pandoc.Walk@ provides faster, nongeneric functions for manipulating Pandoc documents. . @Text.Pandoc.JSON@ provides functions for serializing and deserializing a @Pandoc@ structure to and from JSON. Homepage: https://pandoc.org/ License: BSD-3-Clause License-file: LICENSE Author: John MacFarlane Maintainer: jgm@berkeley.edu Bug-Reports: https://github.com/jgm/pandoc-types/issues Copyright: (c) 2006-2023 John MacFarlane Category: Text Build-type: Simple Extra-Source-Files: changelog Source-repository head type: git location: git://github.com/jgm/pandoc-types.git Library hs-source-dirs: src Exposed-modules: Text.Pandoc.Definition Text.Pandoc.Generic Text.Pandoc.Walk Text.Pandoc.Builder Text.Pandoc.JSON Text.Pandoc.Arbitrary Other-modules: Paths_pandoc_types Autogen-modules: Paths_pandoc_types Build-depends: base >= 4.5 && < 5, containers >= 0.3, text, deepseq >= 1.4.1 && < 1.5, syb >= 0.1 && < 0.8, ghc-prim >= 0.2, bytestring >= 0.9 && < 0.13, aeson >= 0.6.2 && < 2.3, transformers >= 0.2 && < 0.7, QuickCheck >= 2.10 && < 2.15 if !impl(ghc >= 8.0) Build-depends: semigroups == 0.18.* ghc-options: -Wall default-language: Haskell2010 test-suite test-pandoc-types type: exitcode-stdio-1.0 hs-source-dirs: test main-is: test-pandoc-types.hs Other-modules: Data.String.QQ build-depends: base, pandoc-types, syb, aeson >= 0.6.2 && < 2.3, containers >= 0.3, text, bytestring >= 0.9 && < 0.13, test-framework >= 0.3 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2.9 && < 0.4, QuickCheck >= 2.10 && < 2.15, HUnit >= 1.2 && < 1.7, template-haskell >= 2 ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -O2 default-language: Haskell2010 benchmark benchmark-pandoc-types type: exitcode-stdio-1.0 main-is: bench.hs hs-source-dirs: benchmark build-depends: pandoc-types, base >= 4.5 && < 5, text, criterion >= 1.0 ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -O2 default-language: Haskell2010 pandoc-types-1.23.1/src/Text/Pandoc/0000755000000000000000000000000007346545000015314 5ustar0000000000000000pandoc-types-1.23.1/src/Text/Pandoc/Arbitrary.hs0000644000000000000000000004411707346545000017616 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE FlexibleInstances, ScopedTypeVariables, OverloadedStrings #-} -- provides Arbitrary instance for Pandoc types module Text.Pandoc.Arbitrary () where import Test.QuickCheck import Control.Applicative (Applicative ((<*>), pure), (<$>)) import Control.Monad (forM) import Data.Text (Text) import qualified Data.Text as T import Text.Pandoc.Definition import Text.Pandoc.Builder realString :: Gen Text realString = fmap T.pack $ resize 8 $ listOf $ frequency [ (9, elements [' '..'\127']) , (1, elements ['\128'..'\9999']) ] shrinkText :: Text -> [Text] shrinkText xs = T.pack <$> shrink (T.unpack xs) shrinkText2 :: (Text, Text) -> [(Text, Text)] shrinkText2 = liftShrink2 shrinkText shrinkText 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) shrinkAttr :: Attr -> [Attr] shrinkAttr (a, b, c) = [ (a', b', c') | a' <- shrinkText a, b' <- liftShrink shrinkText b, c' <- liftShrink shrinkText2 c ] instance Arbitrary Inlines where arbitrary = (fromList :: [Inline] -> Inlines) <$> arbitrary shrink = fmap fromList . ((++) <$> shrink <*> flattenShrinkInlines) . toList where flattenShrinkInlines (x:xs) = let x' = flattenInline x in [x' ++ xs | not (null x')] ++ [x:xs' | xs' <- flattenShrinkInlines xs] flattenShrinkInlines [] = [] flattenInline :: Inline -> [Inline] flattenInline (Str _) = [] flattenInline (Emph ils) = ils flattenInline (Underline ils) = ils flattenInline (Strong ils) = ils flattenInline (Strikeout ils) = ils flattenInline (Superscript ils) = ils flattenInline (Subscript ils) = ils flattenInline (SmallCaps ils) = ils flattenInline (Quoted _ ils) = ils flattenInline (Cite _ ils) = ils flattenInline Code{} = [] flattenInline Space = [] flattenInline SoftBreak = [] flattenInline LineBreak = [] flattenInline Math{} = [] flattenInline RawInline{} = [] flattenInline (Link _ ils _) = ils flattenInline (Image _ ils _) = ils flattenInline Note{} = [] flattenInline (Span _ ils) = ils instance Arbitrary Blocks where arbitrary = (fromList :: [Block] -> Blocks) <$> arbitrary shrink = fmap fromList . ((++) <$> shrink <*> flattenShrinkBlocks) . toList where flattenShrinkBlocks (x:xs) = let x' = flattenBlock x in [x' ++ xs | not (null x')] ++ [x:xs' | xs' <- flattenShrinkBlocks xs] flattenShrinkBlocks [] = [] flattenBlock :: Block -> [Block] flattenBlock Plain{} = [] flattenBlock Para{} = [] flattenBlock (LineBlock lns) = [Para x | x <- lns] flattenBlock CodeBlock{} = [] flattenBlock RawBlock{} = [] flattenBlock (BlockQuote blks) = blks flattenBlock (OrderedList _ blksList) = concat blksList flattenBlock (BulletList blksList) = concat blksList flattenBlock (DefinitionList defs) = concat [Para ils:concat blks | (ils, blks) <- defs] flattenBlock (Header _ _ ils) = [Para ils] flattenBlock HorizontalRule = [] flattenBlock (Table _ capt _ hd bd ft) = flattenCaption capt <> flattenTableHead hd <> concatMap flattenTableBody bd <> flattenTableFoot ft flattenBlock (Figure _ capt blks) = flattenCaption capt <> blks flattenBlock (Div _ blks) = blks flattenCaption (Caption Nothing body) = body flattenCaption (Caption (Just ils) body) = Para ils : body flattenTableHead (TableHead _ body) = flattenRows body flattenTableBody (TableBody _ _ hd bd) = flattenRows hd <> flattenRows bd flattenTableFoot (TableFoot _ body) = flattenRows body flattenRows = concatMap flattenRow flattenRow (Row _ body) = concatMap flattenCell body flattenCell (Cell _ _ _ _ blks) = blks shrinkInlineList :: [Inline] -> [[Inline]] shrinkInlineList = fmap toList . shrink . fromList shrinkInlinesList :: [[Inline]] -> [[[Inline]]] shrinkInlinesList = fmap (fmap toList) . shrink . fmap fromList shrinkBlockList :: [Block] -> [[Block]] shrinkBlockList = fmap toList . shrink . fromList shrinkBlocksList :: [[Block]] -> [[[Block]]] shrinkBlocksList = fmap (fmap toList) . shrink . fmap fromList instance Arbitrary Inline where arbitrary = resize 3 $ arbInline 2 shrink (Str s) = Str <$> shrinkText s shrink (Emph ils) = Emph <$> shrinkInlineList ils shrink (Underline ils) = Underline <$> shrinkInlineList ils shrink (Strong ils) = Strong <$> shrinkInlineList ils shrink (Strikeout ils) = Strikeout <$> shrinkInlineList ils shrink (Superscript ils) = Superscript <$> shrinkInlineList ils shrink (Subscript ils) = Subscript <$> shrinkInlineList ils shrink (SmallCaps ils) = SmallCaps <$> shrinkInlineList ils shrink (Quoted qtype ils) = Quoted qtype <$> shrinkInlineList ils shrink (Cite cits ils) = (Cite cits <$> shrinkInlineList ils) ++ (flip Cite ils <$> shrink cits) shrink (Code attr s) = (Code attr <$> shrinkText s) ++ (flip Code s <$> shrinkAttr attr) shrink Space = [] shrink SoftBreak = [] shrink LineBreak = [] shrink (Math mtype s) = Math mtype <$> shrinkText s shrink (RawInline fmt s) = RawInline fmt <$> shrinkText s shrink (Link attr ils target) = [Link attr ils' target | ils' <- shrinkInlineList ils] ++ [Link attr ils target' | target' <- shrinkText2 target] ++ [Link attr' ils target | attr' <- shrinkAttr attr] shrink (Image attr ils target) = [Image attr ils' target | ils' <- shrinkInlineList ils] ++ [Image attr ils target' | target' <- shrinkText2 target] ++ [Image attr' ils target | attr' <- shrinkAttr attr] shrink (Note blks) = Note <$> shrinkBlockList blks shrink (Span attr s) = (Span attr <$> shrink s) ++ (flip Span s <$> shrinkAttr attr) arbInlines :: Int -> Gen [Inline] arbInlines n = listOf1 (arbInline n) `suchThat` (not . startsWithSpace) where startsWithSpace (Space:_) = True startsWithSpace (SoftBreak:_) = True -- Note: no LineBreak, similarly to Text.Pandoc.Builder (trimInlines) 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, Str <$> realString) , (40, pure Space) , (10, pure SoftBreak) , (10, pure LineBreak) , (10, Code <$> arbAttr <*> realString) , (5, elements [ RawInline (Format "html") "" , RawInline (Format "latex") "\\my{command}" ]) ] ++ [ x | n > 1, x <- nesters] where nesters = [ (10, Emph <$> arbInlines (n-1)) , (10, Underline <$> arbInlines (n-1)) , (10, Strong <$> arbInlines (n-1)) , (10, Strikeout <$> arbInlines (n-1)) , (10, Superscript <$> arbInlines (n-1)) , (10, Subscript <$> arbInlines (n-1)) , (10, SmallCaps <$> arbInlines (n-1)) , (10, Span <$> arbAttr <*> arbInlines (n-1)) , (10, Quoted <$> arbitrary <*> arbInlines (n-1)) , (10, Math <$> arbitrary <*> realString) , (10, Link <$> arbAttr <*> arbInlines (n-1) <*> ((,) <$> realString <*> realString)) , (10, Image <$> arbAttr <*> arbInlines (n-1) <*> ((,) <$> realString <*> realString)) , (2, Cite <$> arbitrary <*> arbInlines 1) , (2, Note <$> resize 3 (listOf1 $ arbBlock (n-1))) ] instance Arbitrary Block where arbitrary = resize 3 $ arbBlock 2 shrink (Plain ils) = Plain <$> shrinkInlineList ils shrink (Para ils) = Para <$> shrinkInlineList ils shrink (LineBlock lns) = LineBlock <$> shrinkInlinesList lns shrink (CodeBlock attr s) = (CodeBlock attr <$> shrinkText s) ++ (flip CodeBlock s <$> shrinkAttr attr) shrink (RawBlock fmt s) = RawBlock fmt <$> shrinkText s shrink (BlockQuote blks) = BlockQuote <$> shrinkBlockList blks shrink (OrderedList listAttrs blksList) = OrderedList listAttrs <$> shrinkBlocksList blksList shrink (BulletList blksList) = BulletList <$> shrinkBlocksList blksList shrink (DefinitionList defs) = DefinitionList <$> shrinkDefinitionList defs where shrinkDefinition (ils, blksList) = [(ils', blksList) | ils' <- shrinkInlineList ils] ++ [(ils, blksList') | blksList' <- shrinkBlocksList blksList] shrinkDefinitionList (x:xs) = [xs] ++ [x':xs | x' <- shrinkDefinition x] ++ [x:xs' | xs' <- shrinkDefinitionList xs] shrinkDefinitionList [] = [] shrink (Header n attr ils) = (Header n attr <$> shrinkInlineList ils) ++ (flip (Header n) ils <$> shrinkAttr attr) shrink HorizontalRule = [] shrink (Table attr capt specs thead tbody tfoot) = -- TODO: shrink number of columns [Table attr' capt specs thead tbody tfoot | attr' <- shrinkAttr attr] ++ [Table attr capt specs thead' tbody tfoot | thead' <- shrink thead] ++ [Table attr capt specs thead tbody' tfoot | tbody' <- shrink tbody] ++ [Table attr capt specs thead tbody tfoot' | tfoot' <- shrink tfoot] ++ [Table attr capt' specs thead tbody tfoot | capt' <- shrink capt] shrink (Figure attr capt blks) = [Figure attr capt blks' | blks' <- shrinkBlockList blks] ++ [Figure attr capt' blks | capt' <- shrink capt] ++ [Figure attr' capt blks | attr' <- shrinkAttr attr] shrink (Div attr blks) = (Div attr <$> shrinkBlockList blks) ++ (flip Div blks <$> shrinkAttr attr) arbBlock :: Int -> Gen Block arbBlock n = frequency $ [ (10, Plain <$> arbInlines (n-1)) , (15, Para <$> arbInlines (n-1)) , (5, CodeBlock <$> arbAttr <*> realString) , (3, LineBlock <$> ((:) <$> arbInlines ((n - 1) `mod` 3) <*> forM [1..((n - 1) `div` 3)] (const (arbInlines 3)))) , (2, elements [ RawBlock (Format "html") "
\n*&*\n
" , RawBlock (Format "latex") "\\begin[opt]{env}\nhi\n{\\end{env}" ]) , (5, Header <$> choose (1 :: Int, 6) <*> pure nullAttr <*> arbInlines (n-1)) , (2, pure HorizontalRule) ] ++ [x | n > 0, x <- nesters] where nesters = [ (5, BlockQuote <$> listOf1 (arbBlock (n-1))) , (5, OrderedList <$> ((,,) <$> (arbitrary `suchThat` (> 0)) <*> arbitrary <*> arbitrary) <*> listOf1 (listOf1 $ arbBlock (n-1))) , (5, BulletList <$> listOf1 (listOf1 $ arbBlock (n-1))) , (5, DefinitionList <$> listOf1 ((,) <$> arbInlines (n-1) <*> listOf1 (listOf1 $ arbBlock (n-1)))) , (5, Div <$> arbAttr <*> listOf1 (arbBlock (n-1))) , (2, do cs <- choose (1 :: Int, 6) bs <- choose (0 :: Int, 2) Table <$> arbAttr <*> arbitrary <*> vectorOf cs ((,) <$> arbitrary <*> elements [ ColWidthDefault , ColWidth (1/3) , ColWidth 0.25 ]) <*> arbTableHead (n-1) <*> vectorOf bs (arbTableBody (n-1)) <*> arbTableFoot (n-1)) , (2, Figure <$> arbAttr <*> arbitrary <*> listOf1 (arbBlock (n-1))) ] arbRow :: Int -> Gen Row arbRow n = do cs <- choose (0, 5) Row <$> arbAttr <*> vectorOf cs (arbCell n) arbTableHead :: Int -> Gen TableHead arbTableHead n = do rs <- choose (0, 5) TableHead <$> arbAttr <*> vectorOf rs (arbRow n) arbTableBody :: Int -> Gen TableBody arbTableBody n = do hrs <- choose (0 :: Int, 2) rs <- choose (0, 5) rhc <- choose (0, 5) TableBody <$> arbAttr <*> pure (RowHeadColumns rhc) <*> vectorOf hrs (arbRow n) <*> vectorOf rs (arbRow n) arbTableFoot :: Int -> Gen TableFoot arbTableFoot n = do rs <- choose (0, 5) TableFoot <$> arbAttr <*> vectorOf rs (arbRow n) arbCell :: Int -> Gen Cell arbCell n = Cell <$> arbAttr <*> arbitrary <*> (RowSpan <$> choose (1 :: Int, 2)) <*> (ColSpan <$> choose (1 :: Int, 2)) <*> listOf (arbBlock n) instance Arbitrary Pandoc where arbitrary = resize 8 (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 = Citation <$> fmap T.pack (listOf $ elements $ ['a'..'z'] ++ ['0'..'9'] ++ ['_']) <*> arbInlines 1 <*> arbInlines 1 <*> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary Row where arbitrary = resize 3 $ arbRow 2 shrink (Row attr body) = [Row attr' body | attr' <- shrinkAttr attr] ++ [Row attr body' | body' <- shrink body] instance Arbitrary TableHead where arbitrary = resize 3 $ arbTableHead 2 shrink (TableHead attr body) = [TableHead attr' body | attr' <- shrinkAttr attr] ++ [TableHead attr body' | body' <- shrink body] instance Arbitrary TableBody where arbitrary = resize 3 $ arbTableBody 2 -- TODO: shrink rhc? shrink (TableBody attr rhc hd bd) = [TableBody attr' rhc hd bd | attr' <- shrinkAttr attr] ++ [TableBody attr rhc hd' bd | hd' <- shrink hd] ++ [TableBody attr rhc hd bd' | bd' <- shrink bd] instance Arbitrary TableFoot where arbitrary = resize 3 $ arbTableFoot 2 shrink (TableFoot attr body) = [TableFoot attr' body | attr' <- shrinkAttr attr] ++ [TableFoot attr body' | body' <- shrink body] instance Arbitrary Cell where arbitrary = resize 3 $ arbCell 2 shrink (Cell attr malign h w body) = [Cell attr malign h w body' | body' <- shrinkBlockList body] ++ [Cell attr' malign h w body | attr' <- shrinkAttr attr] ++ [Cell attr malign' h w body | malign' <- shrink malign] instance Arbitrary Caption where arbitrary = Caption <$> arbitrary <*> arbitrary shrink (Caption mshort body) = [Caption mshort' body | mshort' <- shrink mshort] ++ [Caption mshort body' | body' <- shrinkBlockList body] 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]) <- filter (not . null) <$> 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" pandoc-types-1.23.1/src/Text/Pandoc/Builder.hs0000644000000000000000000006334107346545000017245 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP, StandaloneDeriving, DeriveGeneric, DeriveTraversable, OverloadedStrings, PatternGuards #-} {- Copyright (C) 2010-2023 John MacFarlane All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of John MacFarlane nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} {- | Module : Text.Pandoc.Builder Copyright : Copyright (C) 2010-2023 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable Convenience functions for building pandoc documents programmatically. Example of use (with @OverloadedStrings@ pragma): > import Text.Pandoc.Builder > > myDoc :: Pandoc > myDoc = setTitle "My title" $ doc $ > 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") > ] Isn't that nicer than writing the following? > import Text.Pandoc.Definition > import Data.Map (fromList) > > myDoc :: Pandoc > myDoc = Pandoc (Meta {unMeta = fromList [("title", > MetaInlines [Str "My",Space,Str "title"])]}) > [Para [Str "This",Space,Str "is",Space,Str "the",Space,Str "first", > Space,Str "paragraph"],Para [Str "And",Space,Emph [Str "another"], > Str "."] > ,BulletList [ > [Para [Str "item",Space,Str "one"] > ,Para [Str "continuation"]] > ,[Plain [Str "item",Space,Str "two",Space,Str "and",Space, > Str "a",Space,Link nullAttr [Str "link"] ("/url","go to url")]]]] And of course, you can use Haskell to define your own builders: > import Text.Pandoc.Builder > import Text.JSON > import Control.Arrow ((***)) > import Data.Monoid (mempty) > > -- | Converts a JSON document into 'Blocks'. > json :: String -> Blocks > json x = > case decode x of > Ok y -> jsValueToBlocks y > Error y -> error y > where jsValueToBlocks x = > case x of > JSNull -> mempty > JSBool x -> plain $ text $ show x > JSRational _ x -> plain $ text $ show x > JSString x -> plain $ text $ fromJSString x > JSArray xs -> bulletList $ map jsValueToBlocks xs > JSObject x -> definitionList $ > map (text *** (:[]) . jsValueToBlocks) $ > fromJSObject x -} module Text.Pandoc.Builder ( module Text.Pandoc.Definition , Many(..) , Inlines , Blocks , (<>) , singleton , toList , fromList , isNull -- * Document builders , doc , ToMetaValue(..) , HasMeta(..) , setTitle , setAuthors , setDate -- * Inline list builders , text , str , emph , underline , strong , strikeout , superscript , subscript , smallcaps , singleQuoted , doubleQuoted , cite , codeWith , code , space , softbreak , linebreak , math , displayMath , rawInline , link , linkWith , image , imageWith , note , spanWith , trimInlines -- * Block list builders , para , plain , lineBlock , codeBlockWith , codeBlock , rawBlock , blockQuote , bulletList , orderedListWith , orderedList , definitionList , header , headerWith , horizontalRule , cell , simpleCell , emptyCell , cellWith , table , simpleTable , tableWith , figure , figureWith , caption , simpleCaption , emptyCaption , simpleFigureWith , simpleFigure , divWith -- * Table processing , normalizeTableHead , normalizeTableBody , normalizeTableFoot , placeRowSection , clipRows ) where import Text.Pandoc.Definition import Data.String import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T 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.Data import Control.Arrow ((***)) import GHC.Generics (Generic) import Data.Semigroup (Semigroup(..)) newtype Many a = Many { unMany :: Seq a } deriving (Data, Ord, Eq, Typeable, Foldable, Traversable, Functor, Show, Read) deriving instance Generic (Many a) toList :: Many a -> [a] toList = F.toList singleton :: a -> Many a singleton = Many . Seq.singleton fromList :: [a] -> Many a fromList = Many . Seq.fromList {-# DEPRECATED isNull "Use null instead" #-} isNull :: Many a -> Bool isNull = Seq.null . unMany type Inlines = Many Inline type Blocks = Many Block deriving instance Semigroup Blocks deriving instance Monoid Blocks 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 <> ys') where meld = case (x, y) of (Space, Space) -> xs' |> Space (Space, SoftBreak) -> xs' |> SoftBreak (SoftBreak, Space) -> xs' |> SoftBreak (Str t1, Str t2) -> xs' |> Str (t1 <> t2) (Emph i1, Emph i2) -> xs' |> Emph (i1 <> i2) (Underline i1, Underline i2) -> xs' |> Underline (i1 <> i2) (Strong i1, Strong i2) -> xs' |> Strong (i1 <> i2) (Subscript i1, Subscript i2) -> xs' |> Subscript (i1 <> i2) (Superscript i1, Superscript i2) -> xs' |> Superscript (i1 <> i2) (Strikeout i1, Strikeout i2) -> xs' |> Strikeout (i1 <> i2) (Space, LineBreak) -> xs' |> LineBreak (LineBreak, Space) -> xs' |> LineBreak (SoftBreak, LineBreak) -> xs' |> LineBreak (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 . T.pack -- | Trim leading and trailing spaces and softbreaks from an Inlines. trimInlines :: Inlines -> Inlines #if MIN_VERSION_containers(0,4,0) trimInlines (Many ils) = Many $ Seq.dropWhileL isSp $ Seq.dropWhileR isSp $ ils #else -- for GHC 6.12, we need to workaround a bug in dropWhileR -- see http://hackage.haskell.org/trac/ghc/ticket/4157 trimInlines (Many ils) = Many $ Seq.dropWhileL isSp $ Seq.reverse $ Seq.dropWhileL isSp $ Seq.reverse ils #endif where isSp Space = True isSp SoftBreak = True isSp _ = False -- Document builders doc :: Blocks -> Pandoc doc = Pandoc nullMeta . toList class ToMetaValue a where toMetaValue :: a -> MetaValue instance ToMetaValue MetaValue where toMetaValue = id instance ToMetaValue Blocks where toMetaValue = MetaBlocks . toList instance ToMetaValue Inlines where toMetaValue = MetaInlines . toList instance ToMetaValue Bool where toMetaValue = MetaBool instance ToMetaValue Text where toMetaValue = MetaString instance {-# OVERLAPPING #-} ToMetaValue String where toMetaValue = MetaString . T.pack instance ToMetaValue a => ToMetaValue [a] where toMetaValue = MetaList . map toMetaValue instance ToMetaValue a => ToMetaValue (M.Map Text a) where toMetaValue = MetaMap . M.map toMetaValue instance ToMetaValue a => ToMetaValue (M.Map String a) where toMetaValue = MetaMap . M.map toMetaValue . M.mapKeys T.pack class HasMeta a where setMeta :: ToMetaValue b => Text -> b -> a -> a deleteMeta :: Text -> a -> a instance HasMeta Meta where setMeta key val (Meta ms) = Meta $ M.insert key (toMetaValue val) ms deleteMeta key (Meta ms) = Meta $ M.delete key ms instance HasMeta Pandoc where setMeta key val (Pandoc (Meta ms) bs) = Pandoc (Meta $ M.insert key (toMetaValue val) ms) bs deleteMeta key (Pandoc (Meta ms) bs) = Pandoc (Meta $ M.delete key ms) bs setTitle :: Inlines -> Pandoc -> Pandoc setTitle = setMeta "title" setAuthors :: [Inlines] -> Pandoc -> Pandoc setAuthors = setMeta "author" setDate :: Inlines -> Pandoc -> Pandoc setDate = setMeta "date" -- Inline list builders -- | Convert a 'Text' to 'Inlines', treating interword spaces as 'Space's -- or 'SoftBreak's. If you want a 'Str' with literal spaces, use 'str'. text :: Text -> Inlines text = fromList . map conv . breakBySpaces where breakBySpaces = T.groupBy sameCategory sameCategory x y = is_space x == is_space y conv xs | T.all is_space xs = if T.any is_newline xs then SoftBreak else Space conv xs = Str xs is_space ' ' = True is_space '\r' = True is_space '\n' = True is_space '\t' = True is_space _ = False is_newline '\r' = True is_newline '\n' = True is_newline _ = False str :: Text -> Inlines str = singleton . Str emph :: Inlines -> Inlines emph = singleton . Emph . toList underline :: Inlines -> Inlines underline = singleton . Underline . toList strong :: Inlines -> Inlines strong = singleton . Strong . toList strikeout :: Inlines -> Inlines strikeout = singleton . Strikeout . toList superscript :: Inlines -> Inlines superscript = singleton . Superscript . toList subscript :: Inlines -> Inlines subscript = singleton . Subscript . toList smallcaps :: Inlines -> Inlines smallcaps = singleton . SmallCaps . toList singleQuoted :: Inlines -> Inlines singleQuoted = quoted SingleQuote doubleQuoted :: Inlines -> Inlines doubleQuoted = quoted DoubleQuote quoted :: QuoteType -> Inlines -> Inlines quoted qt = singleton . Quoted qt . toList cite :: [Citation] -> Inlines -> Inlines cite cts = singleton . Cite cts . toList -- | Inline code with attributes. codeWith :: Attr -> Text -> Inlines codeWith attrs = singleton . Code attrs -- | Plain inline code. code :: Text -> Inlines code = codeWith nullAttr space :: Inlines space = singleton Space softbreak :: Inlines softbreak = singleton SoftBreak linebreak :: Inlines linebreak = singleton LineBreak -- | Inline math math :: Text -> Inlines math = singleton . Math InlineMath -- | Display math displayMath :: Text -> Inlines displayMath = singleton . Math DisplayMath rawInline :: Text -> Text -> Inlines rawInline format = singleton . RawInline (Format format) link :: Text -- ^ URL -> Text -- ^ Title -> Inlines -- ^ Label -> Inlines link = linkWith nullAttr linkWith :: Attr -- ^ Attributes -> Text -- ^ URL -> Text -- ^ Title -> Inlines -- ^ Label -> Inlines linkWith attr url title x = singleton $ Link attr (toList x) (url, title) image :: Text -- ^ URL -> Text -- ^ Title -> Inlines -- ^ Alt text -> Inlines image = imageWith nullAttr imageWith :: Attr -- ^ Attributes -> Text -- ^ URL -> Text -- ^ Title -> Inlines -- ^ Alt text -> Inlines imageWith attr url title x = singleton $ Image attr (toList x) (url, title) note :: Blocks -> Inlines note = singleton . Note . toList spanWith :: Attr -> Inlines -> Inlines spanWith attr = singleton . Span attr . toList -- Block list builders para :: Inlines -> Blocks para = singleton . Para . toList plain :: Inlines -> Blocks plain ils = if isNull ils then mempty else singleton . Plain . toList $ ils lineBlock :: [Inlines] -> Blocks lineBlock = singleton . LineBlock . map toList -- | A code block with attributes. codeBlockWith :: Attr -> Text -> Blocks codeBlockWith attrs = singleton . CodeBlock attrs -- | A plain code block. codeBlock :: Text -> Blocks codeBlock = codeBlockWith nullAttr rawBlock :: Text -> Text -> Blocks rawBlock format = singleton . RawBlock (Format format) blockQuote :: Blocks -> Blocks blockQuote = singleton . BlockQuote . toList -- | Ordered list with attributes. orderedListWith :: ListAttributes -> [Blocks] -> Blocks orderedListWith attrs = singleton . OrderedList attrs . map toList -- | Ordered list with default attributes. orderedList :: [Blocks] -> Blocks orderedList = orderedListWith (1, DefaultStyle, DefaultDelim) bulletList :: [Blocks] -> Blocks bulletList = singleton . BulletList . map toList definitionList :: [(Inlines, [Blocks])] -> Blocks definitionList = singleton . DefinitionList . map (toList *** map toList) header :: Int -- ^ Level -> Inlines -> Blocks header = headerWith nullAttr headerWith :: Attr -> Int -> Inlines -> Blocks headerWith attr level = singleton . Header level attr . toList horizontalRule :: Blocks horizontalRule = singleton HorizontalRule cellWith :: Attr -> Alignment -> RowSpan -> ColSpan -> Blocks -> Cell cellWith at a r c = Cell at a r c . toList cell :: Alignment -> RowSpan -> ColSpan -> Blocks -> Cell cell = cellWith nullAttr -- | A 1×1 cell with default alignment. simpleCell :: Blocks -> Cell simpleCell = cell AlignDefault 1 1 -- | A 1×1 empty cell. emptyCell :: Cell emptyCell = simpleCell mempty -- | Table builder. Performs normalization with 'normalizeTableHead', -- 'normalizeTableBody', and 'normalizeTableFoot'. The number of table -- columns is given by the length of @['ColSpec']@. table :: Caption -> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks table = tableWith nullAttr tableWith :: Attr -> Caption -> [ColSpec] -> TableHead -> [TableBody] -> TableFoot -> Blocks tableWith attr capt specs th tbs tf = singleton $ Table attr capt specs th' tbs' tf' where twidth = length specs th' = normalizeTableHead twidth th tbs' = map (normalizeTableBody twidth) tbs tf' = normalizeTableFoot twidth tf -- | A simple table without a caption. simpleTable :: [Blocks] -- ^ Headers -> [[Blocks]] -- ^ Rows -> Blocks simpleTable headers rows = table emptyCaption (replicate numcols defaults) th [tb] tf where defaults = (AlignDefault, ColWidthDefault) numcols = maximum (map length (headers:rows)) toRow = Row nullAttr . map simpleCell toHeaderRow l | null l = [] | otherwise = [toRow headers] th = TableHead nullAttr (toHeaderRow headers) tb = TableBody nullAttr 0 [] $ map toRow rows tf = TableFoot nullAttr [] figure :: Caption -> Blocks -> Blocks figure = figureWith nullAttr figureWith :: Attr -> Caption -> Blocks -> Blocks figureWith attr capt = singleton . Figure attr capt . toList caption :: Maybe ShortCaption -> Blocks -> Caption caption x = Caption x . toList simpleCaption :: Blocks -> Caption simpleCaption = caption Nothing emptyCaption :: Caption emptyCaption = simpleCaption mempty -- | Creates a simple figure from attributes, a figure caption, an image -- path and image title. The attributes are used as the image -- attributes. simpleFigureWith :: Attr -> Inlines -> Text -> Text -> Blocks simpleFigureWith attr figureCaption url title = figure (simpleCaption (plain figureCaption)) . plain $ imageWith attr url title mempty simpleFigure :: Inlines -> Text -> Text -> Blocks simpleFigure = simpleFigureWith nullAttr divWith :: Attr -> Blocks -> Blocks divWith attr = singleton . Div attr . toList -- | Normalize the 'TableHead' with 'clipRows' and 'placeRowSection' -- so that when placed on a grid with the given width and a height -- equal to the number of rows in the initial 'TableHead', there will -- be no empty spaces or overlapping cells, and the cells will not -- protrude beyond the grid. normalizeTableHead :: Int -> TableHead -> TableHead normalizeTableHead twidth (TableHead attr rows) = TableHead attr $ normalizeHeaderSection twidth rows -- | Normalize the intermediate head and body section of a -- 'TableBody', as in 'normalizeTableHead', but additionally ensure -- that row head cells do not go beyond the row head inside the -- intermediate body. normalizeTableBody :: Int -> TableBody -> TableBody normalizeTableBody twidth (TableBody attr rhc th tb) = TableBody attr rhc' (normalizeHeaderSection twidth th) (normalizeBodySection twidth rhc' tb) where rhc' = max 0 $ min (RowHeadColumns twidth) rhc -- | Normalize the 'TableFoot', as in 'normalizeTableHead'. normalizeTableFoot :: Int -> TableFoot -> TableFoot normalizeTableFoot twidth (TableFoot attr rows) = TableFoot attr $ normalizeHeaderSection twidth rows normalizeHeaderSection :: Int -- ^ The desired width of the table -> [Row] -> [Row] normalizeHeaderSection twidth rows = normalizeRows' (replicate twidth 1) $ clipRows rows where normalizeRows' oldHang (Row attr cells:rs) = let (newHang, cells', _) = placeRowSection oldHang $ cells <> repeat emptyCell rs' = normalizeRows' newHang rs in Row attr cells' : rs' normalizeRows' _ [] = [] normalizeBodySection :: Int -- ^ The desired width of the table -> RowHeadColumns -- ^ The width of the row head, -- between 0 and the table -- width -> [Row] -> [Row] normalizeBodySection twidth (RowHeadColumns rhc) rows = normalizeRows' (replicate rhc 1) (replicate rbc 1) $ clipRows rows where rbc = twidth - rhc normalizeRows' headHang bodyHang (Row attr cells:rs) = let (headHang', rowHead, cells') = placeRowSection headHang $ cells <> repeat emptyCell (bodyHang', rowBody, _) = placeRowSection bodyHang cells' rs' = normalizeRows' headHang' bodyHang' rs in Row attr (rowHead <> rowBody) : rs' normalizeRows' _ _ [] = [] -- | Normalize the given list of cells so that they fit on a single -- grid row. The 'RowSpan' values of the cells are assumed to be valid -- (clamped to lie between 1 and the remaining grid height). The cells -- in the list are also assumed to be able to fill the entire grid -- row. These conditions can be met by appending @repeat 'emptyCell'@ -- to the @['Cell']@ list and using 'clipRows' on the entire table -- section beforehand. -- -- Normalization follows the principle that cells are placed on a grid -- row in order, each at the first available grid position from the -- left, having their 'ColSpan' reduced if they would overlap with a -- previous cell, stopping once the row is filled. Only the dimensions -- of cells are changed, and only of those cells that fit on the row. -- -- Possible overlap is detected using the given @['RowSpan']@, which -- is the "overhang" of the previous grid row, a list of the heights -- of cells that descend through the previous row, reckoned -- /only from the previous row/. -- Its length should be the width (number of columns) of the current -- grid row. -- -- For example, the numbers in the following headerless grid table -- represent the overhang at each grid position for that table: -- -- @ -- 1 1 1 1 -- +---+---+---+---+ -- | 1 | 2 2 | 3 | -- +---+ + + -- | 1 | 1 1 | 2 | -- +---+---+---+ + -- | 1 1 | 1 | 1 | -- +---+---+---+---+ -- @ -- -- In any table, the row before the first has an overhang of -- @replicate tableWidth 1@, since there are no cells to descend into -- the table from there. The overhang of the first row in the example -- is @[1, 2, 2, 3]@. -- -- So if after 'clipRows' the unnormalized second row of that example -- table were -- -- > r = [("a", 1, 2),("b", 2, 3)] -- the cells displayed as (label, RowSpan, ColSpan) only -- -- a correct invocation of 'placeRowSection' to normalize it would be -- -- >>> placeRowSection [1, 2, 2, 3] $ r ++ repeat emptyCell -- ([1, 1, 1, 2], [("a", 1, 1)], [("b", 2, 3)] ++ repeat emptyCell) -- wouldn't stop printing, of course -- -- and if the third row were only @[("c", 1, 2)]@, then the expression -- would be -- -- >>> placeRowSection [1, 1, 1, 2] $ [("c", 1, 2)] ++ repeat emptyCell -- ([1, 1, 1, 1], [("c", 1, 2), emptyCell], repeat emptyCell) placeRowSection :: [RowSpan] -- ^ The overhang of the previous grid -- row -> [Cell] -- ^ The cells to lay on the grid row -> ([RowSpan], [Cell], [Cell]) -- ^ The overhang of -- the current grid -- row, the normalized -- cells that fit on -- the current row, and -- the remaining -- unmodified cells placeRowSection oldHang cellStream -- If the grid has overhang at our position, try to re-lay in -- the next position. | o:os <- oldHang , o > 1 = let (newHang, newCell, cellStream') = placeRowSection os cellStream in (o - 1 : newHang, newCell, cellStream') -- Otherwise if there is any available width, place the cell and -- continue. | c:cellStream' <- cellStream , (h, w) <- getDim c , w' <- max 1 w , (n, oldHang') <- dropAtMostWhile (== 1) (getColSpan w') oldHang , n > 0 = let w'' = min (ColSpan n) w' c' = setW w'' c (newHang, newCell, remainCell) = placeRowSection oldHang' cellStream' in (replicate (getColSpan w'') h <> newHang, c' : newCell, remainCell) -- Otherwise there is no room in the section, or not enough cells -- were given. | otherwise = ([], [], cellStream) where getColSpan (ColSpan w) = w getDim (Cell _ _ h w _) = (h, w) setW w (Cell a ma h _ b) = Cell a ma h w b dropAtMostWhile :: (a -> Bool) -> Int -> [a] -> (Int, [a]) dropAtMostWhile p n = go 0 where go acc (l:ls) | p l && acc < n = go (acc+1) ls go acc l = (acc, l) -- | Ensure that the height of each cell in a table section lies -- between 1 and the distance from its row to the end of the -- section. So if there were four rows in the input list, the cells in -- the second row would have their height clamped between 1 and 3. clipRows :: [Row] -> [Row] clipRows rows = let totalHeight = RowSpan $ length rows in zipWith clipRowH [totalHeight, totalHeight - 1..1] rows where getH (Cell _ _ h _ _) = h setH h (Cell a ma _ w body) = Cell a ma h w body clipH low high c = let h = getH c in setH (min high $ max low h) c clipRowH high (Row attr cells) = Row attr $ map (clipH 1 high) cells pandoc-types-1.23.1/src/Text/Pandoc/Definition.hs0000644000000000000000000004256207346545000017751 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric, FlexibleContexts, GeneralizedNewtypeDeriving, PatternGuards, CPP, TemplateHaskell , PatternSynonyms, ViewPatterns, StrictData #-} {- Copyright (c) 2006-2023, John MacFarlane All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of John MacFarlane nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} {- | Module : Text.Pandoc.Definition Copyright : Copyright (C) 2006-2023 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable Definition of 'Pandoc' data structure for format-neutral representation of documents. -} module Text.Pandoc.Definition ( Pandoc(..) , Meta(..) , MetaValue(..) , nullMeta , isNullMeta , lookupMeta , docTitle , docAuthors , docDate , Block(..) , pattern SimpleFigure , Inline(..) , ListAttributes , ListNumberStyle(..) , ListNumberDelim(..) , Format(..) , Attr , nullAttr , Caption(..) , ShortCaption , RowHeadColumns(..) , Alignment(..) , ColWidth(..) , ColSpec , Row(..) , TableHead(..) , TableBody(..) , TableFoot(..) , Cell(..) , RowSpan(..) , ColSpan(..) , QuoteType(..) , Target , MathType(..) , Citation(..) , CitationMode(..) , pandocTypesVersion ) where import Data.Generics (Data, Typeable) import Data.Ord (comparing) import Data.Aeson import Data.Aeson.TH (deriveJSON) import qualified Data.Aeson.Types as Aeson import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T import GHC.Generics (Generic) import Data.String import Control.DeepSeq import Paths_pandoc_types (version) import Data.Version (Version, versionBranch) import Data.Semigroup (Semigroup(..)) import Control.Arrow (second) 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 mappend = (<>) -- | Metadata for the document: title, authors, date. newtype Meta = Meta { unMeta :: M.Map Text MetaValue } deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) instance Semigroup Meta where (Meta m1) <> (Meta m2) = Meta (M.union m2 m1) -- note: M.union is left-biased, so if there are fields in both m2 -- and m1, m2 wins. instance Monoid Meta where mempty = Meta M.empty mappend = (<>) data MetaValue = MetaMap (M.Map Text MetaValue) | MetaList [MetaValue] | MetaBool Bool | MetaString Text | MetaInlines [Inline] | MetaBlocks [Block] deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) nullMeta :: Meta nullMeta = Meta M.empty isNullMeta :: Meta -> Bool isNullMeta (Meta m) = M.null m -- Helper functions to extract metadata -- | Retrieve the metadata value for a given @key@. lookupMeta :: Text -> Meta -> Maybe MetaValue lookupMeta key (Meta m) = M.lookup key m -- | Extract document title from metadata; works just like the old @docTitle@. docTitle :: Meta -> [Inline] docTitle meta = case lookupMeta "title" meta of Just (MetaString s) -> [Str s] Just (MetaInlines ils) -> ils Just (MetaBlocks [Plain ils]) -> ils Just (MetaBlocks [Para ils]) -> ils _ -> [] -- | Extract document authors from metadata; works just like the old -- @docAuthors@. docAuthors :: Meta -> [[Inline]] docAuthors meta = case lookupMeta "author" meta of Just (MetaString s) -> [[Str s]] Just (MetaInlines ils) -> [ils] Just (MetaList ms) -> [ils | MetaInlines ils <- ms] ++ [ils | MetaBlocks [Plain ils] <- ms] ++ [ils | MetaBlocks [Para ils] <- ms] ++ [[Str x] | MetaString x <- ms] _ -> [] -- | Extract date from metadata; works just like the old @docDate@. docDate :: Meta -> [Inline] docDate meta = case lookupMeta "date" meta of Just (MetaString s) -> [Str s] Just (MetaInlines ils) -> ils Just (MetaBlocks [Plain ils]) -> ils Just (MetaBlocks [Para ils]) -> ils _ -> [] -- | List attributes. The first element of the triple is the -- start number of the list. type ListAttributes = (Int, ListNumberStyle, ListNumberDelim) -- | Style of list numbers. data ListNumberStyle = DefaultStyle | Example | Decimal | LowerRoman | UpperRoman | LowerAlpha | UpperAlpha deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | Delimiter of list numbers. data ListNumberDelim = DefaultDelim | Period | OneParen | TwoParens deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | Attributes: identifier, classes, key-value pairs type Attr = (Text, [Text], [(Text, Text)]) nullAttr :: Attr nullAttr = ("",[],[]) -- | Formats for raw blocks newtype Format = Format Text deriving (Read, Show, Typeable, Data, Generic, ToJSON, FromJSON) instance IsString Format where fromString f = Format $ T.toCaseFold $ T.pack f instance Eq Format where Format x == Format y = T.toCaseFold x == T.toCaseFold y instance Ord Format where compare (Format x) (Format y) = compare (T.toCaseFold x) (T.toCaseFold y) -- | The number of columns taken up by the row head of each row of a -- 'TableBody'. The row body takes up the remaining columns. newtype RowHeadColumns = RowHeadColumns Int deriving (Eq, Ord, Show, Read, Typeable, Data, Generic, Num, Enum, ToJSON, FromJSON) -- | Alignment of a table column. data Alignment = AlignLeft | AlignRight | AlignCenter | AlignDefault deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | The width of a table column, as a percentage of the text width. data ColWidth = ColWidth Double | ColWidthDefault deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | The specification for a single table column. type ColSpec = (Alignment, ColWidth) -- | A table row. data Row = Row Attr [Cell] deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | The head of a table. data TableHead = TableHead Attr [Row] deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | A body of a table, with an intermediate head, intermediate body, -- and the specified number of row header columns in the intermediate -- body. data TableBody = TableBody Attr RowHeadColumns [Row] [Row] deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | The foot of a table. data TableFoot = TableFoot Attr [Row] deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | A short caption, for use in, for instance, lists of figures. type ShortCaption = [Inline] -- | The caption of a table or figure, with optional short caption. data Caption = Caption (Maybe ShortCaption) [Block] deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | A table cell. data Cell = Cell Attr Alignment RowSpan ColSpan [Block] deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | The number of rows occupied by a cell; the height of a cell. newtype RowSpan = RowSpan Int deriving (Eq, Ord, Show, Read, Typeable, Data, Generic, Num, Enum, ToJSON, FromJSON) -- | The number of columns occupied by a cell; the width of a cell. newtype ColSpan = ColSpan Int deriving (Eq, Ord, Show, Read, Typeable, Data, Generic, Num, Enum, ToJSON, FromJSON) -- | Block element. data Block -- | Plain text, not a paragraph = Plain [Inline] -- | Paragraph | Para [Inline] -- | Multiple non-breaking lines | LineBlock [[Inline]] -- | Code block (literal) with attributes | CodeBlock Attr Text -- | Raw block | RawBlock Format Text -- | Block quote (list of blocks) | BlockQuote [Block] -- | Ordered list (attributes and a list of items, each a list of -- blocks) | OrderedList ListAttributes [[Block]] -- | Bullet list (list of items, each a list of blocks) | BulletList [[Block]] -- | Definition list. Each list item is a pair consisting of a -- term (a list of inlines) and one or more definitions (each a -- list of blocks) | DefinitionList [([Inline],[[Block]])] -- | Header - level (integer) and text (inlines) | Header Int Attr [Inline] -- | Horizontal rule | HorizontalRule -- | Table, with attributes, caption, optional short caption, -- column alignments and widths (required), table head, table -- bodies, and table foot | Table Attr Caption [ColSpec] TableHead [TableBody] TableFoot -- | Figure, with attributes, caption, and content (list of blocks) | Figure Attr Caption [Block] -- | Generic block container with attributes | Div Attr [Block] deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) -- | Type of quotation marks to use in Quoted inline. data QuoteType = SingleQuote | DoubleQuote deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) -- | Link target (URL, title). type Target = (Text, Text) isFigureTarget :: Target -> Maybe Target isFigureTarget tgt | (src, Just tit) <- second (T.stripPrefix "fig:") tgt = Just (src, tit) | otherwise = Nothing -- | Bidirectional patter synonym -- -- It can pass as a Block constructor -- -- >>> SimpleFigure nullAttr [] (T.pack "", T.pack "title") -- Para [Image ("",[],[]) [] ("","fig:title")] -- -- -- It can be used to pattern match -- >>> let img = Para [Image undefined undefined (undefined, T.pack "title")] -- >>> case img of { SimpleFigure _ _ _ -> True; _ -> False } -- False -- >>> let fig = Para [Image undefined undefined (undefined, T.pack "fig:title")] -- >>> case fig of { SimpleFigure _ _ tit -> snd tit; _ -> T.pack "" } -- "title" pattern SimpleFigure :: Attr -> [Inline] -> Target -> Block pattern SimpleFigure attr figureCaption tgt <- Para [Image attr figureCaption (isFigureTarget -> Just tgt)] where SimpleFigure attr figureCaption tgt = Para [Image attr figureCaption (second ("fig:" <>) tgt)] -- | Type of math element (display or inline). data MathType = DisplayMath | InlineMath deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) -- | Inline elements. data Inline = Str Text -- ^ Text (string) | Emph [Inline] -- ^ Emphasized text (list of inlines) | Underline [Inline] -- ^ Underlined text (list of inlines) | Strong [Inline] -- ^ Strongly emphasized text (list of inlines) | Strikeout [Inline] -- ^ Strikeout text (list of inlines) | Superscript [Inline] -- ^ Superscripted text (list of inlines) | Subscript [Inline] -- ^ Subscripted text (list of inlines) | SmallCaps [Inline] -- ^ Small caps text (list of inlines) | Quoted QuoteType [Inline] -- ^ Quoted text (list of inlines) | Cite [Citation] [Inline] -- ^ Citation (list of inlines) | Code Attr Text -- ^ Inline code (literal) | Space -- ^ Inter-word space | SoftBreak -- ^ Soft line break | LineBreak -- ^ Hard line break | Math MathType Text -- ^ TeX math (literal) | RawInline Format Text -- ^ Raw inline | Link Attr [Inline] Target -- ^ Hyperlink: alt text (list of inlines), target | Image Attr [Inline] Target -- ^ Image: alt text (list of inlines), target | Note [Block] -- ^ Footnote or endnote | Span Attr [Inline] -- ^ Generic inline container with attributes deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) data Citation = Citation { citationId :: Text , citationPrefix :: [Inline] , citationSuffix :: [Inline] , citationMode :: CitationMode , citationNoteNum :: Int , citationHash :: Int } deriving (Show, Eq, Read, Typeable, Data, Generic) instance Ord Citation where compare = comparing citationHash data CitationMode = AuthorInText | SuppressAuthor | NormalCitation deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) -- ToJSON/FromJSON instances. Some are defined by hand so that we have -- more control over the format. $(let jsonOpts = defaultOptions { allNullaryToStringTag = False , sumEncoding = TaggedObject { tagFieldName = "t", contentsFieldName = "c" } } in concat <$> traverse (deriveJSON jsonOpts) [ ''MetaValue , ''CitationMode , ''Citation , ''QuoteType , ''MathType , ''ListNumberStyle , ''ListNumberDelim , ''Alignment , ''ColWidth , ''Row , ''Caption , ''TableHead , ''TableBody , ''TableFoot , ''Cell , ''Inline , ''Block ]) instance FromJSON Meta where parseJSON = fmap Meta . parseJSON instance ToJSON Meta where toJSON (Meta m) = toJSON m toEncoding (Meta m) = toEncoding m 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 ] toEncoding (Pandoc meta blks) = pairs $ mconcat [ "pandoc-api-version" .= versionBranch pandocTypesVersion , "meta" .= meta , "blocks" .= blks ] -- Instances for deepseq instance NFData MetaValue instance NFData Meta instance NFData Citation instance NFData Alignment instance NFData RowSpan instance NFData ColSpan instance NFData Cell instance NFData Row instance NFData TableHead instance NFData TableBody instance NFData TableFoot instance NFData Caption instance NFData Inline instance NFData MathType instance NFData Format instance NFData CitationMode instance NFData QuoteType instance NFData ListNumberDelim instance NFData ListNumberStyle instance NFData ColWidth instance NFData RowHeadColumns instance NFData Block instance NFData Pandoc pandocTypesVersion :: Version pandocTypesVersion = version pandoc-types-1.23.1/src/Text/Pandoc/Generic.hs0000644000000000000000000001214207346545000017224 0ustar0000000000000000{-# LANGUAGE CPP #-} {- Copyright (c) 2006-2023, John MacFarlane All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of John MacFarlane nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} {- | Module : Text.Pandoc.Generic Copyright : Copyright (C) 2006-2023 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable Generic functions for manipulating 'Pandoc' documents. (Note: the functions defined in @Text.Pandoc.Walk@ should be used instead, when possible, as they are much faster.) Here's a simple example, defining a function that replaces all the level 3+ headers in a document with regular paragraphs in ALL CAPS: > import Text.Pandoc.Definition > import Text.Pandoc.Generic > import Data.Char (toUpper) > > modHeader :: Block -> Block > modHeader (Header n _ xs) | n >= 3 = Para $ bottomUp allCaps xs > modHeader x = x > > allCaps :: Inline -> Inline > allCaps (Str xs) = Str $ map toUpper xs > allCaps x = x > > changeHeaders :: Pandoc -> Pandoc > changeHeaders = bottomUp modHeader 'bottomUp' is so called because it traverses the @Pandoc@ structure from bottom up. 'topDown' goes the other way. The difference between them can be seen from this example: > normal :: [Inline] -> [Inline] > normal (Space : Space : xs) = Space : xs > normal (Emph xs : Emph ys : zs) = Emph (xs ++ ys) : zs > normal xs = xs > > myDoc :: Pandoc > myDoc = Pandoc nullMeta > [ Para [Str "Hi",Space,Emph [Str "world",Space],Emph [Space,Str "emphasized"]]] Here we want to use 'topDown' to lift @normal@ to @Pandoc -> Pandoc@. The top down strategy will collapse the two adjacent @Emph@s first, then collapse the resulting adjacent @Space@s, as desired. If we used 'bottomUp', we would end up with two adjacent @Space@s, since the contents of the two @Emph@ inlines would be processed before the @Emph@s were collapsed into one. > topDown normal myDoc == > Pandoc nullMeta > [Para [Str "Hi",Space,Emph [Str "world",Space,Str "emphasized"]]] > > bottomUp normal myDoc == > Pandoc nullMeta > [Para [Str "Hi",Space,Emph [Str "world",Space,Space,Str "emphasized"]]] 'bottomUpM' is a monadic version of 'bottomUp'. It could be used, for example, to replace the contents of delimited code blocks with attribute @include=FILENAME@ with the contents of @FILENAME@: > doInclude :: Block -> IO Block > doInclude cb@(CodeBlock (id, classes, namevals) contents) = > case lookup "include" namevals of > Just f -> return . (CodeBlock (id, classes, namevals)) =<< readFile f > Nothing -> return cb > doInclude x = return x > > processIncludes :: Pandoc -> IO Pandoc > processIncludes = bottomUpM doInclude 'queryWith' can be used, for example, to compile a list of URLs linked to in a document: > extractURL :: Inline -> [String] > extractURL (Link _ (u,_)) = [u] > extractURL (Image _ _ (u,_)) = [u] > extractURL _ = [] > > extractURLs :: Pandoc -> [String] > extractURLs = queryWith extractURL -} module Text.Pandoc.Generic where import Data.Generics -- | Applies a transformation on @a@s to matching elements in a @b@, -- moving from the bottom of the structure up. bottomUp :: (Data a, Data b) => (a -> a) -> b -> b bottomUp f = everywhere (mkT f) -- | Applies a transformation on @a@s to matching elements in a @b@, -- moving from the top of the structure down. topDown :: (Data a, Data b) => (a -> a) -> b -> b topDown f = everywhere' (mkT f) -- | Like 'bottomUp', but with monadic transformations. bottomUpM :: (Monad m, Data a, Data b) => (a -> m a) -> b -> m b bottomUpM f = everywhereM (mkM f) -- | Runs a query on matching @a@ elements in a @c@. The results -- of the queries are combined using 'mappend'. queryWith :: (Data a, Monoid b, Data c) => (a -> b) -> c -> b queryWith f = everything mappend (mempty `mkQ` f) pandoc-types-1.23.1/src/Text/Pandoc/JSON.hs0000644000000000000000000001232307346545000016422 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-} {- Copyright (c) 2013-2023, John MacFarlane All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of John MacFarlane nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} {- | Module : Text.Pandoc.JSON Copyright : Copyright (C) 2013-2023 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable Functions for serializing the Pandoc AST to JSON and deserializing from JSON. Example of use: The following script (@capitalize.hs@) reads reads a JSON representation of a Pandoc document from stdin, and writes a JSON representation of a Pandoc document to stdout. It changes all regular text in the document to uppercase, without affecting URLs, code, tags, etc. Run the script with > pandoc -t json | runghc capitalize.hs | pandoc -f json or (making capitalize.hs executable) > pandoc --filter ./capitalize.hs > #!/usr/bin/env runghc > import Text.Pandoc.JSON > import Data.Char (toUpper) > > main :: IO () > main = toJSONFilter capitalizeStrings > > capitalizeStrings :: Inline -> Inline > capitalizeStrings (Str s) = Str $ map toUpper s > capitalizeStrings x = x -} module Text.Pandoc.JSON ( module Text.Pandoc.Definition , ToJSONFilter(..) ) where import Text.Pandoc.Definition import Text.Pandoc.Walk import Control.Monad.IO.Class(MonadIO(liftIO)) import Data.Maybe (listToMaybe) import qualified Data.ByteString.Lazy as BL import qualified Data.Text as T import Data.Aeson import System.Environment (getArgs) -- | 'toJSONFilter' convert a function into a filter that reads pandoc's -- JSON serialized output from stdin, transforms it by walking the AST -- and applying the specified function, and serializes the result as JSON -- to stdout. -- -- For a straight transformation, use a function of type @a -> a@ or -- @a -> IO a@ where @a@ = 'Block', 'Inline', 'Pandoc', 'Meta', or 'MetaValue'. -- -- If your transformation needs to be sensitive to the script's arguments, -- use a function of type @[String] -> a -> a@ (with @a@ constrained as above). -- The @[String]@ will be populated with the script's arguments. -- -- An alternative is to use the type @Maybe Format -> a -> a@. -- This is appropriate when the first argument of the script (if present) -- will be the target format, and allows scripts to behave differently -- depending on the target format. The pandoc executable automatically -- provides the target format as argument when scripts are called using -- the `--filter` option. class ToJSONFilter m a where toJSONFilter :: a -> m () instance (Walkable a Pandoc, MonadIO m) => ToJSONFilter m (a -> a) where toJSONFilter f = liftIO $ BL.getContents >>= BL.putStr . encode . (walk f :: Pandoc -> Pandoc) . either error id . eitherDecode' instance (Walkable [a] Pandoc, MonadIO m) => ToJSONFilter m (a -> [a]) where toJSONFilter f = liftIO $ BL.getContents >>= BL.putStr . encode . (walk (concatMap f) :: Pandoc -> Pandoc) . either error id . eitherDecode' instance (Walkable a Pandoc, MonadIO m) => ToJSONFilter m (a -> m a) where toJSONFilter f = do c <- liftIO BL.getContents r <- walkM f (either error id (eitherDecode' c) :: Pandoc) liftIO (BL.putStr (encode (r :: Pandoc))) instance (Walkable [a] Pandoc, MonadIO m) => ToJSONFilter m (a -> m [a]) where toJSONFilter f = do c <- liftIO BL.getContents r <- (walkM (fmap concat . mapM f)) (either error id (eitherDecode' c) :: Pandoc) liftIO (BL.putStr (encode (r :: Pandoc))) instance (ToJSONFilter m a, MonadIO m) => ToJSONFilter m ([String] -> a) where toJSONFilter f = liftIO getArgs >>= toJSONFilter . f instance (ToJSONFilter m a, MonadIO m) => ToJSONFilter m (Maybe Format -> a) where toJSONFilter f = liftIO getArgs >>= toJSONFilter . f . fmap (Format . T.pack) . listToMaybe pandoc-types-1.23.1/src/Text/Pandoc/Walk.hs0000644000000000000000000005460007346545000016553 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,9,0) {-# OPTIONS_GHC -fno-warn-redundant-constraints -O2 #-} #endif #define OVERLAPS {-# OVERLAPPING #-} {- Copyright (c) 2013-2023, John MacFarlane All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of John MacFarlane nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -} {- | Module : Text.Pandoc.Walk Copyright : Copyright (C) 2013-2023 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable Functions for manipulating 'Pandoc' documents or extracting information from them by walking the 'Pandoc' structure (or intermediate structures like '[Block]' or '[Inline]'. These are faster (by a factor of four or five) than the generic functions defined in @Text.Pandoc.Generic@. Here's a simple example, defining a function that replaces all the level 3+ headers in a document with regular paragraphs in ALL CAPS: > import Text.Pandoc.Definition > import Text.Pandoc.Walk > import Data.Char (toUpper) > > modHeader :: Block -> Block > modHeader (Header n _ xs) | n >= 3 = Para $ walk allCaps xs > modHeader x = x > > allCaps :: Inline -> Inline > allCaps (Str xs) = Str $ map toUpper xs > allCaps x = x > > changeHeaders :: Pandoc -> Pandoc > changeHeaders = walk modHeader 'query' can be used, for example, to compile a list of URLs linked to in a document: > extractURL :: Inline -> [Text] > extractURL (Link _ _ (u,_)) = [u] > extractURL (Image _ _ (u,_)) = [u] > extractURL _ = [] > > extractURLs :: Pandoc -> [Text] > extractURLs = query extractURL -} module Text.Pandoc.Walk ( Walkable(..) , queryBlock , queryCaption , queryRow , queryTableHead , queryTableBody , queryTableFoot , queryCell , queryCitation , queryInline , queryMetaValue , queryMetaValue' , queryPandoc , walkBlockM , walkCaptionM , walkRowM , walkTableHeadM , walkTableBodyM , walkTableFootM , walkCellM , walkCitationM , walkInlineM , walkMetaValueM , walkMetaValueM' , walkPandocM ) where import Control.Applicative (Applicative ((<*>), pure), (<$>)) import Control.Monad ((>=>)) import Data.Functor.Identity (Identity (runIdentity)) import qualified Data.Map as M import Text.Pandoc.Definition import qualified Data.Traversable as T import Data.Traversable (Traversable) import qualified Data.Foldable as F import Data.Foldable (Foldable) import Data.Monoid ((<>)) class Walkable a b where -- | @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, 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) walkM f = T.mapM (walkM f) query f = F.foldMap (query f) -- Walk pairs by handling both elements, then combine the results. instance OVERLAPS (Walkable a b, Walkable a c) => Walkable a (b,c) where walk f (x,y) = (walk f x, walk f y) walkM f (x,y) = do x' <- walkM f x y' <- walkM f y return (x',y') query f (x,y) = mappend (query f x) (query f y) instance Walkable Inline Inline where 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 = walkInlineM query = queryInline instance Walkable Inline Block where walkM = walkBlockM query = queryBlock instance Walkable [Inline] Block where walkM = walkBlockM query = queryBlock instance Walkable Block Block where walkM f x = walkBlockM f x >>= f query f x = f x <> queryBlock f x instance Walkable [Block] Block where walkM = walkBlockM query = queryBlock 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 walkM = walkInlineM query = queryInline instance Walkable [Block] Inline where walkM = walkInlineM query = queryInline -- -- Walk Pandoc -- instance Walkable Block Pandoc where walkM = walkPandocM query = queryPandoc instance Walkable [Block] Pandoc where walkM = walkPandocM query = queryPandoc instance Walkable Inline Pandoc where walkM = walkPandocM query = queryPandoc instance Walkable [Inline] Pandoc where walkM = walkPandocM query = queryPandoc instance Walkable Meta Pandoc where walkM f (Pandoc m bs) = Pandoc <$> f m <*> pure bs query f (Pandoc m _) = f m instance Walkable MetaValue Pandoc where walkM f (Pandoc m bs) = Pandoc <$> walkM f m <*> pure bs query f (Pandoc m _) = query f m instance Walkable Pandoc Pandoc where walkM f = f query f = f -- -- Walk Meta -- instance Walkable Meta Meta where walkM f = f query f = f instance Walkable Inline Meta where 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 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 MetaValue Meta where walkM f (Meta metamap) = Meta . M.fromAscList <$> mapM (\(k, v) -> (,) k <$> walkM f v) (M.toAscList metamap) query f (Meta metamap) = M.foldMapWithKey (const $ query f) metamap -- -- Walk MetaValue -- instance Walkable MetaValue MetaValue where walkM f x = walkMetaValueM' f x >>= f query f x = f x <> queryMetaValue' f x instance Walkable Inline MetaValue where walkM = walkMetaValueM query = queryMetaValue instance Walkable [Inline] MetaValue where walkM = walkMetaValueM query = queryMetaValue instance Walkable Block MetaValue where walkM = walkMetaValueM query = queryMetaValue instance Walkable [Block] MetaValue where walkM = walkMetaValueM query = queryMetaValue -- -- Walk Row -- instance Walkable Inline Row where walkM = walkRowM query = queryRow instance Walkable [Inline] Row where walkM = walkRowM query = queryRow instance Walkable Block Row where walkM = walkRowM query = queryRow instance Walkable [Block] Row where walkM = walkRowM query = queryRow -- -- Walk TableHead -- instance Walkable Inline TableHead where walkM = walkTableHeadM query = queryTableHead instance Walkable [Inline] TableHead where walkM = walkTableHeadM query = queryTableHead instance Walkable Block TableHead where walkM = walkTableHeadM query = queryTableHead instance Walkable [Block] TableHead where walkM = walkTableHeadM query = queryTableHead -- -- Walk TableBody -- instance Walkable Inline TableBody where walkM = walkTableBodyM query = queryTableBody instance Walkable [Inline] TableBody where walkM = walkTableBodyM query = queryTableBody instance Walkable Block TableBody where walkM = walkTableBodyM query = queryTableBody instance Walkable [Block] TableBody where walkM = walkTableBodyM query = queryTableBody -- -- Walk TableFoot -- instance Walkable Inline TableFoot where walkM = walkTableFootM query = queryTableFoot instance Walkable [Inline] TableFoot where walkM = walkTableFootM query = queryTableFoot instance Walkable Block TableFoot where walkM = walkTableFootM query = queryTableFoot instance Walkable [Block] TableFoot where walkM = walkTableFootM query = queryTableFoot -- -- Walk Caption -- instance Walkable Inline Caption where walkM = walkCaptionM query = queryCaption instance Walkable [Inline] Caption where walkM = walkCaptionM query = queryCaption instance Walkable Block Caption where walkM = walkCaptionM query = queryCaption instance Walkable [Block] Caption where walkM = walkCaptionM query = queryCaption -- -- Walk Cell -- instance Walkable Inline Cell where walkM = walkCellM query = queryCell instance Walkable [Inline] Cell where walkM = walkCellM query = queryCell instance Walkable Block Cell where walkM = walkCellM query = queryCell instance Walkable [Block] Cell where walkM = walkCellM query = queryCell -- -- Walk Citation -- instance Walkable Inline Citation where walkM = walkCitationM query = queryCitation instance Walkable [Inline] Citation where walkM = walkCitationM query = queryCitation instance Walkable Block Citation where walkM = walkCitationM query = queryCitation instance Walkable [Block] Citation where walkM = walkCitationM query = queryCitation -- | Helper method to walk to elements nested below @'Inline'@ nodes. -- -- When walking an inline with this function, only the contents of the traversed -- inline element may change. The element itself, i.e. its constructor, cannot -- be changed. 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 (Underline xs) = Underline <$> 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 -- | Perform a query on elements nested below an @'Inline'@ element by -- querying nested lists of @Inline@s, @Block@s, or @Citation@s. 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 (Underline 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 -- | Helper method to walk to elements nested below @'Block'@ nodes. -- -- When walking a block with this function, only the contents of the traversed -- block element may change. The element itself, i.e. its constructor, its @'Attr'@, -- and its raw text value, will remain unchanged. walkBlockM :: (Walkable a [Block], Walkable a [Inline], Walkable a Row, Walkable a Caption, Walkable a TableHead, Walkable a TableBody, Walkable a TableFoot, 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 f (Table attr capt as hs bs fs) = do capt' <- walkM f capt hs' <- walkM f hs bs' <- walkM f bs fs' <- walkM f fs return $ Table attr capt' as hs' bs' fs' walkBlockM f (Figure attr capt blks) = do capt' <- walkM f capt blks' <- walkM f blks return $ Figure attr capt' blks' -- | Perform a query on elements nested below a @'Block'@ element by -- querying all directly nested lists of @Inline@s or @Block@s. queryBlock :: (Walkable a Citation, Walkable a [Block], Walkable a Row, Walkable a Caption, Walkable a TableHead, Walkable a TableBody, Walkable a TableFoot, 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 bs fs) = query f capt <> query f hs <> query f bs <> query f fs queryBlock f (Figure _ capt blks) = query f capt <> query f blks queryBlock f (Div _ bs) = query f bs -- | Helper method to walk to elements nested below @'MetaValue'@ nodes. -- -- When walking a meta value with this function, only the contents of the -- traversed meta value element may change. @MetaBool@ and @MetaString@ will -- always remain unchanged. 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 -- | Helper method to walk @'MetaValue'@ nodes nested below @'MetaValue'@ nodes. walkMetaValueM' :: (Monad f, Applicative f, Functor f) => (MetaValue -> f MetaValue) -> MetaValue -> f MetaValue walkMetaValueM' f (MetaMap m) = MetaMap . M.fromAscList <$> mapM (\(k, v) -> (,) k <$> walkM f v) (M.toAscList m) walkMetaValueM' f (MetaList xs) = MetaList <$> mapM (walkM f) xs walkMetaValueM' _ x = return x -- | Perform a query on elements nested below a @'MetaValue'@ element by -- querying all directly nested lists of @Inline@s, list of @Block@s, or -- lists or maps of @MetaValue@s. 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 -- | Perform a query on @'MetaValue'@ elements nested below a @'MetaValue'@ -- element queryMetaValue' :: Monoid c => (MetaValue -> c) -> MetaValue -> c queryMetaValue' f (MetaMap m) = M.foldMapWithKey (const $ query f) m queryMetaValue' f (MetaList xs) = mconcat $ map (query f) xs queryMetaValue' _ _ = mempty -- | Helper method to walk to elements nested below @'Citation'@ nodes. -- -- The non-inline contents of a citation will remain unchanged during traversal. -- Only the inline contents, viz. the citation's prefix and postfix, will be -- traversed further and can thus be changed during this operation. 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 -- | Perform a query on elements nested below a @'Citation'@ element by -- querying the prefix and postfix @Inline@ lists. queryCitation :: (Walkable a [Inline], Monoid c) => (a -> c) -> Citation -> c queryCitation f (Citation _ pref suff _ _ _) = query f pref <> query f suff -- | Helper method to walk the elements nested below @'Row'@ nodes. The -- @'Attr'@ component is not changed by this operation. walkRowM :: (Walkable a Cell, Monad m) => (a -> m a) -> Row -> m Row walkRowM f (Row attr bd) = Row attr <$> walkM f bd -- | Query the elements below a 'Row' element. queryRow :: (Walkable a Cell, Monoid c) => (a -> c) -> Row -> c queryRow f (Row _ bd) = query f bd -- | Helper method to walk the elements nested below @'TableHead'@ nodes. The -- @'Attr'@ component is not changed by this operation. walkTableHeadM :: (Walkable a Row, Monad m) => (a -> m a) -> TableHead -> m TableHead walkTableHeadM f (TableHead attr body) = TableHead attr <$> walkM f body -- | Query the elements below a 'TableHead' element. queryTableHead :: (Walkable a Row, Monoid c) => (a -> c) -> TableHead -> c queryTableHead f (TableHead _ body) = query f body -- | Helper method to walk the elements nested below @'TableBody'@ -- nodes. The @'Attr'@ and @'RowHeadColumns'@ components are not -- changed by this operation. walkTableBodyM :: (Walkable a Row, Monad m) => (a -> m a) -> TableBody -> m TableBody walkTableBodyM f (TableBody attr rhc hd bd) = TableBody attr rhc <$> walkM f hd <*> walkM f bd -- | Query the elements below a 'TableBody' element. queryTableBody :: (Walkable a Row, Monoid c) => (a -> c) -> TableBody -> c queryTableBody f (TableBody _ _ hd bd) = query f hd <> query f bd -- | Helper method to walk the elements nested below @'TableFoot'@ nodes. The -- @'Attr'@ component is not changed by this operation. walkTableFootM :: (Walkable a Row, Monad m) => (a -> m a) -> TableFoot -> m TableFoot walkTableFootM f (TableFoot attr body) = TableFoot attr <$> walkM f body -- | Query the elements below a 'TableFoot' element. queryTableFoot :: (Walkable a Row, Monoid c) => (a -> c) -> TableFoot -> c queryTableFoot f (TableFoot _ body) = query f body -- | Helper method to walk the elements nested below 'Cell' -- nodes. Only the @['Block']@ cell content is changed by this -- operation. walkCellM :: (Walkable a [Block], Monad m) => (a -> m a) -> Cell -> m Cell walkCellM f (Cell attr ma rs cs content) = Cell attr ma rs cs <$> walkM f content -- | Query the elements below a 'Cell' element. queryCell :: (Walkable a [Block], Monoid c) => (a -> c) -> Cell -> c queryCell f (Cell _ _ _ _ content) = query f content -- | Helper method to walk the elements nested below 'Caption' -- nodes. walkCaptionM :: (Walkable a [Block], Walkable a [Inline], Monad m, Walkable a ShortCaption) => (a -> m a) -> Caption -> m Caption walkCaptionM f (Caption mshort body) = Caption <$> walkM f mshort <*> walkM f body -- | Query the elements below a 'Cell' element. queryCaption :: (Walkable a [Block], Walkable a [Inline], Walkable a ShortCaption, Monoid c) => (a -> c) -> Caption -> c queryCaption f (Caption mshort body) = query f mshort <> query f body -- | Helper method to walk the components of a Pandoc element. 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' -- | Query a pandoc element by recursing first into its @'Meta'@ data -- and then append the result of recursing into the list of @'Block'@s. queryPandoc :: (Walkable a Meta, Walkable a [Block], Monoid c) => (a -> c) -> Pandoc -> c queryPandoc f (Pandoc m bs) = query f m <> query f bs pandoc-types-1.23.1/test/Data/String/0000755000000000000000000000000007346545000015473 5ustar0000000000000000pandoc-types-1.23.1/test/Data/String/QQ.hs0000644000000000000000000000126307346545000016352 0ustar0000000000000000-- | This module is based off the QQ implementation from string-qq -- (https://github.com/audreyt/string-qq). {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE RankNTypes #-} module Data.String.QQ (s) where import Data.String (IsString(..)) import Language.Haskell.TH.Quote (QuasiQuoter(..)) s :: QuasiQuoter s = QuasiQuoter expr pat typ dec where expr = (\a -> [|fromString a|]) . clean pat = error "Cannot use s as a pattern" typ = error "Cannot use s as a type" dec = error "Cannot use s as a dec" clean = removeCarriageReturns . trimLeadingNewline removeCarriageReturns = filter (/= '\r') trimLeadingNewline ('\n':xs) = xs trimLeadingNewline xs = xs pandoc-types-1.23.1/test/0000755000000000000000000000000007346545000013354 5ustar0000000000000000pandoc-types-1.23.1/test/test-pandoc-types.hs0000644000000000000000000010455107346545000017301 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, QuasiQuotes, FlexibleContexts, CPP #-} import Text.Pandoc.Arbitrary () import Text.Pandoc.Definition import Text.Pandoc.Walk import Text.Pandoc.Builder (singleton, plain, text, simpleTable, table, emptyCell, normalizeTableHead, normalizeTableBody, normalizeTableFoot, emptyCaption, simpleFigureWith) import qualified Text.Pandoc.Builder as Builder import Data.Generics import Data.List (tails) import Test.HUnit (Assertion, assertEqual, assertFailure) import Data.Aeson (FromJSON, ToJSON, encode, decode) import Test.Framework import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.HUnit (testCase) import Test.QuickCheck (forAll, choose, Property, Arbitrary, Testable, arbitrary, Gen) import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T import Data.String.QQ import Data.ByteString.Lazy (ByteString) 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 $ T.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 metaValueTrans :: MetaValue -> MetaValue metaValueTrans (MetaBool x) = MetaBool $ not x metaValueTrans (MetaString xs) = MetaString $ T.toUpper xs metaValueTrans x = x metaTrans :: Meta -> Meta metaTrans (Meta metamap) = Meta $ M.mapKeys T.toUpper metamap inlineQuery :: Inline -> Text 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 metaValueQuery :: MetaValue -> Text metaValueQuery (MetaString xs) = xs metaValueQuery _ = "" metaQuery :: Meta -> Monoid.Sum Int metaQuery (Meta metamap) = Monoid.Sum $ M.size metamap 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_meta :: (Meta, ByteString) t_meta = ( Meta $ M.fromList [("foo", MetaBool True)] , [s|{"foo":{"t":"MetaBool","c":true}}|] ) 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 [HorizontalRule,HorizontalRule], [s|{"t":"MetaBlocks","c":[{"t":"HorizontalRule"},{"t":"HorizontalRule"}]}|]) 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|{"citationId":"jameson:unconscious","citationPrefix":[{"t":"Str","c":"cf"}],"citationSuffix":[{"t":"Space"},{"t":"Str","c":"123"}],"citationMode":{"t":"NormalCitation"},"citationNoteNum":0,"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_underline :: (Inline, ByteString) t_underline = ( Underline [Str "Hello"] , [s|{"t":"Underline","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":[[{"citationId":"jameson:unconscious","citationPrefix":[{"t":"Str","c":"cf"}],"citationSuffix":[{"t":"Space"},{"t":"Str","c":"12"}],"citationMode":{"t":"NormalCitation"},"citationNoteNum":0,"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_row :: (Row, ByteString) t_row = (Row ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) [Cell ("", [], []) AlignRight 2 3 [Para [Str "bar"]]] ,[s|[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["",[],[]],{"t":"AlignRight"},2,3,[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]]]|]) t_caption :: (Caption, ByteString) t_caption = (Caption (Just [Str "foo"]) [Para [Str "bar"]] ,[s|[[{"t":"Str","c":"foo"}],[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]|]) t_tablehead :: (TableHead, ByteString) t_tablehead = (TableHead ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) [Row ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) []] ,[s|[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[]]]]|]) t_tablebody :: (TableBody, ByteString) t_tablebody = (TableBody ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) 3 [Row ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) []] [Row ("id'",["kls'"],[("k1", "v1"), ("k2", "v2")]) []] ,[s|[["id",["kls"],[["k1","v1"],["k2","v2"]]],3,[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[]]],[[["id'",["kls'"],[["k1","v1"],["k2","v2"]]],[]]]]|]) t_tablefoot :: (TableFoot, ByteString) t_tablefoot = (TableFoot ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) [Row ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) []] ,[s|[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[]]]]|]) t_cell :: (Cell, ByteString) t_cell = (Cell ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) AlignLeft 1 1 [Para [Str "bar"]] ,[s|[["id",["kls"],[["k1","v1"],["k2","v2"]]],{"t":"AlignLeft"},1,1,[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]|]) t_rowheadcolumns :: (RowHeadColumns, ByteString) t_rowheadcolumns = (1 ,[s|1|]) t_rowspan :: (RowSpan, ByteString) t_rowspan = (1 ,[s|1|]) t_colspan :: (ColSpan, ByteString) t_colspan = (1 ,[s|1|]) t_table :: (Block, ByteString) t_table = ( Table ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) (Caption (Just [Str "short"]) [Para [Str "Demonstration" ,Space ,Str "of" ,Space ,Str "simple" ,Space ,Str "table" ,Space ,Str "syntax."]]) [(AlignDefault,ColWidthDefault) ,(AlignRight,ColWidthDefault) ,(AlignLeft,ColWidthDefault) ,(AlignCenter,ColWidthDefault) ,(AlignDefault,ColWidthDefault)] (TableHead ("idh", ["klsh"], [("k1h", "v1h"), ("k2h", "v2h")]) [tRow [tCell [Str "Head"] ,tCell [Str "Right"] ,tCell [Str "Left"] ,tCell [Str "Center"] ,tCell [Str "Default"]]]) [TableBody ("idb", ["klsb"], [("k1b", "v1b"), ("k2b", "v2b")]) 1 [tRow [tCell [Str "ihead12"] ,tCell [Str "i12"] ,tCell [Str "i12"] ,tCell [Str "i12"] ,tCell [Str "i12"]]] [tRow [tCell [Str "head12"] ,tCell' [Str "12"] ,tCell [Str "12"] ,tCell' [Str "12"] ,tCell [Str "12"]] ,tRow [tCell [Str "head123"] ,tCell [Str "123"] ,tCell [Str "123"] ,tCell [Str "123"] ,tCell [Str "123"]] ,tRow [tCell [Str "head1"] ,tCell [Str "1"] ,tCell [Str "1"] ,tCell [Str "1"] ,tCell [Str "1"]]]] (TableFoot ("idf", ["klsf"], [("k1f", "v1f"), ("k2f", "v2f")]) [tRow [tCell [Str "foot"] ,tCell [Str "footright"] ,tCell [Str "footleft"] ,tCell [Str "footcenter"] ,tCell [Str "footdefault"]]]) ,[s|{"t":"Table","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[{"t":"Str","c":"short"}],[{"t":"Para","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":"AlignDefault"},{"t":"ColWidthDefault"}],[{"t":"AlignRight"},{"t":"ColWidthDefault"}],[{"t":"AlignLeft"},{"t":"ColWidthDefault"}],[{"t":"AlignCenter"},{"t":"ColWidthDefault"}],[{"t":"AlignDefault"},{"t":"ColWidthDefault"}]],[["idh",["klsh"],[["k1h","v1h"],["k2h","v2h"]]],[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Head"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Right"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Left"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Center"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"Default"}]}]]]]]],[[["idb",["klsb"],[["k1b","v1b"],["k2b","v2b"]]],1,[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"ihead12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"i12"}]}]]]]],[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"head12"}]}]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]]]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"head123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]]]],[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"head1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]]]]]]],[["idf",["klsf"],[["k1f","v1f"],["k2f","v2f"]]],[[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"foot"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footright"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footleft"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footcenter"}]}]],[["a",["b"],[["c","d"],["e","f"]]],{"t":"AlignDefault"},1,1,[{"t":"Plain","c":[{"t":"Str","c":"footdefault"}]}]]]]]]]}|] ) where tCell i = Cell ("a", ["b"], [("c", "d"), ("e", "f")]) AlignDefault 1 1 [Plain i] tCell' i = Cell ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) AlignDefault 1 1 [Plain i] tRow = Row ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) t_figure :: (Block, ByteString) t_figure = (Figure ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) (Caption (Just [Str "hello"]) [Para [Str "cap content"]]) [Para [Str "fig content"]] ,[s|{"t":"Figure","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[[{"t":"Str","c":"hello"}],[{"t":"Para","c":[{"t":"Str","c":"cap content"}]}]],[{"t":"Para","c":[{"t":"Str","c":"fig content"}]}]]}|] ) 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"}]}]]}|] ) -- headers and rows are padded to a consistent number of -- cells in order to avoid syntax errors after conversion, see -- jgm/pandoc#4059. -- This may change as the table representation changes. t_tableSan :: Test t_tableSan = testCase "table sanitisation" assertion where assertion = assertEqual err expected generated err = "sanitisation error" generated = simpleTable [plain (text "foo"), plain (text "bar")] [[mempty] ,[]] tCell i = Cell nullAttr AlignDefault 1 1 [Plain [Str i]] emptyRow = Row nullAttr $ replicate 2 emptyCell expected = singleton (Table nullAttr (Caption Nothing []) [(AlignDefault,ColWidthDefault) ,(AlignDefault,ColWidthDefault)] (TableHead nullAttr [Row nullAttr [tCell "foo" ,tCell "bar"]]) [TableBody nullAttr 0 [] [emptyRow ,emptyRow]] (TableFoot nullAttr [])) withWidth :: Testable prop => (Int -> prop) -> Property withWidth = forAll $ choose (2 :: Int, 16) widthNormIsIdempotent :: (Arbitrary a, Show a, Eq a) => (Int -> a -> a) -> Property widthNormIsIdempotent f = withWidth $ \n a -> let a' = f n a in f n a' == a' p_tableNormHeadIdempotent :: Property p_tableNormHeadIdempotent = widthNormIsIdempotent normalizeTableHead p_tableNormBodyIdempotent :: Property p_tableNormBodyIdempotent = widthNormIsIdempotent normalizeTableBody p_tableNormFootIdempotent :: Property p_tableNormFootIdempotent = widthNormIsIdempotent normalizeTableFoot cellSubset :: Cell -> Cell -> Bool cellSubset (Cell attr1 align1 rs1 cs1 body1) (Cell attr2 align2 rs2 cs2 body2) = and [ attr1 == attr2 , align1 == align2 , dimValid rs1 rs2 , dimValid cs1 cs2 , body1 == body2 ] where dimValid x y = (y < 1 && x == 1) || (x >= 1 && x <= y) -- True when the first list is an initial segment of the second, -- modulo cell subsetting and the appending of padding cells onto the -- second. cellsSubsetPad :: [Cell] -> [Cell] -> Bool cellsSubsetPad (x:xs) (y:ys) = cellSubset x y && cellsSubsetPad xs ys cellsSubsetPad xs _ = all isPadCell xs where isPadCell = (== emptyCell) -- Only valid for the TableHead and TableFoot. See also -- p_tableNormBodyIsSubset. rowSubset :: Row -> Row -> Bool rowSubset (Row a1 x1) (Row a2 x2) = a1 == a2 && cellsSubsetPad x1 x2 -- The remarks in rowSubset apply. rowsSubset :: [Row] -> [Row] -> Bool rowsSubset (x:xs) (y:ys) = rowSubset x y && rowsSubset xs ys rowsSubset [] _ = True rowsSubset (_:_) [] = False normIsSubset :: (Arbitrary a, Show a, Eq a) => (Int -> a -> a) -> (a -> [Row]) -> Property normIsSubset f proj = withWidth $ \n a -> let a' = f n a in proj a' `rowsSubset` proj a p_tableNormHeadIsSubset :: Property p_tableNormHeadIsSubset = normIsSubset normalizeTableHead thproj where thproj (TableHead _ r) = r -- Checking that each row is a subset of its unnormalized version is a -- little onerous in the TableBody (because of the row head/row body -- distinction), so we settle for testing it only for the first row of -- the intermediate body. The intermediate head is still checked -- fully. p_tableNormBodyIsSubset :: Property p_tableNormBodyIsSubset = withWidth $ \n tb -> checkBody n (normalizeTableBody n tb) tb where cellLength (Cell _ _ _ (ColSpan w) _) = w cellLengths = sum . map cellLength gatherLen n = gatherLen' n 0 gatherLen' n count (c:cs) | count < n = let (beg, end) = gatherLen' n (count + cellLength c) cs in (c : beg, end) gatherLen' _ _ cs = ([], cs) -- Gather as much of the head as we can from the new and old rows, -- then make sure the dimensions line up and the subsetting is -- correct. checkRow n rhc (Row _ r') (Row _ r) = let (rhead', rbody') = gatherLen rhc r' (rhead, rbody) = gatherLen rhc r in and [ cellLengths rhead' == rhc , rhc + cellLengths rbody' == n , cellsSubsetPad rhead' rhead , cellsSubsetPad rbody' rbody ] checkRows n rhc (r':_) (r:_) = checkRow n rhc r' r checkRows _ _ [] [] = True checkRows _ _ _ _ = False checkBody n (TableBody _ (RowHeadColumns rhc) th' tb') (TableBody _ _ th tb) = rowsSubset th' th && checkRows n rhc tb' tb p_tableNormFootIsSubset :: Property p_tableNormFootIsSubset = normIsSubset normalizeTableFoot tfproj where tfproj (TableFoot _ r) = r -- True when the first row in a section (table head, table foot, -- intermediate header, body of table body) has the correct -- width. Only with the first row is it easy to check. firstRowCorrectWidth :: Int -> [Row] -> [Row] -> Bool firstRowCorrectWidth n (Row _ cs:_) (_:_) = n == sum (map cellLength cs) where cellLength (Cell _ _ _ (ColSpan w) _) = w firstRowCorrectWidth _ [] [] = True firstRowCorrectWidth _ _ _ = False testRowCorrectWidth :: (Arbitrary a, Show a, Eq a) => (Int -> a -> a) -> (a -> [Row]) -> Property testRowCorrectWidth f proj = withWidth $ \n a -> let a' = f n a in firstRowCorrectWidth n (proj a') (proj a) p_tableNormHeadRowWidth :: Property p_tableNormHeadRowWidth = testRowCorrectWidth normalizeTableHead thproj where thproj (TableHead _ r) = r p_tableNormBodyRowWidth :: Property p_tableNormBodyRowWidth = withWidth $ \n tb -> compBody n tb $ normalizeTableBody n tb where compBody n (TableBody _ _ th tb) (TableBody _ _ th' tb') = firstRowCorrectWidth n th' th && firstRowCorrectWidth n tb' tb p_tableNormFootRowWidth :: Property p_tableNormFootRowWidth = testRowCorrectWidth normalizeTableFoot tfproj where tfproj (TableFoot _ r) = r t_tableNormExample :: Test t_tableNormExample = testCase "table normalization example" assertion where assertion = assertEqual "normalization error" expected generated cl a h w = Cell (a, [], []) AlignDefault h w [] rws = map $ Row nullAttr th = TableHead nullAttr . rws tb n x y = TableBody nullAttr n (rws x) (rws y) tf = TableFoot nullAttr . rws initialHeads = [[cl "a" 1 1,cl "b" 3 2] ,[cl "c" 2 2 ,cl "d" 1 1] ] finalHeads = [[cl "a" 1 1, cl "b" 2 2] ,[cl "c" 1 1] ] initialTB = tb 1 [[] ,[cl "g" (-7) 0,cl "h" 4 1]] [[cl "e" 4 3 ,cl "f" 4 3] ,[] ,[emptyCell] ] finalTB = tb 1 [[emptyCell,emptyCell,emptyCell] ,[cl "g" 1 1,cl "h" 1 1,emptyCell]] [[cl "e" 3 1,cl "f" 3 2] ,[] ,[]] spec = replicate 3 (AlignDefault, ColWidthDefault) expected = singleton $ Table nullAttr emptyCaption spec (th finalHeads) [finalTB] (tf finalHeads) generated = table emptyCaption spec (th initialHeads) [initialTB] (tf initialHeads) p_figureRepresentation :: Property p_figureRepresentation = forAll (arbitrary :: Gen [Inline]) $ \figureCaption -> simpleFigureWith ("test", [], []) (Builder.fromList figureCaption) "url" "title" == Builder.fromList [Figure nullAttr (Caption Nothing [Plain figureCaption | not (null figureCaption)]) [Plain [Image ("test", [], []) mempty ("url", "title") ]]] tests :: [Test] tests = [ testGroup "Walk" [ testProperty "p_walk inlineTrans" (p_walk inlineTrans) , testProperty "p_walk blockTrans" (p_walk blockTrans) , testProperty "p_walk metaValueTrans" (p_walk metaValueTrans) , testProperty "p_walk metaTrans" (p_walk metaTrans) , testProperty "p_query inlineQuery" (p_query inlineQuery) , testProperty "p_query blockQuery" (p_query blockQuery) , testProperty "p_query metaValueQuery" (p_query metaValueQuery) , testProperty "p_query metaQuery" (p_query metaQuery) , 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" [ testProperty "round-trip" prop_roundtrip ] , testGroup "JSON encoding/decoding" [ testGroup "Meta" [ testEncodeDecode "Meta" t_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 "Underline" t_underline , 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 "Figure" t_figure , testEncodeDecode "Div" t_div ] , testGroup "Table" [ testEncodeDecode "Row" t_row , testEncodeDecode "Caption" t_caption , testEncodeDecode "TableHead" t_tablehead , testEncodeDecode "TableBody" t_tablebody , testEncodeDecode "TableFoot" t_tablefoot , testEncodeDecode "Cell" t_cell , testEncodeDecode "RowHeadColumns" t_rowheadcolumns , testEncodeDecode "RowSpan" t_rowspan , testEncodeDecode "ColSpan" t_colspan ] ] ] , testGroup "Table normalization" [ testProperty "p_tableNormHeadIdempotent" p_tableNormHeadIdempotent , testProperty "p_tableNormBodyIdempotent" p_tableNormBodyIdempotent , testProperty "p_tableNormFootIdempotent" p_tableNormFootIdempotent , testProperty "p_tableNormHeadIsSubset" p_tableNormHeadIsSubset , testProperty "p_tableNormBodyIsSubset" p_tableNormBodyIsSubset , testProperty "p_tableNormFootIsSubset" p_tableNormFootIsSubset , testProperty "p_tableNormHeadRowWidth" p_tableNormHeadRowWidth , testProperty "p_tableNormBodyRowWidth" p_tableNormBodyRowWidth , testProperty "p_tableNormFootRowWidth" p_tableNormFootRowWidth ] , t_tableSan , t_tableNormExample , testGroup "Figure" [ testProperty "p_figureRepresentation figure representation" p_figureRepresentation ] ] main :: IO () main = defaultMain tests