pandoc-types 1.10 → 1.23.1.2
raw patch · 16 files changed
Files
- COPYING +0/−340
- LICENSE +30/−0
- Text/Pandoc/Builder.hs +0/−402
- Text/Pandoc/Definition.hs +0/−161
- Text/Pandoc/Generic.hs +0/−135
- benchmark/bench.hs +39/−0
- changelog +403/−0
- pandoc-types.cabal +68/−19
- src/Text/Pandoc/Arbitrary.hs +405/−0
- src/Text/Pandoc/Builder.hs +756/−0
- src/Text/Pandoc/Definition.hs +475/−0
- src/Text/Pandoc/Generic.hs +141/−0
- src/Text/Pandoc/JSON.hs +133/−0
- src/Text/Pandoc/Walk.hs +664/−0
- test/Data/String/QQ.hs +19/−0
- test/test-pandoc-types.hs +791/−0
− COPYING
@@ -1,340 +0,0 @@- GNU GENERAL PUBLIC LICENSE- Version 2, June 1991-- Copyright (C) 1989, 1991 Free Software Foundation, Inc.- 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA- Everyone is permitted to copy and distribute verbatim copies- of this license document, but changing it is not allowed.-- Preamble-- The licenses for most software are designed to take away your-freedom to share and change it. By contrast, the GNU General Public-License is intended to guarantee your freedom to share and change free-software--to make sure the software is free for all its users. This-General Public License applies to most of the Free Software-Foundation's software and to any other program whose authors commit to-using it. (Some other Free Software Foundation software is covered by-the GNU Library General Public License instead.) You can apply it to-your programs, too.-- When we speak of free software, we are referring to freedom, not-price. Our General Public Licenses are designed to make sure that you-have the freedom to distribute copies of free software (and charge for-this service if you wish), that you receive source code or can get it-if you want it, that you can change the software or use pieces of it-in new free programs; and that you know you can do these things.-- To protect your rights, we need to make restrictions that forbid-anyone to deny you these rights or to ask you to surrender the rights.-These restrictions translate to certain responsibilities for you if you-distribute copies of the software, or if you modify it.-- For example, if you distribute copies of such a program, whether-gratis or for a fee, you must give the recipients all the rights that-you have. You must make sure that they, too, receive or can get the-source code. And you must show them these terms so they know their-rights.-- We protect your rights with two steps: (1) copyright the software, and-(2) offer you this license which gives you legal permission to copy,-distribute and/or modify the software.-- Also, for each author's protection and ours, we want to make certain-that everyone understands that there is no warranty for this free-software. If the software is modified by someone else and passed on, we-want its recipients to know that what they have is not the original, so-that any problems introduced by others will not reflect on the original-authors' reputations.-- Finally, any free program is threatened constantly by software-patents. We wish to avoid the danger that redistributors of a free-program will individually obtain patent licenses, in effect making the-program proprietary. To prevent this, we have made it clear that any-patent must be licensed for everyone's free use or not licensed at all.-- The precise terms and conditions for copying, distribution and-modification follow.-- GNU GENERAL PUBLIC LICENSE- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION-- 0. This License applies to any program or other work which contains-a notice placed by the copyright holder saying it may be distributed-under the terms of this General Public License. The "Program", below,-refers to any such program or work, and a "work based on the Program"-means either the Program or any derivative work under copyright law:-that is to say, a work containing the Program or a portion of it,-either verbatim or with modifications and/or translated into another-language. (Hereinafter, translation is included without limitation in-the term "modification".) Each licensee is addressed as "you".--Activities other than copying, distribution and modification are not-covered by this License; they are outside its scope. The act of-running the Program is not restricted, and the output from the Program-is covered only if its contents constitute a work based on the-Program (independent of having been made by running the Program).-Whether that is true depends on what the Program does.-- 1. You may copy and distribute verbatim copies of the Program's-source code as you receive it, in any medium, provided that you-conspicuously and appropriately publish on each copy an appropriate-copyright notice and disclaimer of warranty; keep intact all the-notices that refer to this License and to the absence of any warranty;-and give any other recipients of the Program a copy of this License-along with the Program.--You may charge a fee for the physical act of transferring a copy, and-you may at your option offer warranty protection in exchange for a fee.-- 2. You may modify your copy or copies of the Program or any portion-of it, thus forming a work based on the Program, and copy and-distribute such modifications or work under the terms of Section 1-above, provided that you also meet all of these conditions:-- a) You must cause the modified files to carry prominent notices- stating that you changed the files and the date of any change.-- b) You must cause any work that you distribute or publish, that in- whole or in part contains or is derived from the Program or any- part thereof, to be licensed as a whole at no charge to all third- parties under the terms of this License.-- c) If the modified program normally reads commands interactively- when run, you must cause it, when started running for such- interactive use in the most ordinary way, to print or display an- announcement including an appropriate copyright notice and a- notice that there is no warranty (or else, saying that you provide- a warranty) and that users may redistribute the program under- these conditions, and telling the user how to view a copy of this- License. (Exception: if the Program itself is interactive but- does not normally print such an announcement, your work based on- the Program is not required to print an announcement.)--These requirements apply to the modified work as a whole. If-identifiable sections of that work are not derived from the Program,-and can be reasonably considered independent and separate works in-themselves, then this License, and its terms, do not apply to those-sections when you distribute them as separate works. But when you-distribute the same sections as part of a whole which is a work based-on the Program, the distribution of the whole must be on the terms of-this License, whose permissions for other licensees extend to the-entire whole, and thus to each and every part regardless of who wrote it.--Thus, it is not the intent of this section to claim rights or contest-your rights to work written entirely by you; rather, the intent is to-exercise the right to control the distribution of derivative or-collective works based on the Program.--In addition, mere aggregation of another work not based on the Program-with the Program (or with a work based on the Program) on a volume of-a storage or distribution medium does not bring the other work under-the scope of this License.-- 3. You may copy and distribute the Program (or a work based on it,-under Section 2) in object code or executable form under the terms of-Sections 1 and 2 above provided that you also do one of the following:-- a) Accompany it with the complete corresponding machine-readable- source code, which must be distributed under the terms of Sections- 1 and 2 above on a medium customarily used for software interchange; or,-- b) Accompany it with a written offer, valid for at least three- years, to give any third party, for a charge no more than your- cost of physically performing source distribution, a complete- machine-readable copy of the corresponding source code, to be- distributed under the terms of Sections 1 and 2 above on a medium- customarily used for software interchange; or,-- c) Accompany it with the information you received as to the offer- to distribute corresponding source code. (This alternative is- allowed only for noncommercial distribution and only if you- received the program in object code or executable form with such- an offer, in accord with Subsection b above.)--The source code for a work means the preferred form of the work for-making modifications to it. For an executable work, complete source-code means all the source code for all modules it contains, plus any-associated interface definition files, plus the scripts used to-control compilation and installation of the executable. However, as a-special exception, the source code distributed need not include-anything that is normally distributed (in either source or binary-form) with the major components (compiler, kernel, and so on) of the-operating system on which the executable runs, unless that component-itself accompanies the executable.--If distribution of executable or object code is made by offering-access to copy from a designated place, then offering equivalent-access to copy the source code from the same place counts as-distribution of the source code, even though third parties are not-compelled to copy the source along with the object code.-- 4. You may not copy, modify, sublicense, or distribute the Program-except as expressly provided under this License. Any attempt-otherwise to copy, modify, sublicense or distribute the Program is-void, and will automatically terminate your rights under this License.-However, parties who have received copies, or rights, from you under-this License will not have their licenses terminated so long as such-parties remain in full compliance.-- 5. You are not required to accept this License, since you have not-signed it. However, nothing else grants you permission to modify or-distribute the Program or its derivative works. These actions are-prohibited by law if you do not accept this License. Therefore, by-modifying or distributing the Program (or any work based on the-Program), you indicate your acceptance of this License to do so, and-all its terms and conditions for copying, distributing or modifying-the Program or works based on it.-- 6. Each time you redistribute the Program (or any work based on the-Program), the recipient automatically receives a license from the-original licensor to copy, distribute or modify the Program subject to-these terms and conditions. You may not impose any further-restrictions on the recipients' exercise of the rights granted herein.-You are not responsible for enforcing compliance by third parties to-this License.-- 7. If, as a consequence of a court judgment or allegation of patent-infringement or for any other reason (not limited to patent issues),-conditions are imposed on you (whether by court order, agreement or-otherwise) that contradict the conditions of this License, they do not-excuse you from the conditions of this License. If you cannot-distribute so as to satisfy simultaneously your obligations under this-License and any other pertinent obligations, then as a consequence you-may not distribute the Program at all. For example, if a patent-license would not permit royalty-free redistribution of the Program by-all those who receive copies directly or indirectly through you, then-the only way you could satisfy both it and this License would be to-refrain entirely from distribution of the Program.--If any portion of this section is held invalid or unenforceable under-any particular circumstance, the balance of the section is intended to-apply and the section as a whole is intended to apply in other-circumstances.--It is not the purpose of this section to induce you to infringe any-patents or other property right claims or to contest validity of any-such claims; this section has the sole purpose of protecting the-integrity of the free software distribution system, which is-implemented by public license practices. Many people have made-generous contributions to the wide range of software distributed-through that system in reliance on consistent application of that-system; it is up to the author/donor to decide if he or she is willing-to distribute software through any other system and a licensee cannot-impose that choice.--This section is intended to make thoroughly clear what is believed to-be a consequence of the rest of this License.-- 8. If the distribution and/or use of the Program is restricted in-certain countries either by patents or by copyrighted interfaces, the-original copyright holder who places the Program under this License-may add an explicit geographical distribution limitation excluding-those countries, so that distribution is permitted only in or among-countries not thus excluded. In such case, this License incorporates-the limitation as if written in the body of this License.-- 9. The Free Software Foundation may publish revised and/or new versions-of the General Public License from time to time. Such new versions will-be similar in spirit to the present version, but may differ in detail to-address new problems or concerns.--Each version is given a distinguishing version number. If the Program-specifies a version number of this License which applies to it and "any-later version", you have the option of following the terms and conditions-either of that version or of any later version published by the Free-Software Foundation. If the Program does not specify a version number of-this License, you may choose any version ever published by the Free Software-Foundation.-- 10. If you wish to incorporate parts of the Program into other free-programs whose distribution conditions are different, write to the author-to ask for permission. For software which is copyrighted by the Free-Software Foundation, write to the Free Software Foundation; we sometimes-make exceptions for this. Our decision will be guided by the two goals-of preserving the free status of all derivatives of our free software and-of promoting the sharing and reuse of software generally.-- NO WARRANTY-- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,-REPAIR OR CORRECTION.-- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE-POSSIBILITY OF SUCH DAMAGES.-- END OF TERMS AND CONDITIONS-- How to Apply These Terms to Your New Programs-- If you develop a new program, and you want it to be of the greatest-possible use to the public, the best way to achieve this is to make it-free software which everyone can redistribute and change under these terms.-- To do so, attach the following notices to the program. It is safest-to attach them to the start of each source file to most effectively-convey the exclusion of warranty; and each file should have at least-the "copyright" line and a pointer to where the full notice is found.-- <one line to give the program's name and a brief idea of what it does.>- Copyright (C) <year> <name of author>-- This program is free software; you can redistribute it and/or modify- it under the terms of the GNU General Public License as published by- the Free Software Foundation; either version 2 of the License, or- (at your option) any later version.-- This program is distributed in the hope that it will be useful,- but WITHOUT ANY WARRANTY; without even the implied warranty of- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the- GNU General Public License for more details.-- You should have received a copy of the GNU General Public License- along with this program; if not, write to the Free Software- Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA---Also add information on how to contact you by electronic and paper mail.--If the program is interactive, make it output a short notice like this-when it starts in an interactive mode:-- Gnomovision version 69, Copyright (C) year name of author- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.- This is free software, and you are welcome to redistribute it- under certain conditions; type `show c' for details.--The hypothetical commands `show w' and `show c' should show the appropriate-parts of the General Public License. Of course, the commands you use may-be called something other than `show w' and `show c'; they could even be-mouse-clicks or menu items--whatever suits your program.--You should also get your employer (if you work as a programmer) or your-school, if any, to sign a "copyright disclaimer" for the program, if-necessary. Here is a sample; alter the names:-- Yoyodyne, Inc., hereby disclaims all copyright interest in the program- `Gnomovision' (which makes passes at compilers) written by James Hacker.-- <signature of Ty Coon>, 1 April 1989- Ty Coon, President of Vice--This General Public License does not permit incorporating your program into-proprietary programs. If your program is a subroutine library, you may-consider it more useful to permit linking proprietary applications with the-library. If this is what you want to do, use the GNU Library General-Public License instead of this License.
+ LICENSE view
@@ -0,0 +1,30 @@+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.
− Text/Pandoc/Builder.hs
@@ -1,402 +0,0 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses,- DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP, StandaloneDeriving #-}-#ifdef GENERICS-{-# LANGUAGE DeriveGeneric #-}-#endif-{--Copyright (C) 2010-2012 John MacFarlane <jgm@berkeley.edu>--This program is free software; you can redistribute it and/or modify-it under the terms of the GNU General Public License as published by-the Free Software Foundation; either version 2 of the License, or-(at your option) any later version.--This program is distributed in the hope that it will be useful,-but WITHOUT ANY WARRANTY; without even the implied warranty of-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-GNU General Public License for more details.--You should have received a copy of the GNU General Public License-along with this program; if not, write to the Free Software-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA--}--{- |- Module : Text.Pandoc.Builder- Copyright : Copyright (C) 2010 John MacFarlane- License : GNU GPL, version 2 or above-- Maintainer : John MacFarlane <jgm@berkeley.edu>- Stability : alpha- Portability : portable--Convenience functions for building pandoc documents programmatically.--Example of use:--> {-# LANGUAGE OverloadedStrings #-}-> 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->-> myDoc :: Pandoc-> myDoc = Pandoc (Meta {docTitle = [Str "My",Space,Str "title"]-> , docAuthors = []-> , docDate = []})-> [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 [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- -- , Listable(..)- -- * Document builders- , doc- , setTitle- , setAuthors- , setDate- -- * Inline list builders- , text- , str- , emph- , strong- , strikeout- , superscript- , subscript- , smallcaps- , singleQuoted- , doubleQuoted- , cite- , codeWith- , code- , space- , linebreak- , math- , displayMath- , rawInline- , link- , image- , note- , trimInlines- -- * Block list builders- , para- , plain- , codeBlockWith- , codeBlock- , rawBlock- , blockQuote- , bulletList- , orderedListWith- , orderedList- , definitionList- , header- , headerWith- , horizontalRule- , table- , simpleTable- )-where-import Text.Pandoc.Definition-import Data.String-import Data.Monoid-import Data.Maybe (fromMaybe)-import Data.Sequence (Seq, (|>), viewr, viewl, ViewR(..), ViewL(..))-import qualified Data.Sequence as Seq-import Data.Foldable (Foldable)-import qualified Data.Foldable as F-import Data.List (groupBy, intersperse)-import Data.Data-import Data.Typeable-import Data.Traversable-import Control.Arrow ((***))-#ifdef GENERICS-import GHC.Generics (Generic)-#endif--#if MIN_VERSION_base(4,5,0)--- (<>) is defined in Data.Monoid-#else-infixr 6 <>---- | An infix synonym for 'mappend'.-(<>) :: Monoid m => m -> m -> m-(<>) = mappend-{-# INLINE (<>) #-}-#endif--newtype Many a = Many { unMany :: Seq a }- deriving (Data, Ord, Eq, Typeable, Foldable, Traversable, Functor, Show, Read)--#ifdef GENERICS-deriving instance Generic (Many a)-#endif--toList :: Many a -> [a]-toList = F.toList--singleton :: a -> Many a-singleton = Many . Seq.singleton--fromList :: [a] -> Many a-fromList = Many . Seq.fromList--isNull :: Many a -> Bool-isNull = Seq.null . unMany--type Inlines = Many Inline-type Blocks = Many Block--deriving instance Monoid Blocks--instance Monoid Inlines where- mempty = Many mempty- (Many xs) `mappend` (Many ys) =- case (viewr xs, viewl ys) of- (EmptyR, _) -> Many ys- (_, EmptyL) -> Many xs- (xs' :> x, y :< ys') -> Many (meld `mappend` ys')- where meld = case (x, y) of- (Space, Space) -> xs' |> Space- (Str t1, Str t2) -> xs' |> Str (t1 <> t2)- (Emph i1, Emph i2) -> xs' |> Emph (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- _ -> xs' |> x |> y--instance IsString Inlines where- fromString = text---- | Trim leading and trailing Sp (spaces) from an Inlines.-trimInlines :: Inlines -> Inlines-#if MIN_VERSION_containers(0,4,0)-trimInlines (Many ils) = Many $ Seq.dropWhileL (== Space) $- Seq.dropWhileR (== Space) $ 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 (== Space) $- Seq.reverse $ Seq.dropWhileL (== Space) $- Seq.reverse ils-#endif---- Document builders--doc :: Blocks -> Pandoc-doc = Pandoc (Meta [] [] []) . toList--setTitle :: Inlines -> Pandoc -> Pandoc-setTitle t (Pandoc m bs) = Pandoc m{ docTitle = toList t } bs--setAuthors :: [Inlines] -> Pandoc -> Pandoc-setAuthors as (Pandoc m bs) = Pandoc m{ docAuthors = map toList as } bs--setDate :: Inlines -> Pandoc -> Pandoc-setDate d (Pandoc m bs) = Pandoc m{ docDate = toList d } bs---- Inline list builders---- | Convert a 'String' to 'Inlines', treating interword spaces as 'Space's.--- If you want a 'Str' with literal spaces, use 'str'.-text :: String -> Inlines-text = fromList . map conv . breakBySpaces- where breakBySpaces = groupBy sameCategory- sameCategory x y = (is_space x && is_space y) ||- (not $ is_space x || is_space y)- conv xs | all is_space xs = Space- conv xs = Str xs- is_space ' ' = True- is_space '\n' = True- is_space '\t' = True- is_space _ = False--str :: String -> Inlines-str = singleton . Str--emph :: Inlines -> Inlines-emph = singleton . Emph . 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 -> String -> Inlines-codeWith attrs = singleton . Code attrs---- | Plain inline code.-code :: String -> Inlines-code = codeWith nullAttr--space :: Inlines-space = singleton Space--linebreak :: Inlines-linebreak = singleton LineBreak---- | Inline math-math :: String -> Inlines-math = singleton . Math InlineMath---- | Display math-displayMath :: String -> Inlines-displayMath = singleton . Math DisplayMath--rawInline :: Format -> String -> Inlines-rawInline format = singleton . RawInline format--link :: String -- ^ URL- -> String -- ^ Title- -> Inlines -- ^ Label- -> Inlines-link url title x = singleton $ Link (toList x) (url, title)--image :: String -- ^ URL- -> String -- ^ Title- -> Inlines -- ^ Alt text- -> Inlines-image url title x = singleton $ Image (toList x) (url, title)--note :: Blocks -> Inlines-note = singleton . Note . toList---- Block list builders--para :: Inlines -> Blocks-para = singleton . Para . toList--plain :: Inlines -> Blocks-plain = singleton . Plain . toList---- | A code block with attributes.-codeBlockWith :: Attr -> String -> Blocks-codeBlockWith attrs = singleton . CodeBlock attrs---- | A plain code block.-codeBlock :: String -> Blocks-codeBlock = codeBlockWith nullAttr--rawBlock :: Format -> String -> Blocks-rawBlock format = singleton . RawBlock 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--table :: Inlines -- ^ Caption- -> [(Alignment, Double)] -- ^ Column alignments and fractional widths- -> [Blocks] -- ^ Headers- -> [[Blocks]] -- ^ Rows- -> Blocks-table caption cellspecs headers rows = singleton $- Table (toList caption) aligns widths- (map toList headers) (map (map toList) rows)- where (aligns, widths) = unzip cellspecs---- | A simple table without a caption.-simpleTable :: [Blocks] -- ^ Headers- -> [[Blocks]] -- ^ Rows- -> Blocks-simpleTable headers = table mempty (mapConst defaults headers) headers- where defaults = (AlignDefault, 0)--mapConst :: Functor f => b -> f a -> f b-mapConst = fmap . const-
− Text/Pandoc/Definition.hs
@@ -1,161 +0,0 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-}--#ifdef GENERICS-{-# LANGUAGE DeriveGeneric #-}-#endif--{--Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>--This program is free software; you can redistribute it and/or modify-it under the terms of the GNU General Public License as published by-the Free Software Foundation; either version 2 of the License, or-(at your option) any later version.--This program is distributed in the hope that it will be useful,-but WITHOUT ANY WARRANTY; without even the implied warranty of-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-GNU General Public License for more details.--You should have received a copy of the GNU General Public License-along with this program; if not, write to the Free Software-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA--}--{- |- Module : Text.Pandoc.Definition- Copyright : Copyright (C) 2006-2010 John MacFarlane- License : GNU GPL, version 2 or above-- Maintainer : John MacFarlane <jgm@berkeley.edu>- Stability : alpha- Portability : portable--Definition of 'Pandoc' data structure for format-neutral representation-of documents.--}-module Text.Pandoc.Definition where--import Data.Generics (Data, Typeable)-import Data.Ord (comparing)--#ifdef GENERICS-import GHC.Generics (Generic)-#define GENERIC , Generic-#else-#define GENERIC-#endif--data Pandoc = Pandoc Meta [Block] deriving (Eq, Ord, Read, Show, Typeable, Data GENERIC)---- | Bibliographic information for the document: title, authors, date.-data Meta = Meta { docTitle :: [Inline]- , docAuthors :: [[Inline]]- , docDate :: [Inline] }- deriving (Eq, Ord, Show, Read, Typeable, Data GENERIC)---- | Alignment of a table column.-data Alignment = AlignLeft- | AlignRight- | AlignCenter- | AlignDefault deriving (Eq, Ord, Show, Read, Typeable, Data GENERIC)---- | List attributes.-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 = (String, [String], [(String, String)])--nullAttr :: Attr-nullAttr = ("",[],[])---- | Table cells are list of Blocks-type TableCell = [Block]---- | Formats for raw blocks-type Format = String---- | Block element.-data Block- = Plain [Inline] -- ^ Plain text, not a paragraph- | Para [Inline] -- ^ Paragraph- | CodeBlock Attr String -- ^ Code block (literal) with attributes- | RawBlock Format String -- ^ Raw block- | BlockQuote [Block] -- ^ Block quote (list of blocks)- | OrderedList ListAttributes [[Block]] -- ^ Ordered list (attributes- -- and a list of items, each a list of blocks)- | BulletList [[Block]] -- ^ Bullet list (list of items, each- -- a list of blocks)- | DefinitionList [([Inline],[[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)- | Header Int Attr [Inline] -- ^ Header - level (integer) and text (inlines)- | HorizontalRule -- ^ Horizontal rule- | Table [Inline] [Alignment] [Double] [TableCell] [[TableCell]] -- ^ Table,- -- with caption, column alignments,- -- relative column widths (0 = default),- -- column headers (each a list of blocks), and- -- rows (each a list of lists of blocks)- | Null -- ^ Nothing- 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 = (String, String)---- | Type of math element (display or inline).-data MathType = DisplayMath | InlineMath deriving (Show, Eq, Ord, Read, Typeable, Data GENERIC)---- | Inline elements.-data Inline- = Str String -- ^ Text (string)- | Emph [Inline] -- ^ Emphasized 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 String -- ^ Inline code (literal)- | Space -- ^ Inter-word space- | LineBreak -- ^ Hard line break- | Math MathType String -- ^ TeX math (literal)- | RawInline Format String -- ^ Raw inline- | Link [Inline] Target -- ^ Hyperlink: text (list of inlines), target- | Image [Inline] Target -- ^ Image: alt text (list of inlines), target- | Note [Block] -- ^ Footnote or endnote- deriving (Show, Eq, Ord, Read, Typeable, Data GENERIC)--data Citation = Citation { citationId :: String- , 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)
− Text/Pandoc/Generic.hs
@@ -1,135 +0,0 @@-{--Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>--This program is free software; you can redistribute it and/or modify-it under the terms of the GNU General Public License as published by-the Free Software Foundation; either version 2 of the License, or-(at your option) any later version.--This program is distributed in the hope that it will be useful,-but WITHOUT ANY WARRANTY; without even the implied warranty of-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the-GNU General Public License for more details.--You should have received a copy of the GNU General Public License-along with this program; if not, write to the Free Software-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA--}--{- |- Module : Text.Pandoc.Generic- Copyright : Copyright (C) 2006-2010 John MacFarlane- License : GNU GPL, version 2 or above-- Maintainer : John MacFarlane <jgm@berkeley.edu>- Stability : alpha- Portability : portable--Generic functions for manipulating 'Pandoc' documents.--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 (Meta {docTitle = [], docAuthors = [], docDate = []})-> [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 (Meta {docTitle = [], docAuthors = [], docDate = []})-> [Para [Str "Hi",Space,Emph [Str "world",Space,Str "emphasized"]]]->-> bottomUp normal myDoc ==-> Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []})-> [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-import Data.Monoid---- | 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)--{-# DEPRECATED processWith "Use bottomUp instead" #-}--- | Deprecated synonym for @bottomUp@.-processWith :: (Data a, Data b) => (a -> a) -> b -> b-processWith = bottomUp--{-# DEPRECATED processWithM "Use bottomUpM instead" #-}--- | Deprecated synonym for @bottomUpM@.-processWithM :: (Monad m, Data a, Data b) => (a -> m a) -> b -> m b-processWithM = bottomUpM-
+ benchmark/bench.hs view
@@ -0,0 +1,39 @@+{-# 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")+ ]
+ changelog view
@@ -0,0 +1,403 @@+[1.23.1.2]++ * Bump upper bound for QuickCheck.++ * Remove obsolete semigroups clause for ghc < 8.++ * Allow aeson 2.3 (Francesco Gazzetta).++ * CI: remove ghc 8.10 from testing++ * Use lts-26 in stack.yaml.++ * Set minimum base version 4.15.++[1.23.1.1]++ * Remove unused `ghc-prim` dependency (konsumlam).++ * Bump bound for QuickCheck.++ * Allow deepseq-1.5 (Bodigrim).++ * Fix 'patter' typo in SimpleFigure haddock (Owen Shepherd).++[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.cabal view
@@ -1,11 +1,12 @@+cabal-version: 2.2 Name: pandoc-types-Version: 1.10+version: 1.23.1.2 Synopsis: Types for representing a structured document-Description: This package contains definitions for the 'Pandoc' data+Description: @Text.Pandoc.Definition@ defines the 'Pandoc' data structure, which is used by pandoc to represent- structured documents. These definitions used to live- in the pandoc package, but starting with pandoc 1.7, they- have been split off, so that other packages can use them+ 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.@@ -15,29 +16,77 @@ . @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: http://johnmacfarlane.net/pandoc-License: GPL-License-file: COPYING+Homepage: https://pandoc.org/+License: BSD-3-Clause+License-file: LICENSE Author: John MacFarlane Maintainer: jgm@berkeley.edu-Bug-Reports: http://code.google.com/p/pandoc/issues/list-Copyright: (c) 2006-2010 John MacFarlane+Bug-Reports: https://github.com/jgm/pandoc-types/issues+Copyright: (c) 2006-2023 John MacFarlane Category: Text Build-type: Simple-Cabal-version: >=1.6+Extra-doc-files: changelog Source-repository head type: git- location: git://github.com/jgm/pandoc-types.git+ location: https://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- if impl(ghc >= 6.10)- Build-depends: base >= 4 && < 5, syb, containers >= 0.3- else- Build-depends: base >= 3 && < 4, containers >= 0.3+ Text.Pandoc.JSON+ Text.Pandoc.Arbitrary+ Other-modules: Paths_pandoc_types+ Autogen-modules: Paths_pandoc_types+ Build-depends: base >= 4.15 && < 5,+ containers >= 0.3,+ text,+ deepseq >= 1.4.1 && < 1.6,+ syb >= 0.1 && < 0.8,+ bytestring >= 0.9 && < 0.13,+ aeson >= 0.6.2 && < 2.4,+ transformers >= 0.2 && < 0.7,+ QuickCheck >= 2.10 && < 2.19+ ghc-options: -Wall+ default-language: Haskell2010 - if impl(ghc >= 7.2.1)- cpp-options: -DGENERICS- build-depends: ghc-prim >= 0.2+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.4,+ 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.19,+ 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.15 && < 5,+ text,+ criterion >= 1.0+ ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -O2+ default-language: Haskell2010
+ src/Text/Pandoc/Arbitrary.hs view
@@ -0,0 +1,405 @@+{-# 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.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") "<a id=\"eek\">"+ , 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")+ "<div>\n*&*\n</div>"+ , 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"
+ src/Text/Pandoc/Builder.hs view
@@ -0,0 +1,756 @@+{-# 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 <jgm@berkeley.edu>+ 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 qualified Data.Foldable as F+import Data.Data+import Control.Arrow ((***))+import GHC.Generics (Generic)++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
+ src/Text/Pandoc/Definition.hs view
@@ -0,0 +1,475 @@+{-# 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 <jgm@berkeley.edu>+ 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 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 pattern 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
+ src/Text/Pandoc/Generic.hs view
@@ -0,0 +1,141 @@+{-# 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 <jgm@berkeley.edu>+ 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)
+ src/Text/Pandoc/JSON.hs view
@@ -0,0 +1,133 @@+{-# 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 <jgm@berkeley.edu>+ 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
+ src/Text/Pandoc/Walk.hs view
@@ -0,0 +1,664 @@+{-# 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 <jgm@berkeley.edu>+ 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.Monad ((>=>))+import Data.Functor.Identity (Identity (runIdentity))+import qualified Data.Map as M+import Text.Pandoc.Definition+import qualified Data.Traversable as T+import qualified Data.Foldable as F++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
+ test/Data/String/QQ.hs view
@@ -0,0 +1,19 @@+-- | 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
+ test/test-pandoc-types.hs view
@@ -0,0 +1,791 @@+{-# 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+