pandoc-types-1.17.5.4/0000755000000000000000000000000013363652215012551 5ustar0000000000000000pandoc-types-1.17.5.4/Setup.hs0000644000000000000000000000005613363652215014206 0ustar0000000000000000import Distribution.Simple main = defaultMain pandoc-types-1.17.5.4/LICENSE0000644000000000000000000000277513363652215013571 0ustar0000000000000000Copyright (c) 2006-2016, John MacFarlane All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of John MacFarlane nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. pandoc-types-1.17.5.4/changelog0000644000000000000000000001260713363652215014431 0ustar0000000000000000[1.17.5.4] * Put NFData in scope for ghc < 7.10. * Reduce deepseq lower bound for ghc < 7.10. [1.17.5.3] * For ghc < 7.10, constrain deepseq-generics to >= 0.2, which no longer exprots NFData from deepseq. Add deepseq dependency. [1.17.5.2] * Bump upper bound for deepseq-generics, QuickCheck, criterion. * Implement QuickCheck shrinking for Inlines and Blocks (Alexander Krotov). [1.17.5.1] * Declare the ToMetaValue instance for String as OVERLAPPING (#46). [1.17.5] * Bump upper bounds for aeson, base. * Allow building on older ghc versions (George Wilson). * Text.Pandoc.Arbitrary: generate SoftBreaks and LineBreaks (Alexander Krotov). * Pad table rows up to maximum row length, to guarantee that all rows have the same number of columns (see jgm/pandoc#4059, Francesco Occhipinti). * Make String an instance of ToMetaValue (Alexander Krotov). [1.17.4.2] * Fix compiler warnings. [1.17.4.1] * Import Semigroups when needed rather than using CPP. * Bump criterion upper bound. [1.17.4] * Add Semigroup instances for Pandoc, Meta, Inlines, Blocks (if base >= 4.9). This is needed for the library to compile with ghc 8.4. * Bumped criterion upper bound. [1.17.3.1] * Bumped upper bounds for criterion and QuickCheck. [1.17.3] * Added Walkable instances for `[Inline] Inline` and `[Block] Block`. [1.17.2] * Provide default implementation for walk (Albert Krewinkel). The implementations for `walk` and `walkM` are very similar, so a default method is provided which implements the former in terms of the latter. This change should not affect performance, as the `Identity` functor, which is used in the default definition, is a newtype that should be eliminated at compile time. (This requires a dependency on transformers for ghc 7.8.x.) * Force optimizations when compiling Walk module (Albert Krewinkel). * Add `Applicative m` to the context of walkM (Albert Krewinkel). The acceptance of AMP makes this a natural change. * Add `Walkable [Block]` and `Walkable [Inline]` instances (Albert Krewinkel). * Factored out duplicate code in Walk. * Added benchmark. * Text.Pandoc.JSON: Use `walk` instead of `bottomUp` in the `ToJSONFilter` instance for `a -> [a]`. Note that behavior will be slightly different, since bottomUp's treatment of a function `[a] -> [a]` is to apply it to each sublist of a list, while walk applies it only to maximal sublists. Usually the latter behavior is what is wanted, and the former can be simulated when needed. But there may be existing filters that need to be rewritten in light of the new behavior. [1.17.1] * Better consistency in simpleTable and table (jgm/pandoc#3648). If `headers` is empty, we populate it with empty cells, using the rows to determine number of columns. We also ensure that there are numcols alignments and column widths. * Make sure Div and Span occur in Arbitrary instances. * Bump dependency upper bounds. * Removed unused mapConst. [1.17.0.5] * Allow aeson 1.1. * Added tests for Walk (originally from pandoc). * Renamed README -> README.md, fix link (Kolen Cheung). [1.17.0.4] * Re-add Functor constraint to walkM, needed for ghc 7.8. * Turn off redundant-constraints warning for Walk (for ghc 8.0.1+). * Added necessary Data.Traversable import. * Allow HUnit 1.5. [1.17.0.3] * More ghc 7.8 compatibility imports. [1.17.0.2] * Added a necessary import from Data.Monoid (for ghc 7.8). [1.17.0.1] * Fix compiler warnings around Data.Monoid import on some platforms. [1.17] * Remimplement json encoding of inlines manually (Jesse Rosenthal). This is the first step to doing manual encoding and decoding of pandoc JSON. This will replace the current generic deriving, which can be a moving target. * Move Arbitrary instances for types from pandoc (Jesse Rosenthal). * Remove empty arrays for leaf elements (Jesse Rosenthal). Elements with no children (Space, SoftBreak, LineBreak, HorizontalRule, Null) previously had an empty array for their "c" value. We remove that here. This is a breaking change for the JSON format. * New toplevel JSON format with api-version (Jesse Rosenthal). The version number is the pandoc-types version. The toplevel format was previously: [{"unMeta": META}, [BLOCKS]] It is now: { "pandoc-api-version" : [MAJ, MIN, REV], "meta" : META, "blocks": BLOCKS } Decoding fails if the major and minor version numbers don't match. * Add simple quickcheck tests to verify that roundtrip works properly (Jesse Rosenthal). * Add a LineBlock block element (Albert Krewinkel). * Add explicit unit tests for encoding and decoding (Jesse Rosenthal). * Fixed warnings in Walk, Builder. * Test with travis and appveyor. [1.16.1.1] * Allow aeson 1.0.*. [1.16.1] * Allow aeson 0.11.*. * Export pandocTypesVersion from Text.Pandoc.Definition. [1.16.0.1] * Use deepseq instead of deepseq-generics. deepseq now allows deriving generic NFData instances, so we don't need deepseq-generics. * Removed unneeded instance, use OVERLAPPING pragma for ghc 7.10. * Added CPP so that deepseq-generics is used for ghc < 7.10. * Added tested-with, generate .travis.yml using make_travis_yml.hs * Added stack.yaml [1.16] * Added Attr field to Image and Link. * Added SoftBreak constructor to Inline pandoc-types-1.17.5.4/pandoc-types.cabal0000644000000000000000000000750213363652215016147 0ustar0000000000000000Name: pandoc-types Version: 1.17.5.4 Synopsis: Types for representing a structured document Description: @Text.Pandoc.Definition@ defines the 'Pandoc' data structure, which is used by pandoc to represent structured documents. This module used to live in the pandoc package, but starting with pandoc 1.7, it has been split off, so that other packages can use it without drawing in all of pandoc's dependencies, and pandoc itself can depend on packages (like citeproc-hs) that use them. . @Text.Pandoc.Builder@ provides functions for building up @Pandoc@ structures programmatically. . @Text.Pandoc.Generic@ provides generic functions for manipulating Pandoc documents. . @Text.Pandoc.Walk@ provides faster, nongeneric functions for manipulating Pandoc documents. . @Text.Pandoc.JSON@ provides functions for serializing and deserializing a @Pandoc@ structure to and from JSON. Homepage: http://johnmacfarlane.net/pandoc License: BSD3 License-file: LICENSE Author: John MacFarlane Maintainer: jgm@berkeley.edu Bug-Reports: https://github.com/jgm/pandoc-types/issues Copyright: (c) 2006-2017 John MacFarlane Category: Text Build-type: Simple Cabal-version: >=1.8 Tested-With: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 Extra-Source-Files: changelog Source-repository head type: git location: git://github.com/jgm/pandoc-types.git Library Exposed-modules: Text.Pandoc.Definition Text.Pandoc.Generic Text.Pandoc.Walk Text.Pandoc.Builder Text.Pandoc.JSON Text.Pandoc.Arbitrary Other-modules: Paths_pandoc_types Build-depends: base >= 4.5 && < 5, containers >= 0.3, syb >= 0.1 && < 0.8, ghc-prim >= 0.2, bytestring >= 0.9 && < 0.11, aeson >= 0.6.2 && < 1.5, transformers >= 0.2 && < 0.6, QuickCheck >= 2.4 && < 2.13 if !impl(ghc >= 8.0) Build-depends: semigroups == 0.18.* if impl(ghc < 7.10) Build-depends: deepseq-generics >= 0.2 && < 0.3, deepseq >= 1.3 && < 1.5 else Build-depends: deepseq >= 1.4.1 && < 1.5 ghc-options: -Wall test-suite test-pandoc-types type: exitcode-stdio-1.0 hs-source-dirs: test main-is: test-pandoc-types.hs build-depends: base, pandoc-types, syb, aeson >= 0.6.2 && < 1.5, containers >= 0.3, bytestring >= 0.9 && < 0.11, test-framework >= 0.3 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, test-framework-quickcheck2 >= 0.2.9 && < 0.4, QuickCheck >= 2.4 && < 2.13, HUnit >= 1.2 && < 1.7, string-qq == 0.0.2 ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall -O2 benchmark benchmark-pandoc-types type: exitcode-stdio-1.0 main-is: bench.hs hs-source-dirs: benchmark build-depends: pandoc-types, base >= 4.5 && < 5, criterion >= 1.0 && < 1.6 ghc-options: -rtsopts -Wall -fno-warn-unused-do-bind -O2 pandoc-types-1.17.5.4/benchmark/0000755000000000000000000000000013363652215014503 5ustar0000000000000000pandoc-types-1.17.5.4/benchmark/bench.hs0000644000000000000000000000237613363652215016126 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Criterion.Main (bench, defaultMain, nf) import Text.Pandoc.Definition (Pandoc, Inline (Str)) import Text.Pandoc.Walk (walk) import Text.Pandoc.Builder main :: IO () main = do defaultMain [ bench "simple walk" $ nf (walk prependZeroWidthSpace) mydoc , bench "walk concatMap" $ nf (walk $ concatMap prependZeroWidthSpace') mydoc , bench "walk lists" $ nf (walk prependZeroWidthSpace'') mydoc ] prependZeroWidthSpace :: Inline -> Inline prependZeroWidthSpace (Str s) = Str ('\8203' : s) prependZeroWidthSpace x = x prependZeroWidthSpace' :: Inline -> [Inline] prependZeroWidthSpace' (Str s) = [Str ('\8203' : s)] prependZeroWidthSpace' x = [x] prependZeroWidthSpace'' :: [Inline] -> [Inline] prependZeroWidthSpace'' (Str s : xs) = (Str ('\8203' : s) : prependZeroWidthSpace'' xs) prependZeroWidthSpace'' (x : xs) = x : prependZeroWidthSpace'' xs prependZeroWidthSpace'' [] = [] mydoc :: Pandoc mydoc = setTitle "My title" $ doc $ mconcat $ replicate 50 $ para "This is the first paragraph" <> para ("And " <> emph "another" <> ".") <> bulletList [ para "item one" <> para "continuation" , plain ("item two and a " <> link "/url" "go to url" "link") ] pandoc-types-1.17.5.4/test/0000755000000000000000000000000013363652215013530 5ustar0000000000000000pandoc-types-1.17.5.4/test/test-pandoc-types.hs0000644000000000000000000004403513363652215017455 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, QuasiQuotes, FlexibleContexts, CPP #-} import Text.Pandoc.Arbitrary () import Text.Pandoc.Definition import Text.Pandoc.Walk import Text.Pandoc.Builder (singleton, plain, text, simpleTable) import Data.Generics import Data.List (tails) import Test.HUnit (Assertion, assertEqual, assertFailure) import Data.Char (toUpper) import Data.Aeson (FromJSON, ToJSON, encode, decode) import Test.Framework import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.HUnit (testCase) import qualified Data.Map as M import Data.String.QQ import Data.ByteString.Lazy (ByteString) #if MIN_VERSION_base(4,8,0) #else import Data.Monoid #endif import qualified Data.Monoid as Monoid p_walk :: (Typeable a, Walkable a Pandoc) => (a -> a) -> Pandoc -> Bool p_walk f d = everywhere (mkT f) d == walk f d p_walkList :: (Typeable a, Walkable [a] Pandoc) => ([a] -> [a]) -> Pandoc -> Bool p_walkList f d = everywhere (mkT f) d == walk (foldr g []) d where g x ys = f (x:ys) p_query :: (Eq a, Typeable a1, Monoid a, Walkable a1 Pandoc) => (a1 -> a) -> Pandoc -> Bool p_query f d = everything mappend (mempty `mkQ` f) d == query f d p_queryList :: (Eq a, Typeable a1, Monoid a, Walkable [a1] Pandoc) => ([a1] -> a) -> Pandoc -> Bool p_queryList f d = everything mappend (mempty `mkQ` f) d == query (mconcat . map f . tails) d inlineTrans :: Inline -> Inline inlineTrans (Str xs) = Str $ map toUpper xs inlineTrans (Emph xs) = Strong xs inlineTrans x = x inlinesTrans :: [Inline] -> [Inline] inlinesTrans ys | all whitespaceInline ys = [] where whitespaceInline Space = True whitespaceInline LineBreak = True whitespaceInline SoftBreak = True whitespaceInline (Str "") = True whitespaceInline _ = False inlinesTrans ys = ys blockTrans :: Block -> Block blockTrans (Plain xs) = Para xs blockTrans (BlockQuote xs) = Div ("",["special"],[]) xs blockTrans x = x blocksTrans :: [Block] -> [Block] blocksTrans [CodeBlock {}] = [] blocksTrans [BlockQuote xs] = xs blocksTrans [Div _ xs] = xs blocksTrans xs = xs inlineQuery :: Inline -> String inlineQuery (Str xs) = xs inlineQuery _ = "" inlinesQuery :: [Inline] -> Monoid.Sum Int inlinesQuery = Monoid.Sum . length blockQuery :: Block -> [Int] blockQuery (Header lev _ _) = [lev] blockQuery _ = [] blocksQuery :: [Block] -> Monoid.Sum Int blocksQuery = Monoid.Sum . length prop_roundtrip :: Pandoc -> Bool prop_roundtrip doc = case decode $ encode doc :: (Maybe Pandoc) of Just doc' -> doc == doc' _ -> False testEncode :: ToJSON a => (a, ByteString) -> Assertion testEncode (doc, j) = assertEqual "Encoding error" (encode doc) j testDecode' :: FromJSON a => (a, ByteString) -> Maybe a testDecode' (_, j) = decode j testDecode :: (Show a, Eq a, FromJSON a) => (a, ByteString) -> Assertion testDecode (doc, j) = case testDecode' (doc, j) of Just doc' -> assertEqual "Decoding error" doc' doc Nothing -> assertFailure "Decoding error" testEncodeDecode :: (Show a, Eq a, ToJSON a, FromJSON a) => String -> (a, ByteString) -> Test testEncodeDecode msg pair = testGroup msg [ testCase "Encoding" $ testEncode pair , testCase "Decoding" $ testDecode pair ] t_metamap :: (MetaValue, ByteString) t_metamap = ( MetaMap $ M.fromList [("foo", MetaBool True)] , [s|{"t":"MetaMap","c":{"foo":{"t":"MetaBool","c":true}}}|] ) t_metalist :: (MetaValue, ByteString) t_metalist = ( MetaList [MetaBool True, MetaString "baz"] , [s|{"t":"MetaList","c":[{"t":"MetaBool","c":true},{"t":"MetaString","c":"baz"}]}|] ) t_metabool :: (MetaValue, ByteString) t_metabool = ( MetaBool False, [s|{"t":"MetaBool","c":false}|] ) t_metastring :: (MetaValue, ByteString) t_metastring = ( MetaString "Hello", [s|{"t":"MetaString","c":"Hello"}|] ) t_metainlines :: (MetaValue, ByteString) t_metainlines = ( MetaInlines [Space, SoftBreak] , [s|{"t":"MetaInlines","c":[{"t":"Space"},{"t":"SoftBreak"}]}|] ) t_metablocks :: (MetaValue, ByteString) t_metablocks = ( MetaBlocks [Null,Null], [s|{"t":"MetaBlocks","c":[{"t":"Null"},{"t":"Null"}]}|]) t_singlequote :: (QuoteType, ByteString) t_singlequote = (SingleQuote, [s|{"t":"SingleQuote"}|]) t_doublequote :: (QuoteType, ByteString) t_doublequote = (DoubleQuote, [s|{"t":"DoubleQuote"}|]) t_authorintext :: (CitationMode, ByteString) t_authorintext = (AuthorInText, [s|{"t":"AuthorInText"}|]) t_suppressauthor :: (CitationMode, ByteString) t_suppressauthor = (SuppressAuthor, [s|{"t":"SuppressAuthor"}|]) t_normalcitation :: (CitationMode, ByteString) t_normalcitation = (NormalCitation, [s|{"t":"NormalCitation"}|]) t_citation :: (Citation, ByteString) t_citation = ( Citation { citationId = "jameson:unconscious", citationPrefix = [Str "cf"], citationSuffix = [Space,Str "123"], citationMode = NormalCitation, citationNoteNum = 0, citationHash = 0} , [s|{"citationSuffix":[{"t":"Space"},{"t":"Str","c":"123"}],"citationNoteNum":0,"citationMode":{"t":"NormalCitation"},"citationPrefix":[{"t":"Str","c":"cf"}],"citationId":"jameson:unconscious","citationHash":0}|] ) t_displaymath :: (MathType, ByteString) t_displaymath = ( DisplayMath, [s|{"t":"DisplayMath"}|]) t_inlinemath :: (MathType, ByteString) t_inlinemath = ( InlineMath, [s|{"t":"InlineMath"}|]) t_str :: (Inline, ByteString) t_str = ( Str "Hello" , [s|{"t":"Str","c":"Hello"}|] ) t_emph :: (Inline, ByteString) t_emph = ( Emph [Str "Hello"] , [s|{"t":"Emph","c":[{"t":"Str","c":"Hello"}]}|] ) t_strong :: (Inline, ByteString) t_strong = ( Strong [Str "Hello"] , [s|{"t":"Strong","c":[{"t":"Str","c":"Hello"}]}|] ) t_strikeout :: (Inline, ByteString) t_strikeout = ( Strikeout [Str "Hello"] , [s|{"t":"Strikeout","c":[{"t":"Str","c":"Hello"}]}|] ) t_superscript :: (Inline, ByteString) t_superscript = ( Superscript [Str "Hello"] , [s|{"t":"Superscript","c":[{"t":"Str","c":"Hello"}]}|] ) t_subscript :: (Inline, ByteString) t_subscript = ( Subscript [Str "Hello"] , [s|{"t":"Subscript","c":[{"t":"Str","c":"Hello"}]}|] ) t_smallcaps :: (Inline, ByteString) t_smallcaps = ( SmallCaps [Str "Hello"] , [s|{"t":"SmallCaps","c":[{"t":"Str","c":"Hello"}]}|] ) t_quoted :: (Inline, ByteString) t_quoted = ( Quoted SingleQuote [Str "Hello"] , [s|{"t":"Quoted","c":[{"t":"SingleQuote"},[{"t":"Str","c":"Hello"}]]}|] ) t_cite :: (Inline, ByteString) t_cite = ( Cite [Citation { citationId = "jameson:unconscious" , citationPrefix = [Str "cf"] , citationSuffix = [Space,Str "12"] , citationMode = NormalCitation , citationNoteNum = 0 , citationHash = 0}] [ Str "[cf" , Space , Str "@jameson:unconscious" , Space , Str "12]"] ,[s|{"t":"Cite","c":[[{"citationSuffix":[{"t":"Space"},{"t":"Str","c":"12"}],"citationNoteNum":0,"citationMode":{"t":"NormalCitation"},"citationPrefix":[{"t":"Str","c":"cf"}],"citationId":"jameson:unconscious","citationHash":0}],[{"t":"Str","c":"[cf"},{"t":"Space"},{"t":"Str","c":"@jameson:unconscious"},{"t":"Space"},{"t":"Str","c":"12]"}]]}|] ) t_code :: (Inline, ByteString) t_code = ( Code ("", [], [("language", "haskell")]) "foo bar" , [s|{"t":"Code","c":[["",[],[["language","haskell"]]],"foo bar"]}|] ) t_space :: (Inline, ByteString) t_space = ( Space, [s|{"t":"Space"}|] ) t_softbreak :: (Inline, ByteString) t_softbreak = ( SoftBreak, [s|{"t":"SoftBreak"}|] ) t_linebreak :: (Inline, ByteString) t_linebreak = ( LineBreak, [s|{"t":"LineBreak"}|] ) t_rawinline :: (Inline, ByteString) t_rawinline = ( RawInline (Format "tex") "\\foo{bar}" , [s|{"t":"RawInline","c":["tex","\\foo{bar}"]}|] ) t_link :: (Inline, ByteString) t_link = ( Link ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) [ Str "a", Space, Str "famous", Space, Str "site"] ("https://www.google.com","google") , [s|{"t":"Link","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Str","c":"a"},{"t":"Space"},{"t":"Str","c":"famous"},{"t":"Space"},{"t":"Str","c":"site"}],["https://www.google.com","google"]]}|] ) t_image :: (Inline, ByteString) t_image = ( Image ("id",["kls"],[("k1", "v1"), ("k2", "v2")]) [ Str "a", Space, Str "famous", Space, Str "image"] ("my_img.png","image") , [s|{"t":"Image","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Str","c":"a"},{"t":"Space"},{"t":"Str","c":"famous"},{"t":"Space"},{"t":"Str","c":"image"}],["my_img.png","image"]]}|] ) t_note :: (Inline, ByteString) t_note = ( Note [Para [Str "Hello"]] , [s|{"t":"Note","c":[{"t":"Para","c":[{"t":"Str","c":"Hello"}]}]}|] ) t_span :: (Inline, ByteString) t_span = ( Span ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) [Str "Hello"] , [s|{"t":"Span","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Str","c":"Hello"}]]}|] ) t_plain :: (Block, ByteString) t_plain = ( Plain [Str "Hello"] , [s|{"t":"Plain","c":[{"t":"Str","c":"Hello"}]}|] ) t_para :: (Block, ByteString) t_para = ( Para [Str "Hello"] , [s|{"t":"Para","c":[{"t":"Str","c":"Hello"}]}|] ) t_lineblock :: (Block, ByteString) t_lineblock = ( LineBlock [[Str "Hello"], [Str "Moin"]] , [s|{"t":"LineBlock","c":[[{"t":"Str","c":"Hello"}],[{"t":"Str","c":"Moin"}]]}|] ) t_codeblock :: (Block, ByteString) t_codeblock = ( CodeBlock ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) "Foo Bar" , [s|{"t":"CodeBlock","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],"Foo Bar"]}|] ) t_rawblock :: (Block, ByteString) t_rawblock = ( RawBlock (Format "tex") "\\foo{bar}" , [s|{"t":"RawBlock","c":["tex","\\foo{bar}"]}|] ) t_blockquote :: (Block, ByteString) t_blockquote = ( BlockQuote [Para [Str "Hello"]] , [s|{"t":"BlockQuote","c":[{"t":"Para","c":[{"t":"Str","c":"Hello"}]}]}|] ) t_orderedlist :: (Block, ByteString) t_orderedlist = (OrderedList (1,Decimal,Period) [[Para [Str "foo"]] ,[Para [Str "bar"]]] , [s|{"t":"OrderedList","c":[[1,{"t":"Decimal"},{"t":"Period"}],[[{"t":"Para","c":[{"t":"Str","c":"foo"}]}],[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]]}|] ) t_bulletlist :: (Block, ByteString) t_bulletlist = (BulletList [[Para [Str "foo"]] ,[Para [Str "bar"]]] , [s|{"t":"BulletList","c":[[{"t":"Para","c":[{"t":"Str","c":"foo"}]}],[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]}|] ) t_definitionlist :: (Block, ByteString) t_definitionlist = (DefinitionList [([Str "foo"], [[Para [Str "bar"]]]) ,([Str "fizz"], [[Para [Str "pop"]]])] , [s|{"t":"DefinitionList","c":[[[{"t":"Str","c":"foo"}],[[{"t":"Para","c":[{"t":"Str","c":"bar"}]}]]],[[{"t":"Str","c":"fizz"}],[[{"t":"Para","c":[{"t":"Str","c":"pop"}]}]]]]}|] ) t_header :: (Block, ByteString) t_header = ( Header 2 ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) [Str "Head"] , [s|{"t":"Header","c":[2,["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Str","c":"Head"}]]}|] ) t_table :: (Block, ByteString) t_table = ( Table [Str "Demonstration" ,Space ,Str "of" ,Space ,Str "simple" ,Space ,Str "table" ,Space ,Str "syntax."] [AlignRight ,AlignLeft ,AlignCenter ,AlignDefault] [0.0,0.0,0.0,0.0] [[Plain [Str "Right"]] ,[Plain [Str "Left"]] ,[Plain [Str "Center"]] ,[Plain [Str "Default"]]] [[[Plain [Str "12"]] ,[Plain [Str "12"]] ,[Plain [Str "12"]] ,[Plain [Str "12"]]] ,[[Plain [Str "123"]] ,[Plain [Str "123"]] ,[Plain [Str "123"]] ,[Plain [Str "123"]]] ,[[Plain [Str "1"]] ,[Plain [Str "1"]] ,[Plain [Str "1"]] ,[Plain [Str "1"]]]] , [s|{"t":"Table","c":[[{"t":"Str","c":"Demonstration"},{"t":"Space"},{"t":"Str","c":"of"},{"t":"Space"},{"t":"Str","c":"simple"},{"t":"Space"},{"t":"Str","c":"table"},{"t":"Space"},{"t":"Str","c":"syntax."}],[{"t":"AlignRight"},{"t":"AlignLeft"},{"t":"AlignCenter"},{"t":"AlignDefault"}],[0,0,0,0],[[{"t":"Plain","c":[{"t":"Str","c":"Right"}]}],[{"t":"Plain","c":[{"t":"Str","c":"Left"}]}],[{"t":"Plain","c":[{"t":"Str","c":"Center"}]}],[{"t":"Plain","c":[{"t":"Str","c":"Default"}]}]],[[[{"t":"Plain","c":[{"t":"Str","c":"12"}]}],[{"t":"Plain","c":[{"t":"Str","c":"12"}]}],[{"t":"Plain","c":[{"t":"Str","c":"12"}]}],[{"t":"Plain","c":[{"t":"Str","c":"12"}]}]],[[{"t":"Plain","c":[{"t":"Str","c":"123"}]}],[{"t":"Plain","c":[{"t":"Str","c":"123"}]}],[{"t":"Plain","c":[{"t":"Str","c":"123"}]}],[{"t":"Plain","c":[{"t":"Str","c":"123"}]}]],[[{"t":"Plain","c":[{"t":"Str","c":"1"}]}],[{"t":"Plain","c":[{"t":"Str","c":"1"}]}],[{"t":"Plain","c":[{"t":"Str","c":"1"}]}],[{"t":"Plain","c":[{"t":"Str","c":"1"}]}]]]]}|] ) t_div :: (Block, ByteString) t_div = ( Div ("id", ["kls"], [("k1", "v1"), ("k2", "v2")]) [Para [Str "Hello"]] , [s|{"t":"Div","c":[["id",["kls"],[["k1","v1"],["k2","v2"]]],[{"t":"Para","c":[{"t":"Str","c":"Hello"}]}]]}|] ) t_null :: (Block, ByteString) t_null = (Null, [s|{"t":"Null"}|]) -- headers and rows are padded to a consistent number of -- cells in order to avoid syntax errors after conversion, see -- jgm/pandoc#4059. 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] ,[]] expected = singleton (Table [] [AlignDefault, AlignDefault] [0.0, 0.0] [[Plain [Str "foo"]], [Plain [Str "bar"]]] [[[], []], [[], []]]) tests :: [Test] tests = [ testGroup "Walk" [ testProperty "p_walk inlineTrans" (p_walk inlineTrans) , testProperty "p_walk blockTrans" (p_walk blockTrans) , testProperty "p_query inlineQuery" (p_query inlineQuery) , testProperty "p_query blockQuery" (p_query blockQuery) , 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 "MetaMap" t_metamap , testEncodeDecode "MetaList" t_metalist , testEncodeDecode "MetaBool" t_metabool , testEncodeDecode "MetaString" t_metastring , testEncodeDecode "MetaInlines" t_metainlines , testEncodeDecode "MetaBlocks" t_metablocks ] , testGroup "QuoteType" [ testEncodeDecode "SingleQuote" t_singlequote , testEncodeDecode "DoubleQuote" t_doublequote ] , testGroup "CitationType" [ testEncodeDecode "AuthorInText" t_authorintext , testEncodeDecode "SuppressAuthor" t_suppressauthor , testEncodeDecode "NormalCitation" t_normalcitation ] , testEncodeDecode "Citation" t_citation , testGroup "MathType" [ testEncodeDecode "DisplayMath" t_displaymath , testEncodeDecode "InlineMath" t_inlinemath ] , testGroup "Inline" [ testEncodeDecode "Str" t_str , testEncodeDecode "Emph" t_emph , testEncodeDecode "Strong" t_strong , testEncodeDecode "Strikeout" t_strikeout , testEncodeDecode "Superscript" t_superscript , testEncodeDecode "Subscript" t_subscript , testEncodeDecode "SmallCaps" t_smallcaps , testEncodeDecode "Quoted" t_quoted , testEncodeDecode "Cite" t_cite , testEncodeDecode "Code" t_code , testEncodeDecode "Space" t_space , testEncodeDecode "SoftBreak" t_softbreak , testEncodeDecode "LineBreak" t_linebreak , testEncodeDecode "RawInline" t_rawinline , testEncodeDecode "Link" t_link , testEncodeDecode "Image" t_image , testEncodeDecode "Note" t_note , testEncodeDecode "Span" t_span ] , testGroup "Block" [ testEncodeDecode "Plain" t_plain , testEncodeDecode "Para" t_para , testEncodeDecode "LineBlock" t_lineblock , testEncodeDecode "CodeBlock" t_codeblock , testEncodeDecode "RawBlock" t_rawblock , testEncodeDecode "BlockQuote" t_blockquote , testEncodeDecode "OrderedList" t_orderedlist , testEncodeDecode "BulletList" t_bulletlist , testEncodeDecode "DefinitionList" t_definitionlist , testEncodeDecode "Header" t_header , testEncodeDecode "Table" t_table , testEncodeDecode "Div" t_div , testEncodeDecode "Null" t_null ] ] ], t_tableSan ] main :: IO () main = defaultMain tests pandoc-types-1.17.5.4/Text/0000755000000000000000000000000013363652214013474 5ustar0000000000000000pandoc-types-1.17.5.4/Text/Pandoc/0000755000000000000000000000000013363652215014701 5ustar0000000000000000pandoc-types-1.17.5.4/Text/Pandoc/Definition.hs0000644000000000000000000005712013363652214017331 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric, FlexibleContexts, GeneralizedNewtypeDeriving, PatternGuards, CPP #-} {- Copyright (c) 2006-2016, 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-2016 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable Definition of 'Pandoc' data structure for format-neutral representation of documents. -} module Text.Pandoc.Definition ( Pandoc(..) , Meta(..) , MetaValue(..) , nullMeta , isNullMeta , lookupMeta , docTitle , docAuthors , docDate , Block(..) , Inline(..) , Alignment(..) , ListAttributes , ListNumberStyle(..) , ListNumberDelim(..) , Format(..) , Attr , nullAttr , TableCell , QuoteType(..) , Target , MathType(..) , Citation(..) , CitationMode(..) , pandocTypesVersion ) where import Data.Generics (Data, Typeable) import Data.Ord (comparing) import Data.Aeson hiding (Null) import qualified Data.Aeson.Types as Aeson import qualified Data.Map as M import GHC.Generics (Generic) import Data.String import Data.Char (toLower) #if MIN_VERSION_base(4,8,0) import Control.DeepSeq #else import Data.Monoid (Monoid (mappend, mempty)) import Control.Applicative ((<$>), (<*>)) import Control.DeepSeq (NFData(..)) import Control.DeepSeq.Generics #endif import Paths_pandoc_types (version) import Data.Version (Version, versionBranch) import Data.Semigroup data Pandoc = Pandoc Meta [Block] deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) instance Semigroup Pandoc where (Pandoc m1 bs1) <> (Pandoc m2 bs2) = Pandoc (m1 <> m2) (bs1 <> bs2) instance Monoid Pandoc where mempty = Pandoc mempty mempty mappend = (<>) -- | Metadata for the document: title, authors, date. newtype Meta = Meta { unMeta :: M.Map String MetaValue } deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) instance Semigroup Meta where (Meta m1) <> (Meta m2) = Meta (M.union m1 m2) -- note: M.union is left-biased, so if there are fields in both m1 -- and m2, m1 wins. instance Monoid Meta where mempty = Meta (M.empty) mappend = (<>) data MetaValue = MetaMap (M.Map String MetaValue) | MetaList [MetaValue] | MetaBool Bool | MetaString String | 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 :: String -> 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 _ -> [] -- | 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 newtype Format = Format String deriving (Read, Show, Typeable, Data, Generic, ToJSON, FromJSON) instance IsString Format where fromString f = Format $ map toLower f instance Eq Format where Format x == Format y = map toLower x == map toLower y instance Ord Format where compare (Format x) (Format y) = compare (map toLower x) (map toLower y) -- | Block element. data Block = Plain [Inline] -- ^ Plain text, not a paragraph | Para [Inline] -- ^ Paragraph | LineBlock [[Inline]] -- ^ Multiple non-breaking lines | CodeBlock Attr String -- ^ Code block (literal) with attributes | RawBlock Format String -- ^ Raw block | BlockQuote [Block] -- ^ Block quote (list of blocks) | 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 (required), -- relative column widths (0 = default), -- column headers (each a list of blocks), and -- rows (each a list of lists of blocks) | Div Attr [Block] -- ^ Generic block container with attributes | 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 | SoftBreak -- ^ Soft line break | LineBreak -- ^ Hard line break | Math MathType String -- ^ TeX math (literal) | RawInline Format String -- ^ 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 :: 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) -- ToJSON/FromJSON instances. We do this by hand instead of deriving -- from generics, so we can have more control over the format. taggedNoContent :: [Char] -> Value taggedNoContent x = object [ "t" .= x ] tagged :: ToJSON a => [Char] -> a -> Value tagged x y = object [ "t" .= x, "c" .= y ] instance FromJSON MetaValue where parseJSON (Object v) = do t <- v .: "t" :: Aeson.Parser Value case t of "MetaMap" -> MetaMap <$> (v .: "c") "MetaList" -> MetaList <$> (v .: "c") "MetaBool" -> MetaBool <$> (v .: "c") "MetaString" -> MetaString <$> (v .: "c") "MetaInlines" -> MetaInlines <$> (v .: "c") "MetaBlocks" -> MetaBlocks <$> (v .: "c") _ -> mempty parseJSON _ = mempty instance ToJSON MetaValue where toJSON (MetaMap mp) = tagged "MetaMap" mp toJSON (MetaList lst) = tagged "MetaList" lst toJSON (MetaBool bool) = tagged "MetaBool" bool toJSON (MetaString s) = tagged "MetaString" s toJSON (MetaInlines ils) = tagged "MetaInlines" ils toJSON (MetaBlocks blks) = tagged "MetaBlocks" blks instance FromJSON Meta where parseJSON j = Meta <$> parseJSON j instance ToJSON Meta where toJSON meta = toJSON $ unMeta meta instance FromJSON CitationMode where parseJSON (Object v) = do t <- v .: "t" :: Aeson.Parser Value case t of "AuthorInText" -> return AuthorInText "SuppressAuthor" -> return SuppressAuthor "NormalCitation" -> return NormalCitation _ -> mempty parseJSON _ = mempty instance ToJSON CitationMode where toJSON cmode = taggedNoContent s where s = case cmode of AuthorInText -> "AuthorInText" SuppressAuthor -> "SuppressAuthor" NormalCitation -> "NormalCitation" instance FromJSON Citation where parseJSON (Object v) = do citationId' <- v .: "citationId" citationPrefix' <- v .: "citationPrefix" citationSuffix' <- v .: "citationSuffix" citationMode' <- v .: "citationMode" citationNoteNum' <- v .: "citationNoteNum" citationHash' <- v .: "citationHash" return Citation { citationId = citationId' , citationPrefix = citationPrefix' , citationSuffix = citationSuffix' , citationMode = citationMode' , citationNoteNum = citationNoteNum' , citationHash = citationHash' } parseJSON _ = mempty instance ToJSON Citation where toJSON cit = object [ "citationId" .= citationId cit , "citationPrefix" .= citationPrefix cit , "citationSuffix" .= citationSuffix cit , "citationMode" .= citationMode cit , "citationNoteNum" .= citationNoteNum cit , "citationHash" .= citationHash cit ] instance FromJSON QuoteType where parseJSON (Object v) = do t <- v .: "t" :: Aeson.Parser Value case t of "SingleQuote" -> return SingleQuote "DoubleQuote" -> return DoubleQuote _ -> mempty parseJSON _ = mempty instance ToJSON QuoteType where toJSON qtype = taggedNoContent s where s = case qtype of SingleQuote -> "SingleQuote" DoubleQuote -> "DoubleQuote" instance FromJSON MathType where parseJSON (Object v) = do t <- v .: "t" :: Aeson.Parser Value case t of "DisplayMath" -> return DisplayMath "InlineMath" -> return InlineMath _ -> mempty parseJSON _ = mempty instance ToJSON MathType where toJSON mtype = taggedNoContent s where s = case mtype of DisplayMath -> "DisplayMath" InlineMath -> "InlineMath" instance FromJSON ListNumberStyle where parseJSON (Object v) = do t <- v .: "t" :: Aeson.Parser Value case t of "DefaultStyle" -> return DefaultStyle "Example" -> return Example "Decimal" -> return Decimal "LowerRoman" -> return LowerRoman "UpperRoman" -> return UpperRoman "LowerAlpha" -> return LowerAlpha "UpperAlpha" -> return UpperAlpha _ -> mempty parseJSON _ = mempty instance ToJSON ListNumberStyle where toJSON lsty = taggedNoContent s where s = case lsty of DefaultStyle -> "DefaultStyle" Example -> "Example" Decimal -> "Decimal" LowerRoman -> "LowerRoman" UpperRoman -> "UpperRoman" LowerAlpha -> "LowerAlpha" UpperAlpha -> "UpperAlpha" instance FromJSON ListNumberDelim where parseJSON (Object v) = do t <- v .: "t" :: Aeson.Parser Value case t of "DefaultDelim" -> return DefaultDelim "Period" -> return Period "OneParen" -> return OneParen "TwoParens" -> return TwoParens _ -> mempty parseJSON _ = mempty instance ToJSON ListNumberDelim where toJSON delim = taggedNoContent s where s = case delim of DefaultDelim -> "DefaultDelim" Period -> "Period" OneParen -> "OneParen" TwoParens -> "TwoParens" instance FromJSON Alignment where parseJSON (Object v) = do t <- v .: "t" :: Aeson.Parser Value case t of "AlignLeft" -> return AlignLeft "AlignRight" -> return AlignRight "AlignCenter" -> return AlignCenter "AlignDefault" -> return AlignDefault _ -> mempty parseJSON _ = mempty instance ToJSON Alignment where toJSON delim = taggedNoContent s where s = case delim of AlignLeft -> "AlignLeft" AlignRight -> "AlignRight" AlignCenter -> "AlignCenter" AlignDefault -> "AlignDefault" instance FromJSON Inline where parseJSON (Object v) = do t <- v .: "t" :: Aeson.Parser Value case t of "Str" -> Str <$> v .: "c" "Emph" -> Emph <$> v .: "c" "Strong" -> Strong <$> v .: "c" "Strikeout" -> Strikeout <$> v .: "c" "Superscript" -> Superscript <$> v .: "c" "Subscript" -> Subscript <$> v .: "c" "SmallCaps" -> SmallCaps <$> v .: "c" "Quoted" -> do (qt, ils) <- v .: "c" return $ Quoted qt ils "Cite" -> do (cits, ils) <- v .: "c" return $ Cite cits ils "Code" -> do (attr, s) <- v .: "c" return $ Code attr s "Space" -> return Space "SoftBreak" -> return SoftBreak "LineBreak" -> return LineBreak "Math" -> do (mtype, s) <- v .: "c" return $ Math mtype s "RawInline" -> do (fmt, s) <- v .: "c" return $ RawInline fmt s "Link" -> do (attr, ils, tgt) <- v .: "c" return $ Link attr ils tgt "Image" -> do (attr, ils, tgt) <- v .: "c" return $ Image attr ils tgt "Note" -> Note <$> v .: "c" "Span" -> do (attr, ils) <- v .: "c" return $ Span attr ils _ -> mempty parseJSON _ = mempty instance ToJSON Inline where toJSON (Str s) = tagged "Str" s toJSON (Emph ils) = tagged "Emph" ils toJSON (Strong ils) = tagged "Strong" ils toJSON (Strikeout ils) = tagged "Strikeout" ils toJSON (Superscript ils) = tagged "Superscript" ils toJSON (Subscript ils) = tagged "Subscript" ils toJSON (SmallCaps ils) = tagged "SmallCaps" ils toJSON (Quoted qtype ils) = tagged "Quoted" (qtype, ils) toJSON (Cite cits ils) = tagged "Cite" (cits, ils) toJSON (Code attr s) = tagged "Code" (attr, s) toJSON Space = taggedNoContent "Space" toJSON SoftBreak = taggedNoContent "SoftBreak" toJSON LineBreak = taggedNoContent "LineBreak" toJSON (Math mtype s) = tagged "Math" (mtype, s) toJSON (RawInline fmt s) = tagged "RawInline" (fmt, s) toJSON (Link attr ils target) = tagged "Link" (attr, ils, target) toJSON (Image attr ils target) = tagged "Image" (attr, ils, target) toJSON (Note blks) = tagged "Note" blks toJSON (Span attr ils) = tagged "Span" (attr, ils) instance FromJSON Block where parseJSON (Object v) = do t <- v .: "t" :: Aeson.Parser Value case t of "Plain" -> Plain <$> v .: "c" "Para" -> Para <$> v .: "c" "LineBlock" -> LineBlock <$> v .: "c" "CodeBlock" -> do (attr, s) <- v .: "c" return $ CodeBlock attr s "RawBlock" -> do (fmt, s) <- v .: "c" return $ RawBlock fmt s "BlockQuote" -> BlockQuote <$> v .: "c" "OrderedList" -> do (attr, items) <- v .: "c" return $ OrderedList attr items "BulletList" -> BulletList <$> v .: "c" "DefinitionList" -> DefinitionList <$> v .: "c" "Header" -> do (n, attr, ils) <- v .: "c" return $ Header n attr ils "HorizontalRule" -> return $ HorizontalRule "Table" -> do (cpt, align, wdths, hdr, rows) <- v .: "c" return $ Table cpt align wdths hdr rows "Div" -> do (attr, blks) <- v .: "c" return $ Div attr blks "Null" -> return $ Null _ -> mempty parseJSON _ = mempty instance ToJSON Block where toJSON (Plain ils) = tagged "Plain" ils toJSON (Para ils) = tagged "Para" ils toJSON (LineBlock lns) = tagged "LineBlock" lns toJSON (CodeBlock attr s) = tagged "CodeBlock" (attr, s) toJSON (RawBlock fmt s) = tagged "RawBlock" (fmt, s) toJSON (BlockQuote blks) = tagged "BlockQuote" blks toJSON (OrderedList listAttrs blksList) = tagged "OrderedList" (listAttrs, blksList) toJSON (BulletList blksList) = tagged "BulletList" blksList toJSON (DefinitionList defs) = tagged "DefinitionList" defs toJSON (Header n attr ils) = tagged "Header" (n, attr, ils) toJSON HorizontalRule = taggedNoContent "HorizontalRule" toJSON (Table caption aligns widths cells rows) = tagged "Table" (caption, aligns, widths, cells, rows) toJSON (Div attr blks) = tagged "Div" (attr, blks) toJSON Null = taggedNoContent "Null" instance FromJSON Pandoc where parseJSON (Object v) = do mbJVersion <- v .:? "pandoc-api-version" :: Aeson.Parser (Maybe [Int]) case mbJVersion of Just jVersion | x : y : _ <- jVersion , x' : y' : _ <- versionBranch pandocTypesVersion , x == x' , y == y' -> Pandoc <$> v .: "meta" <*> v .: "blocks" | otherwise -> fail $ mconcat [ "Incompatible API versions: " , "encoded with " , show jVersion , " but attempted to decode with " , show $ versionBranch pandocTypesVersion , "." ] _ -> fail "JSON missing pandoc-api-version." parseJSON _ = mempty instance ToJSON Pandoc where toJSON (Pandoc meta blks) = object [ "pandoc-api-version" .= versionBranch pandocTypesVersion , "meta" .= meta , "blocks" .= blks ] -- Instances for deepseq #if MIN_VERSION_base(4,8,0) instance NFData MetaValue instance NFData Meta instance NFData Citation instance NFData Alignment instance NFData Inline instance NFData MathType instance NFData Format instance NFData CitationMode instance NFData QuoteType instance NFData ListNumberDelim instance NFData ListNumberStyle instance NFData Block instance NFData Pandoc #else instance NFData MetaValue where rnf = genericRnf instance NFData Meta where rnf = genericRnf instance NFData Citation where rnf = genericRnf instance NFData Alignment where rnf = genericRnf instance NFData Inline where rnf = genericRnf instance NFData MathType where rnf = genericRnf instance NFData Format where rnf = genericRnf instance NFData CitationMode where rnf = genericRnf instance NFData QuoteType where rnf = genericRnf instance NFData ListNumberDelim where rnf = genericRnf instance NFData ListNumberStyle where rnf = genericRnf instance NFData Block where rnf = genericRnf instance NFData Pandoc where rnf = genericRnf #endif pandocTypesVersion :: Version pandocTypesVersion = version pandoc-types-1.17.5.4/Text/Pandoc/Walk.hs0000644000000000000000000003252513363652215016142 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE CPP #-} #if MIN_VERSION_base(4,9,0) {-# OPTIONS_GHC -fno-warn-redundant-constraints -O2 #-} #endif #if MIN_VERSION_base(4,8,0) #define OVERLAPS {-# OVERLAPPING #-} #else {-# LANGUAGE OverlappingInstances #-} #define OVERLAPS #endif {- Copyright (c) 2013-2017, 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 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable Functions for manipulating 'Pandoc' documents or extracting information from them by walking the 'Pandoc' structure (or intermediate structures like '[Block]' or '[Inline]'. These are faster (by a factor of four or five) than the generic functions defined in @Text.Pandoc.Generic@. Here's a simple example, defining a function that replaces all the level 3+ headers in a document with regular paragraphs in ALL CAPS: > import Text.Pandoc.Definition > import Text.Pandoc.Walk > import Data.Char (toUpper) > > modHeader :: Block -> Block > modHeader (Header n _ xs) | n >= 3 = Para $ walk allCaps xs > modHeader x = x > > allCaps :: Inline -> Inline > allCaps (Str xs) = Str $ map toUpper xs > allCaps x = x > > changeHeaders :: Pandoc -> Pandoc > changeHeaders = walk modHeader 'query' can be used, for example, to compile a list of URLs linked to in a document: > extractURL :: Inline -> [String] > extractURL (Link _ _ (u,_)) = [u] > extractURL (Image _ _ (u,_)) = [u] > extractURL _ = [] > > extractURLs :: Pandoc -> [String] > extractURLs = query extractURL -} module Text.Pandoc.Walk (Walkable(..)) where import Control.Applicative (Applicative ((<*>), pure), (<$>)) import Control.Monad ((>=>)) import Data.Functor.Identity (Identity (runIdentity)) import Text.Pandoc.Definition import qualified Data.Traversable as T import Data.Traversable (Traversable) import qualified Data.Foldable as F import Data.Foldable (Foldable) #if MIN_VERSION_base(4,8,0) import Data.Monoid ((<>)) #else import Data.Monoid #endif 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) 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 f = walkInlineM f query f = queryInline f instance Walkable Inline Block where walkM f = walkBlockM f query f = queryBlock f instance Walkable [Inline] Block where walkM f = walkBlockM f query f = queryBlock f instance Walkable Block Block where walkM f x = walkBlockM f x >>= f query f x = f x <> queryBlock f x instance Walkable [Block] Block where walkM f = walkBlockM f query f = queryBlock f instance OVERLAPS Walkable [Block] [Block] where walkM f = T.traverse (walkBlockM f) >=> f query f blks = f blks <> mconcat (map (queryBlock f) blks) instance Walkable Block Inline where walkM f = walkInlineM f query f = queryInline f instance Walkable [Block] Inline where walkM f = walkInlineM f query f = queryInline f instance Walkable Block Pandoc where 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 Pandoc Pandoc where walkM f = f query f = f 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 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 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 walkInlineM :: (Walkable a Citation, Walkable a [Block], Walkable a [Inline], Monad m, Applicative m, Functor m) => (a -> m a) -> Inline -> m Inline walkInlineM _ (Str xs) = return (Str xs) walkInlineM f (Emph xs) = Emph <$> walkM f xs walkInlineM f (Strong xs) = Strong <$> walkM f xs walkInlineM f (Strikeout xs) = Strikeout <$> walkM f xs walkInlineM f (Subscript xs) = Subscript <$> walkM f xs walkInlineM f (Superscript xs) = Superscript <$> walkM f xs walkInlineM f (SmallCaps xs) = SmallCaps <$> walkM f xs walkInlineM f (Quoted qt xs) = Quoted qt <$> walkM f xs walkInlineM f (Link atr xs t) = Link atr <$> walkM f xs <*> pure t walkInlineM f (Image atr xs t) = Image atr <$> walkM f xs <*> pure t walkInlineM f (Note bs) = Note <$> walkM f bs walkInlineM f (Span attr xs) = Span attr <$> walkM f xs walkInlineM f (Cite cs xs) = Cite <$> walkM f cs <*> walkM f xs walkInlineM _ LineBreak = return LineBreak walkInlineM _ SoftBreak = return SoftBreak walkInlineM _ Space = return Space walkInlineM _ x@Code {} = return x walkInlineM _ x@Math {} = return x walkInlineM _ x@RawInline {} = return x walkBlockM :: (Walkable a [Block], Walkable a [Inline], Monad m, Applicative m, Functor m) => (a -> m a) -> Block -> m Block walkBlockM f (Para xs) = Para <$> walkM f xs walkBlockM f (Plain xs) = Plain <$> walkM f xs walkBlockM f (LineBlock xs) = LineBlock <$> walkM f xs walkBlockM f (BlockQuote xs) = BlockQuote <$> walkM f xs walkBlockM f (OrderedList a cs) = OrderedList a <$> walkM f cs walkBlockM f (BulletList cs) = BulletList <$> walkM f cs walkBlockM f (DefinitionList xs) = DefinitionList <$> walkM f xs walkBlockM f (Header lev attr xs) = Header lev attr <$> walkM f xs walkBlockM f (Div attr bs') = Div attr <$> walkM f bs' walkBlockM _ x@CodeBlock {} = return x walkBlockM _ x@RawBlock {} = return x walkBlockM _ HorizontalRule = return HorizontalRule walkBlockM _ Null = return Null walkBlockM f (Table capt as ws hs rs) = do capt' <- walkM f capt hs' <- walkM f hs rs' <- walkM f rs return $ Table capt' as ws hs' rs' walkMetaValueM :: (Walkable a MetaValue, Walkable a [Block], Walkable a [Inline], Monad f, Applicative f, Functor f) => (a -> f a) -> MetaValue -> f MetaValue walkMetaValueM f (MetaList xs) = MetaList <$> walkM f xs walkMetaValueM _ (MetaBool b) = return $ MetaBool b walkMetaValueM _ (MetaString s) = return $ MetaString s walkMetaValueM f (MetaInlines xs) = MetaInlines <$> walkM f xs walkMetaValueM f (MetaBlocks bs) = MetaBlocks <$> walkM f bs walkMetaValueM f (MetaMap m) = MetaMap <$> walkM f m queryInline :: (Walkable a Citation, Walkable a [Block], Walkable a [Inline], Monoid c) => (a -> c) -> Inline -> c queryInline _ (Str _) = mempty queryInline f (Emph xs) = query f xs queryInline f (Strong xs) = query f xs queryInline f (Strikeout xs) = query f xs queryInline f (Subscript xs) = query f xs queryInline f (Superscript xs)= query f xs queryInline f (SmallCaps xs) = query f xs queryInline f (Quoted _ xs) = query f xs queryInline f (Cite cs xs) = query f cs <> query f xs queryInline _ (Code _ _) = mempty queryInline _ Space = mempty queryInline _ SoftBreak = mempty queryInline _ LineBreak = mempty queryInline _ (Math _ _) = mempty queryInline _ (RawInline _ _) = mempty queryInline f (Link _ xs _) = query f xs queryInline f (Image _ xs _) = query f xs queryInline f (Note bs) = query f bs queryInline f (Span _ xs) = query f xs queryBlock :: (Walkable a Citation, Walkable a [Block], Walkable a [Inline], Monoid c) => (a -> c) -> Block -> c queryBlock f (Para xs) = query f xs queryBlock f (Plain xs) = query f xs queryBlock f (LineBlock xs) = query f xs queryBlock _ (CodeBlock _ _) = mempty queryBlock _ (RawBlock _ _) = mempty queryBlock f (BlockQuote bs) = query f bs queryBlock f (OrderedList _ cs) = query f cs queryBlock f (BulletList cs) = query f cs queryBlock f (DefinitionList xs) = query f xs queryBlock f (Header _ _ xs) = query f xs queryBlock _ HorizontalRule = mempty queryBlock f (Table capt _ _ hs rs) = query f capt <> query f hs <> query f rs queryBlock f (Div _ bs) = query f bs queryBlock _ Null = mempty queryMetaValue :: (Walkable a MetaValue, Walkable a [Block], Walkable a [Inline], Monoid c) => (a -> c) -> MetaValue -> c queryMetaValue f (MetaList xs) = query f xs queryMetaValue _ (MetaBool _) = mempty queryMetaValue _ (MetaString _) = mempty queryMetaValue f (MetaInlines xs) = query f xs queryMetaValue f (MetaBlocks bs) = query f bs queryMetaValue f (MetaMap m) = query f m walkCitationM :: (Walkable a [Inline], Monad m, Applicative m, Functor m) => (a -> m a) -> Citation -> m Citation walkCitationM f (Citation id' pref suff mode notenum hash) = do pref' <- walkM f pref suff' <- walkM f suff return $ Citation id' pref' suff' mode notenum hash queryCitation :: (Walkable a [Inline], Monoid c) => (a -> c) -> Citation -> c queryCitation f (Citation _ pref suff _ _ _) = query f pref <> query f suff walkPandocM :: (Walkable a Meta, Walkable a [Block], Monad m, Applicative m, Functor m) => (a -> m a) -> Pandoc -> m Pandoc walkPandocM f (Pandoc m bs) = do m' <- walkM f m bs' <- walkM f bs return $ Pandoc m' bs' queryPandoc :: (Walkable a Meta, Walkable a [Block], Monoid c) => (a -> c) -> Pandoc -> c queryPandoc f (Pandoc m bs) = query f m <> query f bs pandoc-types-1.17.5.4/Text/Pandoc/Builder.hs0000644000000000000000000004023013363652215016622 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP, StandaloneDeriving, DeriveGeneric, DeriveTraversable #-} {- Copyright (C) 2010-2016 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-2016 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable Convenience functions for building pandoc documents programmatically. Example of use (with @OverloadedStrings@ pragma): > import Text.Pandoc.Builder > > myDoc :: Pandoc > myDoc = setTitle "My title" $ doc $ > para "This is the first paragraph" <> > para ("And " <> emph "another" <> ".") <> > bulletList [ para "item one" <> para "continuation" > , plain ("item two and a " <> > link "/url" "go to url" "link") > ] Isn't that nicer than writing the following? > import Text.Pandoc.Definition > import Data.Map (fromList) > > myDoc :: Pandoc > myDoc = Pandoc (Meta {unMeta = fromList [("title", > MetaInlines [Str "My",Space,Str "title"])]}) > [Para [Str "This",Space,Str "is",Space,Str "the",Space,Str "first", > Space,Str "paragraph"],Para [Str "And",Space,Emph [Str "another"], > Str "."] > ,BulletList [ > [Para [Str "item",Space,Str "one"] > ,Para [Str "continuation"]] > ,[Plain [Str "item",Space,Str "two",Space,Str "and",Space, > Str "a",Space,Link nullAttr [Str "link"] ("/url","go to url")]]]] And of course, you can use Haskell to define your own builders: > import Text.Pandoc.Builder > import Text.JSON > import Control.Arrow ((***)) > import Data.Monoid (mempty) > > -- | Converts a JSON document into 'Blocks'. > json :: String -> Blocks > json x = > case decode x of > Ok y -> jsValueToBlocks y > Error y -> error y > where jsValueToBlocks x = > case x of > JSNull -> mempty > JSBool x -> plain $ text $ show x > JSRational _ x -> plain $ text $ show x > JSString x -> plain $ text $ fromJSString x > JSArray xs -> bulletList $ map jsValueToBlocks xs > JSObject x -> definitionList $ > map (text *** (:[]) . jsValueToBlocks) $ > fromJSObject x -} module Text.Pandoc.Builder ( module Text.Pandoc.Definition , Many(..) , Inlines , Blocks , (<>) , singleton , toList , fromList , isNull -- * Document builders , doc , ToMetaValue(..) , HasMeta(..) , setTitle , setAuthors , setDate -- * Inline list builders , text , str , emph , 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 , table , simpleTable , divWith ) where import Text.Pandoc.Definition import Data.String import qualified Data.Map as M import Data.Sequence (Seq, (|>), viewr, viewl, ViewR(..), ViewL(..)) import qualified Data.Sequence as Seq import Data.Traversable (Traversable) import Data.Foldable (Foldable) import qualified Data.Foldable as F import Data.List (groupBy) import Data.Data import Control.Arrow ((***)) import GHC.Generics (Generic) import Data.Semigroup #if MIN_VERSION_base(4,5,0) -- (<>) is defined in Data.Monoid #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) 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 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) (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 -- | 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 {-# OVERLAPPING #-} ToMetaValue String where toMetaValue = MetaString instance ToMetaValue a => ToMetaValue [a] where toMetaValue = MetaList . map toMetaValue instance ToMetaValue a => ToMetaValue (M.Map String a) where toMetaValue = MetaMap . M.map toMetaValue class HasMeta a where setMeta :: ToMetaValue b => String -> b -> a -> a deleteMeta :: String -> 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 'String' to 'Inlines', treating interword spaces as 'Space's -- or 'SoftBreak'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 = if 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 :: 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 softbreak :: Inlines softbreak = singleton SoftBreak linebreak :: Inlines linebreak = singleton LineBreak -- | Inline math math :: String -> Inlines math = singleton . Math InlineMath -- | Display math displayMath :: String -> Inlines displayMath = singleton . Math DisplayMath rawInline :: String -> String -> Inlines rawInline format = singleton . RawInline (Format format) link :: String -- ^ URL -> String -- ^ Title -> Inlines -- ^ Label -> Inlines link = linkWith nullAttr linkWith :: Attr -- ^ Attributes -> String -- ^ URL -> String -- ^ Title -> Inlines -- ^ Label -> Inlines linkWith attr url title x = singleton $ Link attr (toList x) (url, title) image :: String -- ^ URL -> String -- ^ Title -> Inlines -- ^ Alt text -> Inlines image = imageWith nullAttr imageWith :: Attr -- ^ Attributes -> String -- ^ URL -> String -- ^ 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 -> String -> Blocks codeBlockWith attrs = singleton . CodeBlock attrs -- | A plain code block. codeBlock :: String -> Blocks codeBlock = codeBlockWith nullAttr rawBlock :: String -> String -> 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 -- | Table builder. Rows and headers will be padded or truncated to the size of -- @cellspecs@ 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 (sanitise headers) (map sanitise rows) where (aligns, widths) = unzip cellspecs sanitise = map toList . pad mempty numcols numcols = length cellspecs pad element upTo list = take upTo (list ++ repeat element) -- | A simple table without a caption. simpleTable :: [Blocks] -- ^ Headers -> [[Blocks]] -- ^ Rows -> Blocks simpleTable headers rows = table mempty (replicate numcols defaults) headers rows where defaults = (AlignDefault, 0) numcols = case (headers:rows) of [] -> 0 xs -> maximum (map length xs) divWith :: Attr -> Blocks -> Blocks divWith attr = singleton . Div attr . toList pandoc-types-1.17.5.4/Text/Pandoc/JSON.hs0000644000000000000000000001167113363652215016014 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} {- Copyright (c) 2013-2016, 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-2016 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable Functions for serializing the Pandoc AST to JSON and deserializing from JSON. Example of use: The following script (@capitalize.hs@) reads reads a JSON representation of a Pandoc document from stdin, and writes a JSON representation of a Pandoc document to stdout. It changes all regular text in the document to uppercase, without affecting URLs, code, tags, etc. Run the script with > pandoc -t json | runghc capitalize.hs | pandoc -f json or (making capitalize.hs executable) > pandoc --filter ./capitalize.hs > #!/usr/bin/env runghc > import Text.Pandoc.JSON > import Data.Char (toUpper) > > main :: IO () > main = toJSONFilter capitalizeStrings > > capitalizeStrings :: Inline -> Inline > capitalizeStrings (Str s) = Str $ map toUpper s > capitalizeStrings x = x -} module Text.Pandoc.JSON ( module Text.Pandoc.Definition , ToJSONFilter(..) ) where import Text.Pandoc.Definition import Text.Pandoc.Walk import Data.Maybe (listToMaybe) import qualified Data.ByteString.Lazy as BL 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 a where toJSONFilter :: a -> IO () instance (Walkable a Pandoc) => ToJSONFilter (a -> a) where toJSONFilter f = BL.getContents >>= BL.putStr . encode . (walk f :: Pandoc -> Pandoc) . either error id . eitherDecode' instance (Walkable a Pandoc) => ToJSONFilter (a -> IO a) where toJSONFilter f = BL.getContents >>= (walkM f :: Pandoc -> IO Pandoc) . either error id . eitherDecode' >>= BL.putStr . encode instance (Walkable [a] Pandoc) => ToJSONFilter (a -> [a]) where toJSONFilter f = BL.getContents >>= BL.putStr . encode . (walk (concatMap f) :: Pandoc -> Pandoc) . either error id . eitherDecode' instance (Walkable [a] Pandoc) => ToJSONFilter (a -> IO [a]) where toJSONFilter f = BL.getContents >>= (walkM (fmap concat . mapM f) :: Pandoc -> IO Pandoc) . either error id . eitherDecode' >>= BL.putStr . encode instance (ToJSONFilter a) => ToJSONFilter ([String] -> a) where toJSONFilter f = getArgs >>= toJSONFilter . f instance (ToJSONFilter a) => ToJSONFilter (Maybe Format -> a) where toJSONFilter f = getArgs >>= toJSONFilter . f . fmap Format . listToMaybe pandoc-types-1.17.5.4/Text/Pandoc/Arbitrary.hs0000644000000000000000000003447213363652215017206 0ustar0000000000000000{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-} -- provides Arbitrary instance for Pandoc types module Text.Pandoc.Arbitrary () where import Test.QuickCheck import Control.Applicative (Applicative ((<*>), pure), (<$>)) import Control.Monad (forM) import Text.Pandoc.Definition import Text.Pandoc.Builder realString :: Gen String realString = resize 8 $ listOf $ frequency [ (9, elements [' '..'\127']) , (1, elements ['\128'..'\9999']) ] arbAttr :: Gen Attr arbAttr = do id' <- elements ["","loc"] classes <- elements [[],["haskell"],["c","numberLines"]] keyvals <- elements [[],[("start","22")],[("a","11"),("b_2","a b c")]] return (id',classes,keyvals) instance Arbitrary Inlines where arbitrary = (fromList :: [Inline] -> Inlines) <$> arbitrary shrink = fmap fromList . ((++) <$> shrink <*> flattenShrinkInlines) . toList where flattenShrinkInlines (x:xs) = let x' = flattenInline x in (if null x' then [] else [x' ++ xs]) ++ [x:xs' | xs' <- flattenShrinkInlines xs] flattenShrinkInlines [] = [] flattenInline :: Inline -> [Inline] flattenInline (Str _) = [] flattenInline (Emph 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 (if null x' then [] else [x' ++ xs]) ++ [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 caption _ _ cells rows) = Para caption : concat (concat $ cells:rows) flattenBlock (Div _ blks) = blks flattenBlock Null = [] 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 <$> shrink s shrink (Emph ils) = Emph <$> 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 <$> shrink s) ++ (flip Code s <$> shrink attr) shrink Space = [] shrink SoftBreak = [] shrink LineBreak = [] shrink (Math mtype s) = Math mtype <$> shrink s shrink (RawInline fmt s) = RawInline fmt <$> shrink s shrink (Link attr ils target) = [Link attr ils' target | ils' <- shrinkInlineList ils] ++ [Link attr ils target' | target' <- shrink target] ++ [Link attr' ils target | attr' <- shrink attr] shrink (Image attr ils target) = [Image attr ils' target | ils' <- shrinkInlineList ils] ++ [Image attr ils target' | target' <- shrink target] ++ [Image attr' ils target | attr' <- shrink attr] shrink (Note blks) = Note <$> shrinkBlockList blks shrink (Span attr s) = (Span attr <$> shrink s) ++ (flip Span s <$> shrink attr) arbInlines :: Int -> Gen [Inline] arbInlines n = listOf1 (arbInline n) `suchThat` (not . startsWithSpace) where startsWithSpace (Space:_) = True startsWithSpace (SoftBreak:_) = True -- Note: no LineBreak, similarly to Text.Pandoc.Builder (trimInlines) startsWithSpace _ = False -- restrict to 3 levels of nesting max; otherwise we get -- bogged down in indefinitely large structures arbInline :: Int -> Gen Inline arbInline n = frequency $ [ (60, Str <$> realString) , (40, pure Space) , (10, pure SoftBreak) , (10, pure LineBreak) , (10, Code <$> arbAttr <*> realString) , (5, elements [ RawInline (Format "html") "" , RawInline (Format "latex") "\\my{command}" ]) ] ++ [ x | x <- nesters, n > 1] where nesters = [ (10, Emph <$> 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 <$> shrink s) ++ (flip CodeBlock s <$> shrink attr) shrink (RawBlock fmt s) = RawBlock fmt <$> shrink 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 <$> shrink attr) shrink HorizontalRule = [] shrink (Table caption aligns widths cells rows) = -- TODO: shrink number of columns -- Shrink header contents [Table caption aligns widths cells' rows | cells' <- shrinkRow cells] ++ -- Shrink number of rows and row contents [Table caption aligns widths cells rows' | rows' <- shrinkRows rows] ++ -- Shrink caption [Table caption' aligns widths cells rows | caption' <- shrinkInlineList caption] where -- Shrink row contents without reducing the number of columns shrinkRow :: [TableCell] -> [[TableCell]] shrinkRow (x:xs) = [x':xs | x' <- shrinkBlockList x] ++ [x:xs' | xs' <- shrinkRow xs] shrinkRow [] = [] shrinkRows :: [[TableCell]] -> [[[TableCell]]] shrinkRows (x:xs) = [xs] -- Shrink number of rows ++ [x':xs | x' <- shrinkRow x] -- Shrink row contents ++ [x:xs' | xs' <- shrinkRows xs] shrinkRows [] = [] shrink (Div attr blks) = (Div attr <$> shrinkBlockList blks) ++ (flip Div blks <$> shrink attr) shrink Null = [] arbBlock :: Int -> Gen Block arbBlock n = frequency $ [ (10, Plain <$> arbInlines (n-1)) , (15, Para <$> arbInlines (n-1)) , (5, CodeBlock <$> arbAttr <*> realString) , (3, LineBlock <$> ((:) <$> arbInlines ((n - 1) `mod` 3) <*> forM [1..((n - 1) `div` 3)] (const (arbInlines 3)))) , (2, elements [ RawBlock (Format "html") "
\n*&*\n
" , RawBlock (Format "latex") "\\begin[opt]{env}\nhi\n{\\end{env}" ]) , (5, Header <$> choose (1 :: Int, 6) <*> pure nullAttr <*> arbInlines (n-1)) , (2, pure HorizontalRule) ] ++ [x | x <- nesters, n > 0] 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 rs <- choose (1 :: Int, 4) cs <- choose (1 :: Int, 4) Table <$> arbInlines (n-1) <*> vector cs <*> vectorOf cs (elements [0, 0.25]) <*> vectorOf cs (listOf $ arbBlock (n-1)) <*> vectorOf rs (vectorOf cs $ listOf $ arbBlock (n-1))) ] 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 <$> listOf (elements $ ['a'..'z'] ++ ['0'..'9'] ++ ['_']) <*> arbInlines 1 <*> arbInlines 1 <*> arbitrary <*> arbitrary <*> arbitrary 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 . isNull) <$> arbitrary (x3 :: Inlines) <- arbitrary return $ setMeta "title" x1 $ setMeta "author" x2 $ setMeta "date" x3 $ nullMeta instance Arbitrary Alignment where arbitrary = do x <- choose (0 :: Int, 3) case x of 0 -> return AlignLeft 1 -> return AlignRight 2 -> return AlignCenter 3 -> return AlignDefault _ -> error "FATAL ERROR: Arbitrary instance, logic bug" instance Arbitrary ListNumberStyle where arbitrary = do x <- choose (0 :: Int, 6) case x of 0 -> return DefaultStyle 1 -> return Example 2 -> return Decimal 3 -> return LowerRoman 4 -> return UpperRoman 5 -> return LowerAlpha 6 -> return UpperAlpha _ -> error "FATAL ERROR: Arbitrary instance, logic bug" instance Arbitrary ListNumberDelim where arbitrary = do x <- choose (0 :: Int, 3) case x of 0 -> return DefaultDelim 1 -> return Period 2 -> return OneParen 3 -> return TwoParens _ -> error "FATAL ERROR: Arbitrary instance, logic bug" pandoc-types-1.17.5.4/Text/Pandoc/Generic.hs0000644000000000000000000001223613363652215016615 0ustar0000000000000000{-# LANGUAGE CPP #-} {- Copyright (c) 2006-2016, 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-2010 John MacFarlane License : BSD3 Maintainer : John MacFarlane Stability : alpha Portability : portable Generic functions for manipulating 'Pandoc' documents. (Note: the functions defined in @Text.Pandoc.Walk@ should be used instead, when possible, as they are much faster.) Here's a simple example, defining a function that replaces all the level 3+ headers in a document with regular paragraphs in ALL CAPS: > import Text.Pandoc.Definition > import Text.Pandoc.Generic > import Data.Char (toUpper) > > modHeader :: Block -> Block > modHeader (Header n _ xs) | n >= 3 = Para $ bottomUp allCaps xs > modHeader x = x > > allCaps :: Inline -> Inline > allCaps (Str xs) = Str $ map toUpper xs > allCaps x = x > > changeHeaders :: Pandoc -> Pandoc > changeHeaders = bottomUp modHeader 'bottomUp' is so called because it traverses the @Pandoc@ structure from bottom up. 'topDown' goes the other way. The difference between them can be seen from this example: > normal :: [Inline] -> [Inline] > normal (Space : Space : xs) = Space : xs > normal (Emph xs : Emph ys : zs) = Emph (xs ++ ys) : zs > normal xs = xs > > myDoc :: Pandoc > myDoc = Pandoc nullMeta > [ Para [Str "Hi",Space,Emph [Str "world",Space],Emph [Space,Str "emphasized"]]] Here we want to use 'topDown' to lift @normal@ to @Pandoc -> Pandoc@. The top down strategy will collapse the two adjacent @Emph@s first, then collapse the resulting adjacent @Space@s, as desired. If we used 'bottomUp', we would end up with two adjacent @Space@s, since the contents of the two @Emph@ inlines would be processed before the @Emph@s were collapsed into one. > topDown normal myDoc == > Pandoc nullMeta > [Para [Str "Hi",Space,Emph [Str "world",Space,Str "emphasized"]]] > > bottomUp normal myDoc == > Pandoc nullMeta > [Para [Str "Hi",Space,Emph [Str "world",Space,Space,Str "emphasized"]]] 'bottomUpM' is a monadic version of 'bottomUp'. It could be used, for example, to replace the contents of delimited code blocks with attribute @include=FILENAME@ with the contents of @FILENAME@: > doInclude :: Block -> IO Block > doInclude cb@(CodeBlock (id, classes, namevals) contents) = > case lookup "include" namevals of > Just f -> return . (CodeBlock (id, classes, namevals)) =<< readFile f > Nothing -> return cb > doInclude x = return x > > processIncludes :: Pandoc -> IO Pandoc > processIncludes = bottomUpM doInclude 'queryWith' can be used, for example, to compile a list of URLs linked to in a document: > extractURL :: Inline -> [String] > extractURL (Link _ (u,_)) = [u] > extractURL (Image _ _ (u,_)) = [u] > extractURL _ = [] > > extractURLs :: Pandoc -> [String] > extractURLs = queryWith extractURL -} module Text.Pandoc.Generic where import Data.Generics #if MIN_VERSION_base(4,8,0) #else import Data.Monoid #endif -- | Applies a transformation on @a@s to matching elements in a @b@, -- moving from the bottom of the structure up. 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)