pandoc-types-1.16.1/0000755000000000000000000000000012656463425012411 5ustar0000000000000000pandoc-types-1.16.1/changelog0000644000000000000000000000105112656463425014260 0ustar0000000000000000[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.16.1/LICENSE0000644000000000000000000000277012656463425013424 0ustar0000000000000000Copyright (c) 2013, 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.16.1/pandoc-types.cabal0000644000000000000000000000477312656463425016016 0ustar0000000000000000Name: pandoc-types Version: 1.16.1 Synopsis: Types for representing a structured document Description: @Text.Pandoc.Definition@ defines the 'Pandoc' data structure, which is used by pandoc to represent structured documents. This module used to live in the pandoc package, but starting with pandoc 1.7, it has been split off, so that other packages can use it without drawing in all of pandoc's dependencies, and pandoc itself can depend on packages (like citeproc-hs) that use them. . @Text.Pandoc.Builder@ provides functions for building up @Pandoc@ structures programmatically. . @Text.Pandoc.Generic@ provides generic functions for manipulating Pandoc documents. . @Text.Pandoc.Walk@ provides faster, nongeneric functions for manipulating Pandoc documents. . @Text.Pandoc.JSON@ provides functions for serializing and deserializing a @Pandoc@ structure to and from JSON. Homepage: http://johnmacfarlane.net/pandoc License: BSD3 License-file: LICENSE Author: John MacFarlane Maintainer: jgm@berkeley.edu Bug-Reports: http://code.google.com/p/pandoc/issues/list Copyright: (c) 2006-2015 John MacFarlane Category: Text Build-type: Simple Cabal-version: >=1.6 Tested-With: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2 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 Other-modules: Paths_pandoc_types Build-depends: base >= 4 && < 5, containers >= 0.3, syb >= 0.1 && < 0.7, ghc-prim >= 0.2, bytestring >= 0.9 && < 0.11, aeson >= 0.6.2 && < 0.12 if impl(ghc < 7.10) Build-depends: deepseq-generics >= 0.1 && < 0.2 else Build-depends: deepseq >= 1.4.1 && < 1.5 pandoc-types-1.16.1/Setup.hs0000644000000000000000000000005612656463425014046 0ustar0000000000000000import Distribution.Simple main = defaultMain pandoc-types-1.16.1/Text/0000755000000000000000000000000012656463425013335 5ustar0000000000000000pandoc-types-1.16.1/Text/Pandoc/0000755000000000000000000000000012656463425014541 5ustar0000000000000000pandoc-types-1.16.1/Text/Pandoc/Builder.hs0000644000000000000000000003556312656463425016477 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP, StandaloneDeriving, DeriveGeneric, DeriveTraversable #-} {- Copyright (C) 2010-2012 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.Builder Copyright : Copyright (C) 2010 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane 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 , codeBlockWith , codeBlock , rawBlock , blockQuote , bulletList , orderedListWith , orderedList , definitionList , header , headerWith , horizontalRule , table , simpleTable , divWith ) where import Text.Pandoc.Definition import Data.String import Data.Monoid import Data.Maybe (fromMaybe) import qualified Data.Map as M import Data.Sequence (Seq, (|>), viewr, viewl, ViewR(..), ViewL(..)) import qualified Data.Sequence as Seq import Data.Foldable (Foldable) import qualified Data.Foldable as F import Data.List (groupBy, intersperse) import Data.Data import Data.Typeable import Data.Traversable import Control.Arrow ((***)) import GHC.Generics (Generic) #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 Monoid Blocks instance Monoid Inlines where mempty = Many mempty (Many xs) `mappend` (Many ys) = case (viewr xs, viewl ys) of (EmptyR, _) -> Many ys (_, EmptyL) -> Many xs (xs' :> x, y :< ys') -> Many (meld `mappend` ys') where meld = case (x, y) of (Space, Space) -> xs' |> Space (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 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 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 -- | 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 :: Inlines -- ^ Caption -> [(Alignment, Double)] -- ^ Column alignments and fractional widths -> [Blocks] -- ^ Headers -> [[Blocks]] -- ^ Rows -> Blocks table caption cellspecs headers rows = singleton $ Table (toList caption) aligns widths (map toList headers) (map (map toList) rows) where (aligns, widths) = unzip cellspecs -- | A simple table without a caption. simpleTable :: [Blocks] -- ^ Headers -> [[Blocks]] -- ^ Rows -> Blocks simpleTable headers = table mempty (mapConst defaults headers) headers where defaults = (AlignDefault, 0) divWith :: Attr -> Blocks -> Blocks divWith attr = singleton . Div attr . toList mapConst :: Functor f => b -> f a -> f b mapConst = fmap . const pandoc-types-1.16.1/Text/Pandoc/Definition.hs0000644000000000000000000003273012656463425017172 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleContexts, CPP #-} {- Copyright (C) 2006-2013 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.Definition Copyright : Copyright (C) 2006-2010 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane 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 (FromJSON(..), ToJSON(..)) import qualified Data.Aeson.Types as Aeson import Control.Monad (guard) import qualified Data.Map as M import GHC.Generics (Generic, Rep (..)) import Data.String import Data.Char (toLower) import Data.Monoid #if MIN_VERSION_base(4,8,0) import Control.DeepSeq #else import Control.DeepSeq.Generics #endif import Paths_pandoc_types (version) import Data.Version (Version) data Pandoc = Pandoc Meta [Block] deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) instance Monoid Pandoc where mempty = Pandoc mempty mempty (Pandoc m1 bs1) `mappend` (Pandoc m2 bs2) = Pandoc (m1 `mappend` m2) (bs1 `mappend` bs2) -- | Metadata for the document: title, authors, date. newtype Meta = Meta { unMeta :: M.Map String MetaValue } deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) instance Monoid Meta where mempty = Meta (M.empty) (Meta m1) `mappend` (Meta m2) = Meta (M.union m1 m2) -- note: M.union is left-biased, so if there are fields in both m1 -- and m2, m1 wins. 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) 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 | 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) -- derive generic instances of FromJSON, ToJSON: jsonOpts :: Aeson.Options jsonOpts = Aeson.defaultOptions{ Aeson.fieldLabelModifier = id , Aeson.constructorTagModifier = id , Aeson.allNullaryToStringTag = False , Aeson.omitNothingFields = False , Aeson.sumEncoding = Aeson.TaggedObject "t" "c" } toJSON' :: (Generic a, Aeson.GToJSON (Rep a)) => a -> Aeson.Value toJSON' = Aeson.genericToJSON jsonOpts parseJSON' :: (Generic a, Aeson.GFromJSON (Rep a)) => Aeson.Value -> Aeson.Parser a parseJSON' = Aeson.genericParseJSON jsonOpts instance FromJSON MetaValue where parseJSON = parseJSON' instance ToJSON MetaValue where toJSON = toJSON' instance FromJSON Meta where parseJSON = parseJSON' instance ToJSON Meta where toJSON = toJSON' instance FromJSON CitationMode where parseJSON = parseJSON' instance ToJSON CitationMode where toJSON = toJSON' instance FromJSON Citation where parseJSON = parseJSON' instance ToJSON Citation where toJSON = toJSON' instance FromJSON QuoteType where parseJSON = parseJSON' instance ToJSON QuoteType where toJSON = toJSON' instance FromJSON MathType where parseJSON = parseJSON' instance ToJSON MathType where toJSON = toJSON' instance FromJSON ListNumberStyle where parseJSON = parseJSON' instance ToJSON ListNumberStyle where toJSON = toJSON' instance FromJSON ListNumberDelim where parseJSON = parseJSON' instance ToJSON ListNumberDelim where toJSON = toJSON' instance FromJSON Alignment where parseJSON = parseJSON' instance ToJSON Alignment where toJSON = toJSON' instance FromJSON Format where parseJSON = parseJSON' instance ToJSON Format where toJSON = toJSON' instance FromJSON Inline where parseJSON = parseJSON' instance ToJSON Inline where toJSON = toJSON' instance FromJSON Block where parseJSON = parseJSON' instance ToJSON Block where toJSON = toJSON' instance FromJSON Pandoc where parseJSON = parseJSON' instance ToJSON Pandoc where toJSON = toJSON' -- 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.16.1/Text/Pandoc/Generic.hs0000644000000000000000000001053212656463425016452 0ustar0000000000000000{- Copyright (C) 2006-2010 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.Generic Copyright : Copyright (C) 2006-2010 John MacFarlane License : GNU GPL, version 2 or above Maintainer : John MacFarlane 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 import Data.Monoid -- | Applies a transformation on @a@s to matching elements in a @b@, -- moving from the bottom of the structure up. bottomUp :: (Data a, Data b) => (a -> a) -> b -> b bottomUp f = everywhere (mkT f) -- | Applies a transformation on @a@s to matching elements in a @b@, -- moving from the top of the structure down. topDown :: (Data a, Data b) => (a -> a) -> b -> b topDown f = everywhere' (mkT f) -- | Like 'bottomUp', but with monadic transformations. bottomUpM :: (Monad m, Data a, Data b) => (a -> m a) -> b -> m b bottomUpM f = everywhereM (mkM f) -- | Runs a query on matching @a@ elements in a @c@. The results -- of the queries are combined using 'mappend'. queryWith :: (Data a, Monoid b, Data c) => (a -> b) -> c -> b queryWith f = everything mappend (mempty `mkQ` f) pandoc-types-1.16.1/Text/Pandoc/JSON.hs0000644000000000000000000001035012656463425015645 0ustar0000000000000000{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} {- Copyright (C) 2013 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.JSON Copyright : Copyright (C) 2013 John MacFarlane License : GNU GPL, version 2 or above 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 Text.Pandoc.Generic import Data.Maybe (listToMaybe) import Data.Data import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy as BL import Data.Aeson import System.Environment (getArgs) -- | '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 Data a => ToJSONFilter (a -> [a]) where toJSONFilter f = BL.getContents >>= BL.putStr . encode . (bottomUp (concatMap f) :: Pandoc -> Pandoc) . either error id . eitherDecode' instance Data a => ToJSONFilter (a -> IO [a]) where toJSONFilter f = BL.getContents >>= (bottomUpM (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.16.1/Text/Pandoc/Walk.hs0000644000000000000000000004343512656463425016004 0ustar0000000000000000{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, CPP #-} #if MIN_VERSION_base(4,8,0) #define OVERLAPS {-# OVERLAPPING #-} #else {-# LANGUAGE OverlappingInstances #-} #define OVERLAPS #endif {- Copyright (C) 2013 John MacFarlane This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | Module : Text.Pandoc.Walk Copyright : Copyright (C) 2013 John MacFarlane License : GNU GPL, version 2 or above 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 ((<$>), (<*>)) import Text.Pandoc.Definition import Text.Pandoc.Builder ((<>)) import qualified Data.Traversable as T import Data.Traversable (Traversable, traverse) import qualified Data.Foldable as F import Data.Foldable (Foldable, foldMap) import qualified Data.Map as M import Data.Monoid class Walkable a b where -- | @walk f x@ walks the structure @x@ (bottom up) and replaces every -- occurrence of an @a@ with the result of applying @f@ to it. walk :: (a -> a) -> b -> b -- | A monadic version of 'walk'. walkM :: (Monad 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 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 walk f (Str xs) = f $ Str xs walk f (Emph xs) = f $ Emph (walk f xs) walk f (Strong xs) = f $ Strong (walk f xs) walk f (Strikeout xs) = f $ Strikeout (walk f xs) walk f (Subscript xs) = f $ Subscript (walk f xs) walk f (Superscript xs) = f $ Superscript (walk f xs) walk f (SmallCaps xs) = f $ SmallCaps (walk f xs) walk f (Quoted qt xs) = f $ Quoted qt (walk f xs) walk f (Cite cs xs) = f $ Cite (walk f cs) (walk f xs) walk f (Code attr s) = f $ Code attr s walk f Space = f Space walk f SoftBreak = f SoftBreak walk f LineBreak = f LineBreak walk f (Math mt s) = f (Math mt s) walk f (RawInline t s) = f $ RawInline t s walk f (Link atr xs t) = f $ Link atr (walk f xs) t walk f (Image atr xs t) = f $ Image atr (walk f xs) t walk f (Note bs) = f $ Note (walk f bs) walk f (Span attr xs) = f $ Span attr (walk f xs) walkM f (Str xs) = f $ Str xs walkM f (Emph xs) = Emph <$> walkM f xs >>= f walkM f (Strong xs) = Strong <$> walkM f xs >>= f walkM f (Strikeout xs) = Strikeout <$> walkM f xs >>= f walkM f (Subscript xs) = Subscript <$> walkM f xs >>= f walkM f (Superscript xs)= Superscript <$> walkM f xs >>= f walkM f (SmallCaps xs) = SmallCaps <$> walkM f xs >>= f walkM f (Quoted qt xs) = Quoted qt <$> walkM f xs >>= f walkM f (Cite cs xs) = do cs' <- walkM f cs xs' <- walkM f xs f $ Cite cs' xs' walkM f (Code attr s) = f $ Code attr s walkM f Space = f Space walkM f SoftBreak = f SoftBreak walkM f LineBreak = f LineBreak walkM f (Math mt s) = f (Math mt s) walkM f (RawInline t s) = f $ RawInline t s walkM f (Link atr xs t) = Link atr <$> walkM f xs >>= f . ($ t) walkM f (Image atr xs t)= Image atr <$> walkM f xs >>= f . ($ t) walkM f (Note bs) = Note <$> walkM f bs >>= f walkM f (Span attr xs) = Span attr <$> walkM f xs >>= f query f (Str xs) = f (Str xs) query f (Emph xs) = f (Emph xs) <> query f xs query f (Strong xs) = f (Strong xs) <> query f xs query f (Strikeout xs) = f (Strikeout xs) <> query f xs query f (Subscript xs) = f (Subscript xs) <> query f xs query f (Superscript xs)= f (Superscript xs) <> query f xs query f (SmallCaps xs) = f (SmallCaps xs) <> query f xs query f (Quoted qt xs) = f (Quoted qt xs) <> query f xs query f (Cite cs xs) = f (Cite cs xs) <> query f cs <> query f xs query f (Code attr s) = f (Code attr s) query f Space = f Space query f SoftBreak = f SoftBreak query f LineBreak = f LineBreak query f (Math mt s) = f (Math mt s) query f (RawInline t s) = f (RawInline t s) query f (Link atr xs t) = f (Link atr xs t) <> query f xs query f (Image atr xs t)= f (Image atr xs t) <> query f xs query f (Note bs) = f (Note bs) <> query f bs query f (Span attr xs) = f (Span attr xs) <> query f xs instance Walkable Inline Block where walk f (Para xs) = Para $ walk f xs walk f (Plain xs) = Plain $ walk f xs walk f (CodeBlock attr s) = CodeBlock attr s walk f (RawBlock t s) = RawBlock t s walk f (BlockQuote bs) = BlockQuote $ walk f bs walk f (OrderedList a cs) = OrderedList a $ walk f cs walk f (BulletList cs) = BulletList $ walk f cs walk f (DefinitionList xs) = DefinitionList $ walk f xs walk f (Header lev attr xs) = Header lev attr $ walk f xs walk f HorizontalRule = HorizontalRule walk f (Table capt as ws hs rs) = Table (walk f capt) as ws (walk f hs) (walk f rs) walk f (Div attr bs) = Div attr (walk f bs) walk f Null = Null walkM f (Para xs) = Para <$> walkM f xs walkM f (Plain xs) = Plain <$> walkM f xs walkM f (CodeBlock attr s) = return $ CodeBlock attr s walkM f (RawBlock t s) = return $ RawBlock t s walkM f (BlockQuote bs) = BlockQuote <$> walkM f bs walkM f (OrderedList a cs) = OrderedList a <$> walkM f cs walkM f (BulletList cs) = BulletList <$> walkM f cs walkM f (DefinitionList xs) = DefinitionList <$> walkM f xs walkM f (Header lev attr xs) = Header lev attr <$> walkM f xs walkM f HorizontalRule = return HorizontalRule walkM f (Table capt as ws hs rs) = do capt' <- walkM f capt hs' <- walkM f hs rs' <- walkM f rs return $ Table capt' as ws hs' rs' walkM f (Div attr bs) = Div attr <$> (walkM f bs) walkM f Null = return Null query f (Para xs) = query f xs query f (Plain xs) = query f xs query f (CodeBlock attr s) = mempty query f (RawBlock t s) = mempty query f (BlockQuote bs) = query f bs query f (OrderedList a cs) = query f cs query f (BulletList cs) = query f cs query f (DefinitionList xs) = query f xs query f (Header lev attr xs) = query f xs query f HorizontalRule = mempty query f (Table capt as ws hs rs) = query f capt <> query f hs <> query f rs query f (Div attr bs) = query f bs query f Null = mempty instance Walkable Block Block where walk f (Para xs) = f $ Para $ walk f xs walk f (Plain xs) = f $ Plain $ walk f xs walk f (CodeBlock attr s) = f $ CodeBlock attr s walk f (RawBlock t s) = f $ RawBlock t s walk f (BlockQuote bs) = f $ BlockQuote $ walk f bs walk f (OrderedList a cs) = f $ OrderedList a $ walk f cs walk f (BulletList cs) = f $ BulletList $ walk f cs walk f (DefinitionList xs) = f $ DefinitionList $ walk f xs walk f (Header lev attr xs) = f $ Header lev attr $ walk f xs walk f HorizontalRule = f $ HorizontalRule walk f (Table capt as ws hs rs) = f $ Table (walk f capt) as ws (walk f hs) (walk f rs) walk f (Div attr bs) = f $ Div attr (walk f bs) walk f Null = Null walkM f (Para xs) = Para <$> walkM f xs >>= f walkM f (Plain xs) = Plain <$> walkM f xs >>= f walkM f (CodeBlock attr s) = f $ CodeBlock attr s walkM f (RawBlock t s) = f $ RawBlock t s walkM f (BlockQuote bs) = BlockQuote <$> walkM f bs >>= f walkM f (OrderedList a cs) = OrderedList a <$> walkM f cs >>= f walkM f (BulletList cs) = BulletList <$> walkM f cs >>= f walkM f (DefinitionList xs) = DefinitionList <$> walkM f xs >>= f walkM f (Header lev attr xs) = Header lev attr <$> walkM f xs >>= f walkM f HorizontalRule = f $ HorizontalRule walkM f (Table capt as ws hs rs) = do capt' <- walkM f capt hs' <- walkM f hs rs' <- walkM f rs f $ Table capt' as ws hs' rs' walkM f (Div attr bs) = Div attr <$> walkM f bs >>= f walkM f Null = f Null query f (Para xs) = f (Para xs) <> query f xs query f (Plain xs) = f (Plain xs) <> query f xs query f (CodeBlock attr s) = f $ CodeBlock attr s query f (RawBlock t s) = f $ RawBlock t s query f (BlockQuote bs) = f (BlockQuote bs) <> query f bs query f (OrderedList a cs) = f (OrderedList a cs) <> query f cs query f (BulletList cs) = f (BulletList cs) <> query f cs query f (DefinitionList xs) = f (DefinitionList xs) <> query f xs query f (Header lev attr xs) = f (Header lev attr xs) <> query f xs query f HorizontalRule = f $ HorizontalRule query f (Table capt as ws hs rs) = f (Table capt as ws hs rs) <> query f capt <> query f hs <> query f rs query f (Div attr bs) = f (Div attr bs) <> query f bs query f Null = f Null instance Walkable Block Inline where walk f (Str xs) = Str xs walk f (Emph xs) = Emph (walk f xs) walk f (Strong xs) = Strong (walk f xs) walk f (Strikeout xs) = Strikeout (walk f xs) walk f (Subscript xs) = Subscript (walk f xs) walk f (Superscript xs)= Superscript (walk f xs) walk f (SmallCaps xs) = SmallCaps (walk f xs) walk f (Quoted qt xs) = Quoted qt (walk f xs) walk f (Cite cs xs) = Cite (walk f cs) (walk f xs) walk f (Code attr s) = Code attr s walk f Space = Space walk f SoftBreak = SoftBreak walk f LineBreak = LineBreak walk f (Math mt s) = Math mt s walk f (RawInline t s) = RawInline t s walk f (Link atr xs t) = Link atr (walk f xs) t walk f (Image atr xs t)= Image atr (walk f xs) t walk f (Note bs) = Note (walk f bs) walk f (Span attr xs) = Span attr (walk f xs) walkM f (Str xs) = return $ Str xs walkM f (Emph xs) = Emph <$> walkM f xs walkM f (Strong xs) = Strong <$> walkM f xs walkM f (Strikeout xs) = Strikeout <$> walkM f xs walkM f (Subscript xs) = Subscript <$> walkM f xs walkM f (Superscript xs)= Superscript <$> walkM f xs walkM f (SmallCaps xs) = SmallCaps <$> walkM f xs walkM f (Quoted qt xs) = Quoted qt <$> walkM f xs walkM f (Cite cs xs) = do cs' <- walkM f cs xs' <- walkM f xs return $ Cite cs' xs' walkM f (Code attr s) = return $ Code attr s walkM f Space = return $ Space walkM f SoftBreak = return $ SoftBreak walkM f LineBreak = return $ LineBreak walkM f (Math mt s) = return $ Math mt s walkM f (RawInline t s) = return $ RawInline t s walkM f (Link atr xs t) = (\lab -> Link atr lab t) <$> walkM f xs walkM f (Image atr xs t)= (\lab -> Image atr lab t) <$> walkM f xs walkM f (Note bs) = Note <$> walkM f bs walkM f (Span attr xs) = Span attr <$> walkM f xs query f (Str xs) = mempty query f (Emph xs) = query f xs query f (Strong xs) = query f xs query f (Strikeout xs) = query f xs query f (Subscript xs) = query f xs query f (Superscript xs)= query f xs query f (SmallCaps xs) = query f xs query f (Quoted qt xs) = query f xs query f (Cite cs xs) = query f cs <> query f xs query f (Code attr s) = mempty query f Space = mempty query f SoftBreak = mempty query f LineBreak = mempty query f (Math mt s) = mempty query f (RawInline t s) = mempty query f (Link atr xs t) = query f xs query f (Image atr xs t)= query f xs query f (Note bs) = query f bs query f (Span attr xs) = query f xs instance Walkable Block Pandoc where walk f (Pandoc m bs) = Pandoc (walk f m) (walk f bs) walkM f (Pandoc m bs) = do m' <- walkM f m bs' <- walkM f bs return $ Pandoc m' bs' query f (Pandoc m bs) = query f m <> query f bs instance Walkable Inline Pandoc where walk f (Pandoc m bs) = Pandoc (walk f m) (walk f bs) walkM f (Pandoc m bs) = do m' <- walkM f m bs' <- walkM f bs return $ Pandoc m' bs' query f (Pandoc m bs) = query f m <> query f bs instance Walkable Pandoc Pandoc where walk f = f walkM f = f query f = f instance Walkable Meta Meta where walk f = f walkM f = f query f = f instance Walkable Inline Meta where walk f (Meta metamap) = Meta $ walk f metamap walkM f (Meta metamap) = Meta <$> walkM f metamap query f (Meta metamap) = query f metamap instance Walkable Block Meta where walk f (Meta metamap) = Meta $ walk f metamap walkM f (Meta metamap) = Meta <$> walkM f metamap query f (Meta metamap) = query f metamap instance Walkable Inline MetaValue where walk f (MetaList xs) = MetaList $ walk f xs walk f (MetaBool b) = MetaBool b walk f (MetaString s) = MetaString s walk f (MetaInlines xs) = MetaInlines $ walk f xs walk f (MetaBlocks bs) = MetaBlocks $ walk f bs walk f (MetaMap m) = MetaMap $ walk f m walkM f (MetaList xs) = MetaList <$> walkM f xs walkM f (MetaBool b) = return $ MetaBool b walkM f (MetaString s) = return $ MetaString s walkM f (MetaInlines xs) = MetaInlines <$> walkM f xs walkM f (MetaBlocks bs) = MetaBlocks <$> walkM f bs walkM f (MetaMap m) = MetaMap <$> walkM f m query f (MetaList xs) = query f xs query f (MetaBool b) = mempty query f (MetaString s) = mempty query f (MetaInlines xs) = query f xs query f (MetaBlocks bs) = query f bs query f (MetaMap m) = query f m instance Walkable Block MetaValue where walk f (MetaList xs) = MetaList $ walk f xs walk f (MetaBool b) = MetaBool b walk f (MetaString s) = MetaString s walk f (MetaInlines xs) = MetaInlines $ walk f xs walk f (MetaBlocks bs) = MetaBlocks $ walk f bs walk f (MetaMap m) = MetaMap $ walk f m walkM f (MetaList xs) = MetaList <$> walkM f xs walkM f (MetaBool b) = return $ MetaBool b walkM f (MetaString s) = return $ MetaString s walkM f (MetaInlines xs) = MetaInlines <$> walkM f xs walkM f (MetaBlocks bs) = MetaBlocks <$> walkM f bs walkM f (MetaMap m) = MetaMap <$> walkM f m query f (MetaList xs) = query f xs query f (MetaBool b) = mempty query f (MetaString s) = mempty query f (MetaInlines xs) = query f xs query f (MetaBlocks bs) = query f bs query f (MetaMap m) = query f m instance Walkable Inline Citation where walk f (Citation id' pref suff mode notenum hash) = Citation id' (walk f pref) (walk f suff) mode notenum hash walkM f (Citation id' pref suff mode notenum hash) = do pref' <- walkM f pref suff' <- walkM f suff return $ Citation id' pref' suff' mode notenum hash query f (Citation id' pref suff mode notenum hash) = query f pref <> query f suff instance Walkable Block Citation where walk f (Citation id' pref suff mode notenum hash) = Citation id' (walk f pref) (walk f suff) mode notenum hash walkM f (Citation id' pref suff mode notenum hash) = do pref' <- walkM f pref suff' <- walkM f suff return $ Citation id' pref' suff' mode notenum hash query f (Citation id' pref suff mode notenum hash) = query f pref <> query f suff