1{-# LANGUAGE CPP #-}
2{-
3Copyright (c) 2006-2019, John MacFarlane
4
5All rights reserved.
6
7Redistribution and use in source and binary forms, with or without
8modification, are permitted provided that the following conditions are met:
9
10    * Redistributions of source code must retain the above copyright
11      notice, this list of conditions and the following disclaimer.
12
13    * Redistributions in binary form must reproduce the above
14      copyright notice, this list of conditions and the following
15      disclaimer in the documentation and/or other materials provided
16      with the distribution.
17
18    * Neither the name of John MacFarlane nor the names of other
19      contributors may be used to endorse or promote products derived
20      from this software without specific prior written permission.
21
22THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
25A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
26OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
27SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
28LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
29DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
30THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
31(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
32OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
33-}
34
35{- |
36   Module      : Text.Pandoc.Generic
37   Copyright   : Copyright (C) 2006-2019 John MacFarlane
38   License     : BSD3
39
40   Maintainer  : John MacFarlane <jgm@berkeley.edu>
41   Stability   : alpha
42   Portability : portable
43
44Generic functions for manipulating 'Pandoc' documents.
45(Note:  the functions defined in @Text.Pandoc.Walk@ should be used instead,
46when possible, as they are much faster.)
47
48Here's a simple example, defining a function that replaces all the level 3+
49headers in a document with regular paragraphs in ALL CAPS:
50
51> import Text.Pandoc.Definition
52> import Text.Pandoc.Generic
53> import Data.Char (toUpper)
54>
55> modHeader :: Block -> Block
56> modHeader (Header n _ xs) | n >= 3 = Para $ bottomUp allCaps xs
57> modHeader x = x
58>
59> allCaps :: Inline -> Inline
60> allCaps (Str xs) = Str $ map toUpper xs
61> allCaps x = x
62>
63> changeHeaders :: Pandoc -> Pandoc
64> changeHeaders = bottomUp modHeader
65
66'bottomUp' is so called because it traverses the @Pandoc@ structure from
67bottom up. 'topDown' goes the other way. The difference between them can be
68seen from this example:
69
70> normal :: [Inline] -> [Inline]
71> normal (Space : Space : xs) = Space : xs
72> normal (Emph xs : Emph ys : zs) = Emph (xs ++ ys) : zs
73> normal xs = xs
74>
75> myDoc :: Pandoc
76> myDoc =  Pandoc nullMeta
77>  [ Para [Str "Hi",Space,Emph [Str "world",Space],Emph [Space,Str "emphasized"]]]
78
79Here we want to use 'topDown' to lift @normal@ to @Pandoc -> Pandoc@.
80The top down strategy will collapse the two adjacent @Emph@s first, then
81collapse the resulting adjacent @Space@s, as desired. If we used 'bottomUp',
82we would end up with two adjacent @Space@s, since the contents of the
83two @Emph@ inlines would be processed before the @Emph@s were collapsed
84into one.
85
86> topDown normal myDoc ==
87>   Pandoc nullMeta
88>    [Para [Str "Hi",Space,Emph [Str "world",Space,Str "emphasized"]]]
89>
90> bottomUp normal myDoc ==
91>   Pandoc nullMeta
92>    [Para [Str "Hi",Space,Emph [Str "world",Space,Space,Str "emphasized"]]]
93
94'bottomUpM' is a monadic version of 'bottomUp'.  It could be used,
95for example, to replace the contents of delimited code blocks with
96attribute @include=FILENAME@ with the contents of @FILENAME@:
97
98> doInclude :: Block -> IO Block
99> doInclude cb@(CodeBlock (id, classes, namevals) contents) =
100>   case lookup "include" namevals of
101>        Just f  -> return . (CodeBlock (id, classes, namevals)) =<< readFile f
102>        Nothing -> return cb
103> doInclude x = return x
104>
105> processIncludes :: Pandoc -> IO Pandoc
106> processIncludes = bottomUpM doInclude
107
108'queryWith' can be used, for example, to compile a list of URLs
109linked to in a document:
110
111> extractURL :: Inline -> [String]
112> extractURL (Link _ (u,_)) = [u]
113> extractURL (Image _ _ (u,_)) = [u]
114> extractURL _ = []
115>
116> extractURLs :: Pandoc -> [String]
117> extractURLs = queryWith extractURL
118
119-}
120module Text.Pandoc.Generic where
121
122import Data.Generics
123
124-- | Applies a transformation on @a@s to matching elements in a @b@,
125-- moving from the bottom of the structure up.
126bottomUp :: (Data a, Data b) => (a -> a) -> b -> b
127bottomUp f = everywhere (mkT f)
128
129-- | Applies a transformation on @a@s to matching elements in a @b@,
130-- moving from the top of the structure down.
131topDown :: (Data a, Data b) => (a -> a) -> b -> b
132topDown f = everywhere' (mkT f)
133
134-- | Like 'bottomUp', but with monadic transformations.
135bottomUpM :: (Monad m, Data a, Data b) => (a -> m a) -> b -> m b
136bottomUpM f = everywhereM (mkM f)
137
138-- | Runs a query on matching @a@ elements in a @c@.  The results
139-- of the queries are combined using 'mappend'.
140queryWith :: (Data a, Monoid b, Data c) => (a -> b) -> c -> b
141queryWith f = everything mappend (mempty `mkQ` f)
142