1{-# LANGUAGE OverloadedStrings, DeriveDataTypeable, DeriveGeneric,
2    FlexibleContexts, GeneralizedNewtypeDeriving, PatternGuards, CPP,
3    TemplateHaskell #-}
4
5{-
6Copyright (c) 2006-2019, John MacFarlane
7
8All rights reserved.
9
10Redistribution and use in source and binary forms, with or without
11modification, are permitted provided that the following conditions are met:
12
13    * Redistributions of source code must retain the above copyright
14      notice, this list of conditions and the following disclaimer.
15
16    * Redistributions in binary form must reproduce the above
17      copyright notice, this list of conditions and the following
18      disclaimer in the documentation and/or other materials provided
19      with the distribution.
20
21    * Neither the name of John MacFarlane nor the names of other
22      contributors may be used to endorse or promote products derived
23      from this software without specific prior written permission.
24
25THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
26"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
27LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
28A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
29OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
30SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
31LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
32DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
33THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
34(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
35OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
36-}
37
38{- |
39   Module      : Text.Pandoc.Definition
40   Copyright   : Copyright (C) 2006-2019 John MacFarlane
41   License     : BSD3
42
43   Maintainer  : John MacFarlane <jgm@berkeley.edu>
44   Stability   : alpha
45   Portability : portable
46
47Definition of 'Pandoc' data structure for format-neutral representation
48of documents.
49-}
50module Text.Pandoc.Definition ( Pandoc(..)
51                              , Meta(..)
52                              , MetaValue(..)
53                              , nullMeta
54                              , isNullMeta
55                              , lookupMeta
56                              , docTitle
57                              , docAuthors
58                              , docDate
59                              , Block(..)
60                              , Inline(..)
61                              , ListAttributes
62                              , ListNumberStyle(..)
63                              , ListNumberDelim(..)
64                              , Format(..)
65                              , Attr
66                              , nullAttr
67                              , Caption(..)
68                              , ShortCaption
69                              , RowHeadColumns(..)
70                              , Alignment(..)
71                              , ColWidth(..)
72                              , ColSpec
73                              , Row(..)
74                              , TableHead(..)
75                              , TableBody(..)
76                              , TableFoot(..)
77                              , Cell(..)
78                              , RowSpan(..)
79                              , ColSpan(..)
80                              , QuoteType(..)
81                              , Target
82                              , MathType(..)
83                              , Citation(..)
84                              , CitationMode(..)
85                              , pandocTypesVersion
86                              ) where
87
88import Data.Generics (Data, Typeable)
89import Data.Ord (comparing)
90import Data.Aeson hiding (Null)
91import Data.Aeson.TH (deriveJSON)
92import qualified Data.Aeson.Types as Aeson
93import qualified Data.Map as M
94import Data.Text (Text)
95import qualified Data.Text as T
96import GHC.Generics (Generic)
97import Data.String
98import Control.DeepSeq
99import Paths_pandoc_types (version)
100import Data.Version (Version, versionBranch)
101import Data.Semigroup (Semigroup(..))
102
103data Pandoc = Pandoc Meta [Block]
104              deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
105
106instance Semigroup Pandoc where
107  (Pandoc m1 bs1) <> (Pandoc m2 bs2) =
108    Pandoc (m1 <> m2) (bs1 <> bs2)
109instance Monoid Pandoc where
110  mempty = Pandoc mempty mempty
111  mappend = (<>)
112
113-- | Metadata for the document:  title, authors, date.
114newtype Meta = Meta { unMeta :: M.Map Text MetaValue }
115               deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
116
117instance Semigroup Meta where
118  (Meta m1) <> (Meta m2) = Meta (M.union m2 m1)
119  -- note: M.union is left-biased, so if there are fields in both m2
120  -- and m1, m2 wins.
121instance Monoid Meta where
122  mempty = Meta M.empty
123  mappend = (<>)
124
125data MetaValue = MetaMap (M.Map Text MetaValue)
126               | MetaList [MetaValue]
127               | MetaBool Bool
128               | MetaString Text
129               | MetaInlines [Inline]
130               | MetaBlocks [Block]
131               deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
132
133nullMeta :: Meta
134nullMeta = Meta M.empty
135
136isNullMeta :: Meta -> Bool
137isNullMeta (Meta m) = M.null m
138
139-- Helper functions to extract metadata
140
141-- | Retrieve the metadata value for a given @key@.
142lookupMeta :: Text -> Meta -> Maybe MetaValue
143lookupMeta key (Meta m) = M.lookup key m
144
145-- | Extract document title from metadata; works just like the old @docTitle@.
146docTitle :: Meta -> [Inline]
147docTitle meta =
148  case lookupMeta "title" meta of
149         Just (MetaString s)           -> [Str s]
150         Just (MetaInlines ils)        -> ils
151         Just (MetaBlocks [Plain ils]) -> ils
152         Just (MetaBlocks [Para ils])  -> ils
153         _                             -> []
154
155-- | Extract document authors from metadata; works just like the old
156-- @docAuthors@.
157docAuthors :: Meta -> [[Inline]]
158docAuthors meta =
159  case lookupMeta "author" meta of
160        Just (MetaString s)    -> [[Str s]]
161        Just (MetaInlines ils) -> [ils]
162        Just (MetaList   ms)   -> [ils | MetaInlines ils <- ms] ++
163                                  [ils | MetaBlocks [Plain ils] <- ms] ++
164                                  [ils | MetaBlocks [Para ils]  <- ms] ++
165                                  [[Str x] | MetaString x <- ms]
166        _                      -> []
167
168-- | Extract date from metadata; works just like the old @docDate@.
169docDate :: Meta -> [Inline]
170docDate meta =
171  case lookupMeta "date" meta of
172         Just (MetaString s)           -> [Str s]
173         Just (MetaInlines ils)        -> ils
174         Just (MetaBlocks [Plain ils]) -> ils
175         Just (MetaBlocks [Para ils])  -> ils
176         _                             -> []
177
178-- | List attributes.  The first element of the triple is the
179-- start number of the list.
180type ListAttributes = (Int, ListNumberStyle, ListNumberDelim)
181
182-- | Style of list numbers.
183data ListNumberStyle = DefaultStyle
184                     | Example
185                     | Decimal
186                     | LowerRoman
187                     | UpperRoman
188                     | LowerAlpha
189                     | UpperAlpha deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
190
191-- | Delimiter of list numbers.
192data ListNumberDelim = DefaultDelim
193                     | Period
194                     | OneParen
195                     | TwoParens deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
196
197-- | Attributes: identifier, classes, key-value pairs
198type Attr = (Text, [Text], [(Text, Text)])
199
200nullAttr :: Attr
201nullAttr = ("",[],[])
202
203-- | Formats for raw blocks
204newtype Format = Format Text
205               deriving (Read, Show, Typeable, Data, Generic, ToJSON, FromJSON)
206
207instance IsString Format where
208  fromString f = Format $ T.toCaseFold $ T.pack f
209
210instance Eq Format where
211  Format x == Format y = T.toCaseFold x == T.toCaseFold y
212
213instance Ord Format where
214  compare (Format x) (Format y) = compare (T.toCaseFold x) (T.toCaseFold y)
215
216-- | The number of columns taken up by the row head of each row of a
217-- 'TableBody'. The row body takes up the remaining columns.
218newtype RowHeadColumns = RowHeadColumns Int
219  deriving (Eq, Ord, Show, Read, Typeable, Data, Generic, Num, Enum, ToJSON, FromJSON)
220
221-- | Alignment of a table column.
222data Alignment = AlignLeft
223               | AlignRight
224               | AlignCenter
225               | AlignDefault deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
226
227-- | The width of a table column, as a fraction of the total table
228-- width.
229data ColWidth = ColWidth Double
230              | ColWidthDefault deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
231
232-- | The specification for a single table column.
233type ColSpec = (Alignment, ColWidth)
234
235-- | A table row.
236data Row = Row Attr [Cell]
237  deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
238
239-- | The head of a table.
240data TableHead = TableHead Attr [Row]
241  deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
242
243-- | A body of a table, with an intermediate head, intermediate body,
244-- and the specified number of row header columns in the intermediate
245-- body.
246data TableBody = TableBody Attr RowHeadColumns [Row] [Row]
247  deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
248
249-- | The foot of a table.
250data TableFoot = TableFoot Attr [Row]
251  deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
252
253-- | A short caption, for use in, for instance, lists of figures.
254type ShortCaption = [Inline]
255
256-- | The caption of a table, with an optional short caption.
257data Caption = Caption (Maybe ShortCaption) [Block]
258  deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
259
260-- | A table cell.
261data Cell = Cell Attr Alignment RowSpan ColSpan [Block]
262  deriving (Eq, Ord, Show, Read, Typeable, Data, Generic)
263
264-- | The number of rows occupied by a cell; the height of a cell.
265newtype RowSpan = RowSpan Int
266  deriving (Eq, Ord, Show, Read, Typeable, Data, Generic, Num, Enum, ToJSON, FromJSON)
267
268-- | The number of columns occupied by a cell; the width of a cell.
269newtype ColSpan = ColSpan Int
270  deriving (Eq, Ord, Show, Read, Typeable, Data, Generic, Num, Enum, ToJSON, FromJSON)
271
272-- | Block element.
273data Block
274    -- | Plain text, not a paragraph
275    = Plain [Inline]
276    -- | Paragraph
277    | Para [Inline]
278    -- | Multiple non-breaking lines
279    | LineBlock [[Inline]]
280    -- | Code block (literal) with attributes
281    | CodeBlock Attr Text
282    -- | Raw block
283    | RawBlock Format Text
284    -- | Block quote (list of blocks)
285    | BlockQuote [Block]
286    -- | Ordered list (attributes and a list of items, each a list of
287    -- blocks)
288    | OrderedList ListAttributes [[Block]]
289    -- | Bullet list (list of items, each a list of blocks)
290    | BulletList [[Block]]
291    -- | Definition list. Each list item is a pair consisting of a
292    -- term (a list of inlines) and one or more definitions (each a
293    -- list of blocks)
294    | DefinitionList [([Inline],[[Block]])]
295    -- | Header - level (integer) and text (inlines)
296    | Header Int Attr [Inline]
297    -- | Horizontal rule
298    | HorizontalRule
299    -- | Table, with attributes, caption, optional short caption,
300    -- column alignments and widths (required), table head, table
301    -- bodies, and table foot
302    | Table Attr Caption [ColSpec] TableHead [TableBody] TableFoot
303    -- | Generic block container with attributes
304    | Div Attr [Block]
305    -- | Nothing
306    | Null
307    deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
308
309-- | Type of quotation marks to use in Quoted inline.
310data QuoteType = SingleQuote | DoubleQuote deriving (Show, Eq, Ord, Read, Typeable, Data, Generic)
311
312-- | Link target (URL, title).
313type Target = (Text, Text)
314
315-- | Type of math element (display or inline).
316data MathType = DisplayMath | InlineMath deriving (Show, Eq, Ord, Read, Typeable, Data, Generic)
317
318-- | Inline elements.
319data Inline
320    = Str Text            -- ^ Text (string)
321    | Emph [Inline]         -- ^ Emphasized text (list of inlines)
322    | Underline [Inline]    -- ^  Underlined text (list of inlines)
323    | Strong [Inline]       -- ^ Strongly emphasized text (list of inlines)
324    | Strikeout [Inline]    -- ^ Strikeout text (list of inlines)
325    | Superscript [Inline]  -- ^ Superscripted text (list of inlines)
326    | Subscript [Inline]    -- ^ Subscripted text (list of inlines)
327    | SmallCaps [Inline]    -- ^ Small caps text (list of inlines)
328    | Quoted QuoteType [Inline] -- ^ Quoted text (list of inlines)
329    | Cite [Citation]  [Inline] -- ^ Citation (list of inlines)
330    | Code Attr Text      -- ^ Inline code (literal)
331    | Space                 -- ^ Inter-word space
332    | SoftBreak             -- ^ Soft line break
333    | LineBreak             -- ^ Hard line break
334    | Math MathType Text  -- ^ TeX math (literal)
335    | RawInline Format Text -- ^ Raw inline
336    | Link Attr [Inline] Target  -- ^ Hyperlink: alt text (list of inlines), target
337    | Image Attr [Inline] Target -- ^ Image:  alt text (list of inlines), target
338    | Note [Block]          -- ^ Footnote or endnote
339    | Span Attr [Inline]    -- ^ Generic inline container with attributes
340    deriving (Show, Eq, Ord, Read, Typeable, Data, Generic)
341
342data Citation = Citation { citationId      :: Text
343                         , citationPrefix  :: [Inline]
344                         , citationSuffix  :: [Inline]
345                         , citationMode    :: CitationMode
346                         , citationNoteNum :: Int
347                         , citationHash    :: Int
348                         }
349                deriving (Show, Eq, Read, Typeable, Data, Generic)
350
351instance Ord Citation where
352    compare = comparing citationHash
353
354data CitationMode = AuthorInText | SuppressAuthor | NormalCitation
355                    deriving (Show, Eq, Ord, Read, Typeable, Data, Generic)
356
357
358-- ToJSON/FromJSON instances. Some are defined by hand so that we have
359-- more control over the format.
360
361$(let jsonOpts = defaultOptions
362        { allNullaryToStringTag = False
363        , sumEncoding = TaggedObject { tagFieldName = "t", contentsFieldName = "c" }
364        }
365  in fmap concat $ traverse (deriveJSON jsonOpts)
366     [ ''MetaValue
367     , ''CitationMode
368     , ''Citation
369     , ''QuoteType
370     , ''MathType
371     , ''ListNumberStyle
372     , ''ListNumberDelim
373     , ''Alignment
374     , ''ColWidth
375     , ''Row
376     , ''Caption
377     , ''TableHead
378     , ''TableBody
379     , ''TableFoot
380     , ''Cell
381     , ''Inline
382     , ''Block
383     ])
384
385instance FromJSON Meta where
386  parseJSON = fmap Meta . parseJSON
387instance ToJSON Meta where
388  toJSON (Meta m) = toJSON m
389  toEncoding (Meta m) = toEncoding m
390
391instance FromJSON Pandoc where
392  parseJSON (Object v) = do
393    mbJVersion <- v .:? "pandoc-api-version" :: Aeson.Parser (Maybe [Int])
394    case mbJVersion of
395      Just jVersion  | x : y : _ <- jVersion
396                     , x' : y' : _ <- versionBranch pandocTypesVersion
397                     , x == x'
398                     , y == y' -> Pandoc <$> v .: "meta" <*> v .: "blocks"
399                     | otherwise ->
400                         fail $ mconcat [ "Incompatible API versions: "
401                                        , "encoded with "
402                                        , show jVersion
403                                        , " but attempted to decode with "
404                                        , show $ versionBranch pandocTypesVersion
405                                        , "."
406                                        ]
407      _ -> fail "JSON missing pandoc-api-version."
408  parseJSON _ = mempty
409instance ToJSON Pandoc where
410  toJSON (Pandoc meta blks) =
411    object [ "pandoc-api-version" .= versionBranch pandocTypesVersion
412           , "meta"               .= meta
413           , "blocks"             .= blks
414           ]
415  toEncoding (Pandoc meta blks) =
416    pairs $ mconcat [ "pandoc-api-version" .= versionBranch pandocTypesVersion
417                    , "meta"               .= meta
418                    , "blocks"             .= blks
419                    ]
420
421-- Instances for deepseq
422instance NFData MetaValue
423instance NFData Meta
424instance NFData Citation
425instance NFData Alignment
426instance NFData RowSpan
427instance NFData ColSpan
428instance NFData Cell
429instance NFData Row
430instance NFData TableHead
431instance NFData TableBody
432instance NFData TableFoot
433instance NFData Caption
434instance NFData Inline
435instance NFData MathType
436instance NFData Format
437instance NFData CitationMode
438instance NFData QuoteType
439instance NFData ListNumberDelim
440instance NFData ListNumberStyle
441instance NFData ColWidth
442instance NFData RowHeadColumns
443instance NFData Block
444instance NFData Pandoc
445
446pandocTypesVersion :: Version
447pandocTypesVersion = version
448