diff --git a/COPYING b/COPYING new file mode 100644 --- /dev/null +++ b/COPYING @@ -0,0 +1,340 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc. + 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Library General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Library General +Public License instead of this License. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Text/Pandoc/Builder.hs b/Text/Pandoc/Builder.hs new file mode 100644 --- /dev/null +++ b/Text/Pandoc/Builder.hs @@ -0,0 +1,500 @@ +{-# 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 [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 + , numRef + , codeWith + , code + , space + , linebreak + , math + , displayMath + , displayMathWith + , rawInline + , link + , image + , imageWith + , note + , spanWith + , trimInlines + -- * Block list builders + , para + , plain + , codeBlockWith + , codeBlock + , rawBlock + , blockQuote + , bulletList + , orderedListWith + , orderedList + , definitionList + , header + , headerWith + , horizontalRule + , table + , simpleTable + , imageGrid + , figure + , statement + , proof + , 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 + (Str t1, Str t2) -> xs' |> Str (t1 <> t2) + (Emph i1, Emph i2) -> xs' |> Emph (i1 <> i2) + (Strong i1, Strong i2) -> xs' |> Strong (i1 <> i2) + (Subscript i1, Subscript i2) -> xs' |> Subscript (i1 <> i2) + (Superscript i1, Superscript i2) -> xs' |> Superscript (i1 <> i2) + (Strikeout i1, Strikeout i2) -> xs' |> Strikeout (i1 <> i2) + (Space, LineBreak) -> xs' |> LineBreak + _ -> xs' |> x |> y + +instance IsString Inlines where + fromString = text + +-- | Trim leading and trailing Sp (spaces) from an Inlines. +trimInlines :: Inlines -> Inlines +#if MIN_VERSION_containers(0,4,0) +trimInlines (Many ils) = Many $ Seq.dropWhileL (== Space) $ + Seq.dropWhileR (== Space) $ ils +#else +-- for GHC 6.12, we need to workaround a bug in dropWhileR +-- see http://hackage.haskell.org/trac/ghc/ticket/4157 +trimInlines (Many ils) = Many $ Seq.dropWhileL (== Space) $ + Seq.reverse $ Seq.dropWhileL (== Space) $ + Seq.reverse ils +#endif + +-- Document builders + +doc :: Blocks -> Pandoc +doc = Pandoc 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. +-- If you want a 'Str' with literal spaces, use 'str'. +text :: String -> Inlines +text = fromList . map conv . breakBySpaces + where breakBySpaces = groupBy sameCategory + sameCategory x y = (is_space x && is_space y) || + (not $ is_space x || is_space y) + conv xs | all is_space xs = Space + conv xs = Str xs + is_space ' ' = True + is_space '\n' = True + is_space '\t' = True + is_space _ = False + +str :: String -> Inlines +str = singleton . Str + +emph :: Inlines -> Inlines +emph = singleton . Emph . toList + +strong :: Inlines -> Inlines +strong = singleton . Strong . toList + +strikeout :: Inlines -> Inlines +strikeout = singleton . Strikeout . toList + +superscript :: Inlines -> Inlines +superscript = singleton . Superscript . toList + +subscript :: Inlines -> Inlines +subscript = singleton . Subscript . toList + +smallcaps :: Inlines -> Inlines +smallcaps = singleton . SmallCaps . toList + +singleQuoted :: Inlines -> Inlines +singleQuoted = quoted SingleQuote + +doubleQuoted :: Inlines -> Inlines +doubleQuoted = quoted DoubleQuote + +quoted :: QuoteType -> Inlines -> Inlines +quoted qt = singleton . Quoted qt . toList + +cite :: [Citation] -> Inlines -> Inlines +cite cts = singleton . Cite cts . toList + +numRef :: NumberedReference -> String -> Inlines +numRef refspec = singleton . NumRef refspec + +-- | Inline code with attributes. +codeWith :: Attr -> String -> Inlines +codeWith attrs = singleton . Code attrs + +-- | Plain inline code. +code :: String -> Inlines +code = codeWith nullAttr + +space :: Inlines +space = singleton Space + +linebreak :: Inlines +linebreak = singleton LineBreak + +-- | Inline math +math :: String -> Inlines +math = singleton . Math InlineMath + +-- | Display math with attributes +displayMathWith :: Attr -> String -> Inlines +displayMathWith attrs = singleton . Math (DisplayMath attrs) + +-- | Display math +displayMath :: String -> Inlines +displayMath = displayMathWith nullAttr + +rawInline :: String -> String -> Inlines +rawInline format = singleton . RawInline (Format format) + +link :: String -- ^ URL + -> String -- ^ Title + -> Inlines -- ^ Label + -> Inlines +link url title x = singleton $ Link (toList x) (url, title) + +image :: String -- ^ URL + -> String -- ^ Title + -> Inlines -- ^ Alt text + -> Inlines +image url title x = singleton $ Image nullAttr (toList x) (url, title) + +-- | Image element with additional attributes +imageWith :: Attr + -> 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) + +-- | A column of rows of images, forming a grid (used for figures) +imageGrid :: [Inlines] -> Blocks +imageGrid = singleton . ImageGrid . map toList + +-- | Generic figure builder for all figure types +figure :: FigureType + -> Attr + -> PreparedContent + -> Blocks -- ^ Float content (intrepreted according to FigureType) + -> Inlines -- ^ Caption + -> Blocks +figure figureType attr prepared content caption = + singleton $ Figure figureType attr (toList content) prepared (toList caption) + +-- | Statements (theorem, lemma, definiton, example, etc) +statement :: String + -> StatementStyle -- ^ Style (Theorem, Standard, Remark, Other) + -> (Inlines, String) -- ^ Label (with raw string) + -> String -- ^ Counter name + -> Int -- ^ Hierarchial level (1-6) + -> String -- ^ Default numerical label + -> Inlines -- ^ Caption + -> Blocks -- ^ Text + -> Blocks +statement ident style (lab, rawlab) cntr hlevel numlab capt text = + singleton $ Statement + (StatementAttr ident style (toList lab, rawlab) cntr hlevel numlab (toList capt)) + (toList text) + +proof :: Inlines -- ^ Replacement title + -> Blocks -- ^ Text + -> Blocks +proof altTile text = + singleton $ Proof (toList altTile) (toList text) + +divWith :: Attr -> Blocks -> Blocks +divWith attr = singleton . Div attr . toList + +mapConst :: Functor f => b -> f a -> f b +mapConst = fmap . const + diff --git a/Text/Pandoc/Definition.hs b/Text/Pandoc/Definition.hs new file mode 100644 --- /dev/null +++ b/Text/Pandoc/Definition.hs @@ -0,0 +1,463 @@ +{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, FlexibleContexts #-} + +{- +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(..) + , FigureType(..) + , PreparedContent(..) + , noPrepContent + , StatementAttr(..) + , StatementStyle(..) + , Citation(..) + , CitationMode(..) + , NumberedReference(..) + , NumberedReferenceStyle(..) + ) 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 +import Control.DeepSeq.Generics + +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) + | Figure FigureType Attr [Block] PreparedContent [Inline] -- ^ A floating figure, + -- containing for example images, tables, + -- highlighted code, pseudocode, etc. Differentiated + -- by FigureType. Has attribures, list of float + -- content (typically just 1), a FloatFallback for + -- "pre-compiled" float content,and a caption (inlines) + -- for the whole figure. + | ImageGrid [[Inline]] -- ^ ImageGrid, containing rows of images, intended + -- to be used primarily in Floats. In this context, + -- alt texts will be treated as captions for each + -- individual image. + | Statement StatementAttr [Block] -- ^ Standalone statements, can be + -- sequentially numbered and cross-referenced, and + -- optinally may have a Proof block inside its body. + | Proof [Inline] [Block] -- ^ Proofs (AMS-style), with an optional + -- alternate title, and proof text + | Div Attr [Block] -- ^ Generic block container with attributes + | Null -- ^ Nothing + deriving (Eq, Ord, Read, Show, Typeable, Data, Generic) + +-- | Type of figure, mainly used to differentiate content (i.e., images vs tables). +-- ImageFigure contains a ImageGrid. TableFigure contains one or more Tables. +-- LineBlockFigure contains one or more Paras (intended for algorithms and poetry). +-- ListingFigure contains one or more CodeBlocks. +data FigureType = ImageFigure | TableFigure | LineBlockFigure | ListingFigure + deriving (Show, Eq, Ord, Read, 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 Attr | InlineMath deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + +-- | Pre-rendered figure content intended to archive final, professionally typeset or drawn +-- figures from content already described in markdown format (an image and/or latex code) +data PreparedContent = PreparedContent { preparedImageContent :: Inline -- Image + , preparedLaTeXContent :: String + } + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + +noPrepContent :: PreparedContent +noPrepContent = PreparedContent Space "" + +-- | Statement Attributes: identifier, label (inlines with raw), name of counter, hiearchy level, pre-computed numerical label, caption, +data StatementAttr = StatementAttr { statementId :: String + , statementStyle :: StatementStyle + , statementLabel :: ([Inline], String) + , statementCounter :: String + , statementLevel :: Int + , statementNum :: String + , statementCaption :: [Inline] + } + deriving (Show, Eq, Read, Typeable, Data, Generic) + +instance Ord StatementAttr where + compare = comparing statementId + +-- | Type of statement, rought equivalent to @amsthm@ plain, defninition, and remark +data StatementStyle = Theorem | Standard | Remark | Other String + 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) + | NumRef NumberedReference String -- ^ Reference (literal) + | Code Attr String -- ^ Inline code (literal) + | Space -- ^ Inter-word space + | LineBreak -- ^ Hard line break + | Math MathType String -- ^ TeX math (literal) + | RawInline Format String -- ^ Raw inline + | Link [Inline] Target -- ^ Hyperlink: text (list of inlines), target + | Image 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) + +data NumberedReference = NumberedReference { numRefId :: String + , numRefStyle :: NumberedReferenceStyle + , numRefLabel :: [Inline] + } + deriving (Show, Eq, Read, Typeable, Data, Generic) + +instance Ord NumberedReference where + compare = comparing numRefId + +data NumberedReferenceStyle = PlainNumRef | ParenthesesNumRef + deriving (Show, Eq, Ord, Read, Typeable, Data, Generic) + +-- derive generic instances of FromJSON, ToJSON: + +jsonOpts :: Aeson.Options +jsonOpts = Aeson.Options{ 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 NumberedReferenceStyle + where parseJSON = parseJSON' +instance ToJSON NumberedReferenceStyle + where toJSON = toJSON' + +instance FromJSON NumberedReference + where parseJSON = parseJSON' +instance ToJSON NumberedReference + where toJSON = toJSON' + +instance FromJSON FigureType + where parseJSON = parseJSON' +instance ToJSON FigureType + where toJSON = toJSON' + +instance FromJSON PreparedContent + where parseJSON = parseJSON' +instance ToJSON PreparedContent + where toJSON = toJSON' + +instance FromJSON StatementAttr + where parseJSON = parseJSON' +instance ToJSON StatementAttr + where toJSON = toJSON' + +instance FromJSON StatementStyle + where parseJSON = parseJSON' +instance ToJSON StatementStyle + 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 +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 FigureType where rnf = genericRnf +instance NFData MathType where rnf = genericRnf +instance NFData PreparedContent where rnf = genericRnf +instance NFData StatementAttr where rnf = genericRnf +instance NFData StatementStyle where rnf = genericRnf +instance NFData Format where rnf = genericRnf +instance NFData CitationMode where rnf = genericRnf +instance NFData NumberedReference where rnf = genericRnf +instance NFData NumberedReferenceStyle 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 diff --git a/Text/Pandoc/Generic.hs b/Text/Pandoc/Generic.hs new file mode 100644 --- /dev/null +++ b/Text/Pandoc/Generic.hs @@ -0,0 +1,126 @@ +{- +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) diff --git a/Text/Pandoc/JSON.hs b/Text/Pandoc/JSON.hs new file mode 100644 --- /dev/null +++ b/Text/Pandoc/JSON.hs @@ -0,0 +1,117 @@ +{-# 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 diff --git a/Text/Pandoc/Walk.hs b/Text/Pandoc/Walk.hs new file mode 100644 --- /dev/null +++ b/Text/Pandoc/Walk.hs @@ -0,0 +1,481 @@ +{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, ScopedTypeVariables, + OverlappingInstances #-} +{- +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 (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 (NumRef r s) = f $ NumRef r s + 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 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 (NumRef r s) = f $ NumRef r s + 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 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 (NumRef r s) = f (NumRef r s) + 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 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 (Figure ft attr cs (PreparedContent im lt) capt) = + Figure ft attr (walk f cs) (PreparedContent (walk f im) lt) (walk f capt) + walk f (ImageGrid xs) = ImageGrid $ walk f xs + walk f (Statement (StatementAttr i sty (lb, lbr) ct lv n cp) bs) = + Statement (StatementAttr i sty (walk f lb, lbr) ct lv n (walk f cp)) (walk f bs) + walk f (Proof cpt cs) = Proof (walk f cpt) (walk f cs) + 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 (Figure ft attr cs (PreparedContent im lt) capt) = do + cs' <- walkM f cs + im' <- walkM f im + capt' <- walkM f capt + return $ Figure ft attr cs' + (PreparedContent im' lt) capt' + walkM f (ImageGrid xs) = ImageGrid <$> walkM f xs + walkM f (Statement (StatementAttr i sty (lb, lbr) ct lv n cp) bs) = do + lb' <- walkM f lb + cp' <- walkM f cp + bs' <- walkM f bs + return $ Statement + (StatementAttr i sty (lb', lbr) + ct lv n cp') bs' + walkM f (Proof cpt cs) = do + cpt' <- walkM f cpt + cs' <- walkM f cs + return $ Proof cpt' cs' + 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 (Figure ft attr cs (PreparedContent im lt) capt) = + query f cs <> query f im <> query f capt + query f (ImageGrid xs) = query f xs + query f (Statement (StatementAttr i sty (lb, lbr) ct lv n cp) bs) = + query f lb <> query f cp <> query f bs + query f (Proof cpt cs) = query f cpt <> query f cs + 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 (Figure ft attr cs (PreparedContent im lt) capt) = + f $ Figure ft attr (walk f cs) + (PreparedContent (walk f im) lt) (walk f capt) + walk f (ImageGrid xs) = f $ ImageGrid $ walk f xs + walk f (Statement (StatementAttr i sty (lb, lbr) ct lv n cp) bs) = + f $ Statement + (StatementAttr i sty (walk f lb, lbr) + ct lv n (walk f cp)) + (walk f bs) + walk f (Proof cpt cs) = f $ Proof (walk f cpt) (walk f cs) + 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 (Figure ft attr cs (PreparedContent im lt) capt) = do + cs' <- walkM f cs + im' <- walkM f im + capt' <- walkM f capt + f $ Figure ft attr cs' + (PreparedContent im' lt) capt' + walkM f (ImageGrid xs) = ImageGrid <$> walkM f xs >>= f + walkM f (Statement at bs) = Statement at <$> walkM f bs >>= f + walkM f (Proof cpt cs) = do cpt' <- walkM f cpt + cs' <- walkM f cs + f $ Proof cpt' cs' + 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 (Figure ft attr cs pc@(PreparedContent im lt) capt) = + f (Figure ft attr cs pc capt) <> + query f cs <> query f im <> query f capt + query f (ImageGrid xs) = f (ImageGrid xs) <> query f xs + query f (Statement at bs) = f (Statement at bs) <> query f bs + query f (Proof cpt cs) = f (Proof cpt cs) <> query f cpt <> query f cs + 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 (NumRef r s) = NumRef r s + 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 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 (NumRef r s) = return $ NumRef r s + 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 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 (NumRef r s) = mempty + 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 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 + +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 diff --git a/scholdoc-types.cabal b/scholdoc-types.cabal new file mode 100644 --- /dev/null +++ b/scholdoc-types.cabal @@ -0,0 +1,42 @@ +Name: scholdoc-types +Version: 0.1.3 +Synopsis: Scholdoc fork of pandoc-types +Description: This package is a fork of @pandoc-types@ intended to + support the development of Scholdoc. It includes some + non-trivial extensions to the Pandoc types and builder + functions that are not easily implemented by depending on + and extending the @pandoc-types@ modules. + . + This package is currently up to date with @pandoc-types@ + version 1.12.4 + . + For descriptions of the original @pandoc-types@ package, + please visit + + +Homepage: http://scholarlymarkdown.com +License: GPL +License-file: COPYING +Author: Tim T.Y. Lin +Maintainer: timtylin@gmail.com +Bug-Reports: http://github.com/timtylin/scholdoc-types/issues +Copyright: (c) 2014 Tim T.Y. Lin, (c) 2006-2014 John MacFarlane +Category: Text +Build-type: Simple +Cabal-version: >=1.6 +Source-repository head + type: git + location: git://github.com/timtylin/scholdoc-types.git +Library + Exposed-modules: Text.Pandoc.Definition + Text.Pandoc.Generic + Text.Pandoc.Walk + Text.Pandoc.Builder + 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.2 && < 0.8, + deepseq-generics >= 0.1 && < 0.2