pandoc-types 1.10 → 1.12
raw patch · 6 files changed
+754/−88 lines, 6 filesdep +aesondep +bytestringdep ~basedep ~syb
Dependencies added: aeson, bytestring
Dependency ranges changed: base, syb
Files
- Text/Pandoc/Builder.hs +71/−30
- Text/Pandoc/Definition.hs +158/−29
- Text/Pandoc/Generic.hs +7/−16
- Text/Pandoc/JSON.hs +105/−0
- Text/Pandoc/Walk.hs +394/−0
- pandoc-types.cabal +19/−13
Text/Pandoc/Builder.hs view
@@ -1,8 +1,6 @@ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses,- DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP, StandaloneDeriving #-}-#ifdef GENERICS-{-# LANGUAGE DeriveGeneric #-}-#endif+ DeriveDataTypeable, GeneralizedNewtypeDeriving, CPP, StandaloneDeriving,+ DeriveGeneric #-} {- Copyright (C) 2010-2012 John MacFarlane <jgm@berkeley.edu> @@ -32,9 +30,8 @@ Convenience functions for building pandoc documents programmatically. -Example of use:+Example of use (with @OverloadedStrings@ pragma): -> {-# LANGUAGE OverloadedStrings #-} > import Text.Pandoc.Builder > > myDoc :: Pandoc@@ -49,18 +46,19 @@ Isn't that nicer than writing the following? > import Text.Pandoc.Definition+> import Data.Map (fromList) > > myDoc :: Pandoc-> myDoc = Pandoc (Meta {docTitle = [Str "My",Space,Str "title"]-> , docAuthors = []-> , docDate = []})-> [Para [Str "This",Space,Str "is",Space,Str "the",Space,Str "first",-> Space,Str "paragraph"]-> ,Para [Str "And",Space,Emph [Str "another"],Str "."]-> ,BulletList [[Para [Str "item",Space,Str "one"]-> ,Para [Str "continuation"]]-> ,[Plain [Str "item",Space,Str "two",Space,Str "and", Space,-> Str "a",Space,Link [Str "link"] ("/url","go to url")]]]]+> 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 [Str "link"] ("/url","go to url")]]]] And of course, you can use Haskell to define your own builders: @@ -97,9 +95,10 @@ , toList , fromList , isNull- -- , Listable(..) -- * Document builders , doc+ , ToMetaValue(..)+ , HasMeta(..) , setTitle , setAuthors , setDate@@ -125,6 +124,7 @@ , link , image , note+ , spanWith , trimInlines -- * Block list builders , para@@ -142,12 +142,14 @@ , 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)@@ -157,9 +159,7 @@ import Data.Typeable import Data.Traversable import Control.Arrow ((***))-#ifdef GENERICS import GHC.Generics (Generic)-#endif #if MIN_VERSION_base(4,5,0) -- (<>) is defined in Data.Monoid@@ -175,9 +175,7 @@ newtype Many a = Many { unMany :: Seq a } deriving (Data, Ord, Eq, Typeable, Foldable, Traversable, Functor, Show, Read) -#ifdef GENERICS deriving instance Generic (Many a)-#endif toList :: Many a -> [a] toList = F.toList@@ -233,16 +231,51 @@ -- Document builders doc :: Blocks -> Pandoc-doc = Pandoc (Meta [] [] []) . toList+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 t (Pandoc m bs) = Pandoc m{ docTitle = toList t } bs+setTitle = setMeta "title" setAuthors :: [Inlines] -> Pandoc -> Pandoc-setAuthors as (Pandoc m bs) = Pandoc m{ docAuthors = map toList as } bs+setAuthors = setMeta "author" setDate :: Inlines -> Pandoc -> Pandoc-setDate d (Pandoc m bs) = Pandoc m{ docDate = toList d } bs+setDate = setMeta "date" -- Inline list builders @@ -315,8 +348,8 @@ displayMath :: String -> Inlines displayMath = singleton . Math DisplayMath -rawInline :: Format -> String -> Inlines-rawInline format = singleton . RawInline format+rawInline :: String -> String -> Inlines+rawInline format = singleton . RawInline (Format format) link :: String -- ^ URL -> String -- ^ Title@@ -333,13 +366,18 @@ 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 = singleton . Plain . toList+plain ils = if isNull ils+ then mempty+ else singleton . Plain . toList $ ils -- | A code block with attributes. codeBlockWith :: Attr -> String -> Blocks@@ -349,8 +387,8 @@ codeBlock :: String -> Blocks codeBlock = codeBlockWith nullAttr -rawBlock :: Format -> String -> Blocks-rawBlock format = singleton . RawBlock format+rawBlock :: String -> String -> Blocks+rawBlock format = singleton . RawBlock (Format format) blockQuote :: Blocks -> Blocks blockQuote = singleton . BlockQuote . toList@@ -396,6 +434,9 @@ -> 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
Text/Pandoc/Definition.hs view
@@ -1,11 +1,7 @@-{-# LANGUAGE CPP, DeriveDataTypeable #-}--#ifdef GENERICS-{-# LANGUAGE DeriveGeneric #-}-#endif+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-} {--Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>+Copyright (C) 2006-2013 John MacFarlane <jgm@berkeley.edu> This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by@@ -34,31 +30,111 @@ Definition of 'Pandoc' data structure for format-neutral representation of documents. -}-module Text.Pandoc.Definition where+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(..)+ ) where import Data.Generics (Data, Typeable) import Data.Ord (comparing)--#ifdef GENERICS+import Data.Aeson (FromJSON(..), ToJSON(..))+import Control.Monad (guard)+import qualified Data.Map as M import GHC.Generics (Generic)-#define GENERIC , Generic-#else-#define GENERIC-#endif+import Data.String+import Data.Char (toLower)+import Data.Monoid -data Pandoc = Pandoc Meta [Block] deriving (Eq, Ord, Read, Show, Typeable, Data GENERIC)+data Pandoc = Pandoc Meta [Block]+ deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) --- | Bibliographic information for the document: title, authors, date.-data Meta = Meta { docTitle :: [Inline]- , docAuthors :: [[Inline]]- , docDate :: [Inline] }- deriving (Eq, Ord, Show, Read, Typeable, Data GENERIC)+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 (MetaInlines ils) -> ils+ Just (MetaBlocks [Plain ils]) -> ils+ _ -> []++-- | Extract document authors from metadata; works just like the old+-- @docAuthors@.+docAuthors :: Meta -> [[Inline]]+docAuthors meta =+ case lookupMeta "author" meta of+ Just (MetaInlines ils) -> [ils]+ Just (MetaList ms) -> [ils | MetaInlines ils <- ms] +++ [ils | MetaBlocks [Plain ils] <- ms]+ _ -> []++-- | Extract date from metadata; works just like the old @docDate@.+docDate :: Meta -> [Inline]+docDate meta =+ case lookupMeta "date" meta of+ Just (MetaInlines ils) -> ils+ Just (MetaBlocks [Plain ils]) -> ils+ _ -> []+ -- | Alignment of a table column. data Alignment = AlignLeft | AlignRight | AlignCenter- | AlignDefault deriving (Eq, Ord, Show, Read, Typeable, Data GENERIC)+ | AlignDefault deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | List attributes. type ListAttributes = (Int, ListNumberStyle, ListNumberDelim)@@ -70,13 +146,13 @@ | LowerRoman | UpperRoman | LowerAlpha- | UpperAlpha deriving (Eq, Ord, Show, Read, Typeable, Data GENERIC)+ | 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)+ | TwoParens deriving (Eq, Ord, Show, Read, Typeable, Data, Generic) -- | Attributes: identifier, classes, key-value pairs type Attr = (String, [String], [(String, String)])@@ -88,8 +164,18 @@ type TableCell = [Block] -- | Formats for raw blocks-type Format = String+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@@ -112,17 +198,18 @@ -- 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)+ 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)+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)+data MathType = DisplayMath | InlineMath deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) -- | Inline elements. data Inline@@ -143,7 +230,8 @@ | Link [Inline] Target -- ^ Hyperlink: text (list of inlines), target | Image [Inline] Target -- ^ Image: alt text (list of inlines), target | Note [Block] -- ^ Footnote or endnote- deriving (Show, Eq, Ord, Read, Typeable, Data GENERIC)+ | Span Attr [Inline] -- ^ Generic inline container with attributes+ deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) data Citation = Citation { citationId :: String , citationPrefix :: [Inline]@@ -152,10 +240,51 @@ , citationNoteNum :: Int , citationHash :: Int }- deriving (Show, Eq, Read, Typeable, Data GENERIC)+ 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)+ deriving (Show, Eq, Ord, Read, Typeable, Data, Generic)++-- derive generic instances of FromJSON, ToJSON:++instance FromJSON MetaValue+instance ToJSON MetaValue++instance FromJSON Meta+instance ToJSON Meta++instance FromJSON CitationMode+instance ToJSON CitationMode++instance FromJSON Citation+instance ToJSON Citation++instance FromJSON QuoteType+instance ToJSON QuoteType++instance FromJSON MathType+instance ToJSON MathType++instance FromJSON ListNumberStyle+instance ToJSON ListNumberStyle++instance FromJSON ListNumberDelim+instance ToJSON ListNumberDelim++instance FromJSON Alignment+instance ToJSON Alignment++instance FromJSON Format+instance ToJSON Format++instance FromJSON Inline+instance ToJSON Inline++instance FromJSON Block+instance ToJSON Block++instance FromJSON Pandoc+instance ToJSON Pandoc
Text/Pandoc/Generic.hs view
@@ -26,6 +26,8 @@ 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:@@ -35,7 +37,7 @@ > import Data.Char (toUpper) > > modHeader :: Block -> Block-> modHeader (Header n xs) | n >= 3 = Para $ bottomUp allCaps xs+> modHeader (Header n _ xs) | n >= 3 = Para $ bottomUp allCaps xs > modHeader x = x > > allCaps :: Inline -> Inline@@ -55,8 +57,8 @@ > normal xs = xs > > myDoc :: Pandoc-> myDoc = Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []})-> [Para [Str "Hi",Space,Emph [Str "world",Space],Emph [Space,Str "emphasized"]]]+> 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@@ -66,11 +68,11 @@ into one. > topDown normal myDoc ==-> Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []})+> Pandoc nullMeta > [Para [Str "Hi",Space,Emph [Str "world",Space,Str "emphasized"]]] > > bottomUp normal myDoc ==-> Pandoc (Meta {docTitle = [], docAuthors = [], docDate = []})+> Pandoc nullMeta > [Para [Str "Hi",Space,Emph [Str "world",Space,Space,Str "emphasized"]]] 'bottomUpM' is a monadic version of 'bottomUp'. It could be used,@@ -122,14 +124,3 @@ -- of the queries are combined using 'mappend'. queryWith :: (Data a, Monoid b, Data c) => (a -> b) -> c -> b queryWith f = everything mappend (mempty `mkQ` f)--{-# DEPRECATED processWith "Use bottomUp instead" #-}--- | Deprecated synonym for @bottomUp@.-processWith :: (Data a, Data b) => (a -> a) -> b -> b-processWith = bottomUp--{-# DEPRECATED processWithM "Use bottomUpM instead" #-}--- | Deprecated synonym for @bottomUpM@.-processWithM :: (Monad m, Data a, Data b) => (a -> m a) -> b -> m b-processWithM = bottomUpM-
+ Text/Pandoc/JSON.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}+{-+Copyright (C) 2013 John MacFarlane <jgm@berkeley.edu>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : Text.Pandoc.JSON+ Copyright : Copyright (C) 2013 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable++Functions for serializing the Pandoc AST to JSON and deserializing from JSON.++Example of use: The following script (@capitalize.hs@) reads+reads a JSON representation of a Pandoc document from stdin,+and writes a JSON representation of a Pandoc document to stdout.+It changes all regular text in the document to uppercase, without+affecting URLs, code, tags, etc. Run the script with++> pandoc -t json | runghc capitalize.hs | pandoc -f json++or (making capitalize.hs executable)++> pandoc --filter ./capitalize.hs++> #!/usr/bin/env runghc+> import Text.Pandoc.JSON+> import Data.Char (toUpper)+>+> main :: IO ()+> main = toJSONFilter capitalizeStrings+>+> capitalizeStrings :: Inline -> Inline+> capitalizeStrings (Str s) = Str $ map toUpper s+> capitalizeStrings x = x++-}++module Text.Pandoc.JSON ( module Text.Pandoc.Definition+ , ToJSONFilter(..)+ )+where+import Text.Pandoc.Definition+import Text.Pandoc.Walk+import 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 (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
+ Text/Pandoc/Walk.hs view
@@ -0,0 +1,394 @@+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables,+ OverlappingInstances #-}+{-+Copyright (C) 2013 John MacFarlane <jgm@berkeley.edu>++This program is free software; you can redistribute it and/or modify+it under the terms of the GNU General Public License as published by+the Free Software Foundation; either version 2 of the License, or+(at your option) any later version.++This program is distributed in the hope that it will be useful,+but WITHOUT ANY WARRANTY; without even the implied warranty of+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+GNU General Public License for more details.++You should have received a copy of the GNU General Public License+along with this program; if not, write to the Free Software+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA+-}++{- |+ Module : Text.Pandoc.Walk+ Copyright : Copyright (C) 2013 John MacFarlane+ License : GNU GPL, version 2 or above++ Maintainer : John MacFarlane <jgm@berkeley.edu>+ Stability : alpha+ Portability : portable++Functions for manipulating 'Pandoc' documents or extracting+information from them by walking the 'Pandoc' structure (or+intermediate structures like '[Block]' or '[Inline]'.+These are faster (by a factor of four or five) than the generic+functions defined in @Text.Pandoc.Generic@.++Here's a simple example, defining a function that replaces all the level 3++headers in a document with regular paragraphs in ALL CAPS:++> import Text.Pandoc.Definition+> import Text.Pandoc.Walk+> import Data.Char (toUpper)+>+> modHeader :: Block -> Block+> modHeader (Header n _ xs) | n >= 3 = Para $ walk allCaps xs+> modHeader x = x+>+> allCaps :: Inline -> Inline+> allCaps (Str xs) = Str $ map toUpper xs+> allCaps x = x+>+> changeHeaders :: Pandoc -> Pandoc+> changeHeaders = walk modHeader++'query' can be used, for example, to compile a list of URLs+linked to in a document:++> extractURL :: Inline -> [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 (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 cs (walk f xs)+ walk f (Code attr s) = f $ Code attr s+ walk f Space = f Space+ 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 xs t) = f $ Link (walk f xs) t+ walk f (Image xs t) = f $ Image (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) = Cite cs <$> walkM f xs >>= f+ walkM f (Code attr s) = f $ Code attr s+ walkM f Space = f Space+ 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 xs t) = Link <$> walkM f xs >>= f . ($ t)+ walkM f (Image xs t) = Image <$> walkM f xs >>= f . ($ t)+ walkM f (Note bs) = Note <$> walkM f bs+ 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 xs+ query f (Code attr s) = f (Code attr s)+ query f Space = f Space+ 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 xs t) = f (Link xs t) <> query f xs+ query f (Image xs t) = f (Image 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 cs (walk f xs)+ walk f (Code attr s) = Code attr s+ walk f Space = Space+ walk f LineBreak = LineBreak+ walk f (Math mt s) = Math mt s+ walk f (RawInline t s) = RawInline t s+ walk f (Link xs t) = Link (walk f xs) t+ walk f (Image xs t) = Image (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) = Cite cs <$> walkM f xs+ walkM f (Code attr s) = return $ Code attr s+ walkM f Space = return $ Space+ 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 xs t) = (\lab -> Link lab t) <$> walkM f xs+ walkM f (Image xs t) = (\lab -> Image 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 xs+ query f (Code attr s) = mempty+ query f Space = mempty+ query f LineBreak = mempty+ query f (Math mt s) = mempty+ query f (RawInline t s) = mempty+ query f (Link xs t) = query f xs+ query f (Image 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 a b => Walkable a [b] where+ walk f xs = map (walk f) xs+ walkM f xs = mapM (walkM f) xs+ query f xs = mconcat $ map (query f) xs
pandoc-types.cabal view
@@ -1,11 +1,11 @@ Name: pandoc-types-Version: 1.10+Version: 1.12 Synopsis: Types for representing a structured document-Description: This package contains definitions for the 'Pandoc' data+Description: @Text.Pandoc.Definition@ defines the 'Pandoc' data structure, which is used by pandoc to represent- structured documents. These definitions used to live- in the pandoc package, but starting with pandoc 1.7, they- have been split off, so that other packages can use them+ structured documents. This module used to live+ in the pandoc package, but starting with pandoc 1.7, it+ has been split off, so that other packages can use it without drawing in all of pandoc's dependencies, and pandoc itself can depend on packages (like citeproc-hs) that use them.@@ -15,6 +15,12 @@ . @Text.Pandoc.Generic@ provides generic functions for manipulating Pandoc documents.+ .+ @Text.Pandoc.Walk@ provides faster, nongeneric functions+ for manipulating Pandoc documents.+ .+ @Text.Pandoc.JSON@ provides functions for serializing+ and deserializing a @Pandoc@ structure to and from JSON. Homepage: http://johnmacfarlane.net/pandoc License: GPL@@ -32,12 +38,12 @@ Library Exposed-modules: Text.Pandoc.Definition Text.Pandoc.Generic+ Text.Pandoc.Walk Text.Pandoc.Builder- if impl(ghc >= 6.10)- Build-depends: base >= 4 && < 5, syb, containers >= 0.3- else- Build-depends: base >= 3 && < 4, containers >= 0.3-- if impl(ghc >= 7.2.1)- cpp-options: -DGENERICS- build-depends: ghc-prim >= 0.2+ Text.Pandoc.JSON+ Build-depends: base >= 4 && < 5,+ containers >= 0.3,+ syb >= 0.1 && < 0.5,+ ghc-prim >= 0.2,+ bytestring >= 0.9 && < 0.11,+ aeson >= 0.6 && < 0.7