Use enumerable set of known formats

Text/Pandoc/Arbitrary.hs

@@ -47,6 +47,7 @@ instance Arbitrary Inlines where
           flattenInline (Image _ ils _) = ils
           flattenInline Note{} = []
           flattenInline (Span _ ils) = ils
+          flattenInline (IfFormatInline _ ils) = ils
 
 instance Arbitrary Blocks where
   arbitrary = (fromList :: [Block] -> Blocks) <$> arbitrary
@@ -61,6 +62,7 @@ instance Arbitrary Blocks where
           flattenBlock (LineBlock lns) = [Para x | x <- lns]
           flattenBlock CodeBlock{} = []
           flattenBlock RawBlock{} = []
+          flattenBlock (IfFormatBlock _ blks) = blks
           flattenBlock (BlockQuote blks) = blks
           flattenBlock (OrderedList _ blksList) = concat blksList
           flattenBlock (BulletList blksList) = concat blksList
@@ -101,7 +103,8 @@ instance Arbitrary Inline where
   shrink SoftBreak = []
   shrink LineBreak = []
   shrink (Math mtype s) = Math mtype <$> shrink s
-  shrink (RawInline fmt s) = RawInline fmt <$> shrink s
+  shrink (RawInline s) = RawInline <$> shrink s
+  shrink (IfFormatInline fmt s) = IfFormatInline fmt <$> shrink s
   shrink (Link attr ils target) = [Link attr ils' target | ils' <- shrinkInlineList ils]
                                ++ [Link attr ils target' | target' <- shrink target]
                                ++ [Link attr' ils target | attr' <- shrink attr]
@@ -127,8 +130,12 @@ arbInline n = frequency $ [ (60, Str <$> realString)
                           , (10, pure SoftBreak)
                           , (10, pure LineBreak)
                           , (10, Code <$> arbAttr <*> realString)
-                          , (5,  elements [ RawInline (Format "html") "<a id=\"eek\">"
-                                          , RawInline (Format "latex") "\\my{command}" ])
+                          , (5,  elements
+                                 [ IfFormatInline (singleFormat HTML) $
+                                   [RawInline "<a id=\"eek\">"]
+                                 , IfFormatInline (oneOfFormats [LaTeX, ConTeXt]) $
+                                   [RawInline "\\my{command}"]
+                                 ])
                           ] ++ [ x | x <- nesters, n > 1]
    where nesters = [ (10, Emph <$> arbInlines (n-1))
                    , (10, Strong <$> arbInlines (n-1))
@@ -152,7 +159,8 @@ instance Arbitrary Block where
   shrink (LineBlock lns) = LineBlock <$> shrinkInlinesList lns
   shrink (CodeBlock attr s) = (CodeBlock attr <$> shrink s)
                            ++ (flip CodeBlock s <$> shrink attr)
-  shrink (RawBlock fmt s) = RawBlock fmt <$> shrink s
+  shrink (IfFormatBlock fmt blks) = IfFormatBlock fmt <$> shrink blks
+  shrink (RawBlock s) = RawBlock <$> shrink s
   shrink (BlockQuote blks) = BlockQuote <$> shrinkBlockList blks
   shrink (OrderedList listAttrs blksList) = OrderedList listAttrs <$> shrinkBlocksList blksList
   shrink (BulletList blksList) = BulletList <$> shrinkBlocksList blksList
@@ -196,10 +204,12 @@ arbBlock n = frequency $ [ (10, Plain <$> arbInlines (n-1))
                                 ((:) <$>
                                   arbInlines ((n - 1) `mod` 3) <*>
                                   forM [1..((n - 1) `div` 3)] (const (arbInlines 3))))
-                         , (2,  elements [ RawBlock (Format "html")
-                                            "<div>\n*&amp;*\n</div>"
-                                         , RawBlock (Format "latex")
-                                            "\\begin[opt]{env}\nhi\n{\\end{env}"
+                         , (2,  elements [ IfFormatBlock (singleFormat HTML) $
+                                           [RawBlock "<div>\n*&amp;*\n</div>"]
+                                         , IfFormatBlock (oneOfFormats [LaTeX, ConTeXt]) $
+                                           [RawBlock "\\begin[opt]{env}\nhi\n\\end{env}"]
+                                         , IfFormatBlock (noneOfFormats [HTML]) $
+                                           [Plain [Str "not HTML"]]
                                          ])
                          , (5,  Header <$> choose (1 :: Int, 6)
                                        <*> pure nullAttr

Text/Pandoc/Builder.hs

@@ -390,8 +390,9 @@ math = singleton . Math InlineMath
 displayMath :: String -> Inlines
 displayMath = singleton . Math DisplayMath
 
-rawInline :: String -> String -> Inlines
-rawInline format = singleton . RawInline (Format format)
+rawInline :: Format -> String -> Inlines
+rawInline format =
+  singleton . IfFormatInline (singleFormat format) . (:[]) . RawInline
 
 link :: String  -- ^ URL
      -> String  -- ^ Title
@@ -446,8 +447,9 @@ codeBlockWith attrs = singleton . CodeBlock attrs
 codeBlock :: String -> Blocks
 codeBlock = codeBlockWith nullAttr
 
-rawBlock :: String -> String -> Blocks
-rawBlock format = singleton . RawBlock (Format format)
+rawBlock :: Format -> String -> Blocks
+rawBlock format =
+  singleton . IfFormatBlock (singleFormat format) . (:[]) . RawBlock
 
 blockQuote :: Blocks -> Blocks
 blockQuote = singleton . BlockQuote . toList

Text/Pandoc/Definition.hs

@@ -61,7 +61,6 @@ module Text.Pandoc.Definition ( Pandoc(..)
                               , ListAttributes
                               , ListNumberStyle(..)
                               , ListNumberDelim(..)
-                              , Format(..)
                               , Attr
                               , nullAttr
                               , TableCell
@@ -70,6 +69,7 @@ module Text.Pandoc.Definition ( Pandoc(..)
                               , MathType(..)
                               , Citation(..)
                               , CitationMode(..)
+                              , module Text.Pandoc.Format
                               , pandocTypesVersion
                               ) where
 
@@ -79,8 +79,6 @@ import Data.Aeson hiding (Null)
 import qualified Data.Aeson.Types as Aeson
 import qualified Data.Map as M
 import GHC.Generics (Generic)
-import Data.String
-import Data.Char (toLower)
 #if MIN_VERSION_base(4,8,0)
 import Control.DeepSeq
 #else
@@ -92,6 +90,7 @@ import Control.DeepSeq.Generics
 import Paths_pandoc_types (version)
 import Data.Version (Version, versionBranch)
 import Data.Semigroup
+import Text.Pandoc.Format
 
 data Pandoc = Pandoc Meta [Block]
               deriving (Eq, Ord, Read, Show, Typeable, Data, Generic)
@@ -202,27 +201,15 @@ nullAttr = ("",[],[])
 -- | Table cells are list of Blocks
 type TableCell = [Block]
 
--- | Formats for raw blocks
-newtype Format = Format String
-               deriving (Read, Show, Typeable, Data, Generic, ToJSON, FromJSON)
-
-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
     | LineBlock [[Inline]]  -- ^ Multiple non-breaking lines
     | CodeBlock Attr String -- ^ Code block (literal) with attributes
-    | RawBlock Format String -- ^ Raw block
+    | RawBlock String       -- ^ Raw block
     | BlockQuote [Block]    -- ^ Block quote (list of blocks)
+    | IfFormatBlock Formats [Block] -- ^ Format-conditional content
     | OrderedList ListAttributes [[Block]] -- ^ Ordered list (attributes
                             -- and a list of items, each a list of blocks)
     | BulletList [[Block]]  -- ^ Bullet list (list of items, each
@@ -267,7 +254,8 @@ data Inline
     | SoftBreak             -- ^ Soft line break
     | LineBreak             -- ^ Hard line break
     | Math MathType String  -- ^ TeX math (literal)
-    | RawInline Format String -- ^ Raw inline
+    | RawInline String      -- ^ Raw inline
+    | IfFormatInline Formats [Inline] -- ^ Format-conditional inline content
     | Link Attr [Inline] Target  -- ^ Hyperlink: alt text (list of inlines), target
     | Image Attr [Inline] Target -- ^ Image:  alt text (list of inlines), target
     | Note [Block]          -- ^ Footnote or endnote
@@ -479,15 +467,17 @@ instance FromJSON Inline where
       "LineBreak"   -> return LineBreak
       "Math"        -> do (mtype, s) <- v .: "c"
                           return $ Math mtype s
-      "RawInline"   -> do (fmt, s) <- v .: "c"
-                          return $ RawInline fmt s
+      "RawInline"   -> do s <- v .: "c"
+                          return $ RawInline s
       "Link"        -> do (attr, ils, tgt) <- v .: "c"
                           return $ Link attr ils tgt
       "Image"       -> do (attr, ils, tgt) <- v .: "c"
                           return $ Image attr ils tgt
       "Note"        -> Note <$> v .: "c"
       "Span"        -> do (attr, ils) <- v .: "c"
                           return $ Span attr ils
+      "IfFormatInline" -> do (fmt, ils) <- v .: "c"
+                             return $ IfFormatInline fmt ils
       _ -> mempty
   parseJSON _ = mempty
 
@@ -506,11 +496,12 @@ instance ToJSON Inline where
   toJSON SoftBreak = taggedNoContent "SoftBreak"
   toJSON LineBreak = taggedNoContent "LineBreak"
   toJSON (Math mtype s) = tagged "Math" (mtype, s)
-  toJSON (RawInline fmt s) = tagged "RawInline" (fmt, s)
+  toJSON (RawInline s) = tagged "RawInline" s
   toJSON (Link attr ils target) = tagged "Link" (attr, ils, target)
   toJSON (Image attr ils target) = tagged "Image" (attr, ils, target)
   toJSON (Note blks) = tagged "Note" blks
   toJSON (Span attr ils) = tagged "Span" (attr, ils)
+  toJSON (IfFormatInline fmts ils) = tagged "IfFormatInline" (fmts, ils)
 
 instance FromJSON Block where
   parseJSON (Object v) = do
@@ -521,8 +512,8 @@ instance FromJSON Block where
       "LineBlock"      -> LineBlock <$> v .: "c"
       "CodeBlock"      -> do (attr, s) <- v .: "c"
                              return $ CodeBlock attr s
-      "RawBlock"       -> do (fmt, s) <- v .: "c"
-                             return $ RawBlock fmt s
+      "RawBlock"       -> do s <- v .: "c"
+                             return $ RawBlock s
       "BlockQuote"     -> BlockQuote <$> v .: "c"
       "OrderedList"    -> do (attr, items) <- v .: "c"
                              return $ OrderedList attr items
@@ -535,6 +526,8 @@ instance FromJSON Block where
                              return $ Table cpt align wdths hdr rows
       "Div"            -> do (attr, blks) <- v .: "c"
                              return $ Div attr blks
+      "IfFormatBlock"  -> do (fmts, blks) <- v .: "c"
+                             return $ IfFormatBlock fmts blks
       "Null"           -> return $ Null
       _                -> mempty
   parseJSON _ = mempty
@@ -543,7 +536,8 @@ instance ToJSON Block where
   toJSON (Para ils) = tagged "Para" ils
   toJSON (LineBlock lns) = tagged "LineBlock" lns
   toJSON (CodeBlock attr s) = tagged "CodeBlock" (attr, s)
-  toJSON (RawBlock fmt s) = tagged "RawBlock" (fmt, s)
+  toJSON (IfFormatBlock fmts blks) = tagged "IfFormatBlock" (fmts, blks)
+  toJSON (RawBlock s) = tagged "RawBlock" s
   toJSON (BlockQuote blks) = tagged "BlockQuote" blks
   toJSON (OrderedList listAttrs blksList) = tagged "OrderedList" (listAttrs, blksList)
   toJSON (BulletList blksList) = tagged "BulletList" blksList
@@ -588,7 +582,6 @@ instance NFData Citation
 instance NFData Alignment
 instance NFData Inline
 instance NFData MathType
-instance NFData Format
 instance NFData CitationMode
 instance NFData QuoteType
 instance NFData ListNumberDelim

Text/Pandoc/Format.hs

@@ -0,0 +1,149 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{- |
+   Module      : Text.Pandoc.Definition
+   Copyright   : © 2006-2019 John MacFarlane, Albert Krewinkel
+   License     : BSD3
+
+   Maintainer  : John MacFarlane <jgm@berkeley.edu>
+   Stability   : alpha
+   Portability : portable
+
+Set of known formats.
+-}
+module Text.Pandoc.Format
+  ( Format (..)
+  , Formats
+  , allFormats
+  , formatFromName
+  , name
+  , singleFormat
+  , oneOfFormats
+  , noneOfFormats
+  , inFormats
+  ) where
+
+import Prelude hiding (or)
+import Control.Applicative ((<|>))
+import Control.DeepSeq (NFData)
+import Data.Aeson ((.=), (.:), FromJSON (parseJSON), ToJSON (toJSON))
+import Data.Text (Text)
+import Data.Generics (Data, Typeable)
+import Data.List (sort)
+import Data.Map (Map)
+import Data.Set (Set)
+import GHC.Generics (Generic)
+
+import qualified Data.Aeson.Types as Aeson
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.Text as T
+
+-- | Formats
+data Formats
+  = OneOf (Set Format)
+  | NoneOf (Set Format)
+  deriving (Eq, Data, Generic, Ord, Read, Show, Typeable)
+
+oneOfFormats :: [Format] -> Formats
+oneOfFormats = OneOf . Set.fromList
+
+noneOfFormats :: [Format] -> Formats
+noneOfFormats = NoneOf . Set.fromList
+
+inFormats :: Format -> Formats -> Bool
+inFormats f (OneOf fs)  = f `Set.member` fs
+inFormats f (NoneOf fs) = f `Set.notMember` fs
+
+singleFormat :: Format -> Formats
+singleFormat = OneOf . Set.singleton
+
+-- | A known format.
+data Format
+  = AsciiDoc
+  | CommonMark
+  | ConTeXt
+  | Creole
+  | DocBook
+  | DokuWiki
+  | FB2
+  | HTML
+  | Haddock
+  | ICML
+  | Ipynb
+  | JATS
+  | JSON
+  | Jira
+  | LaTeX
+  | Man
+  | Markdown
+  | MediaWiki
+  | MS
+  | Muse
+  | Native
+  | ODT
+  | OOXML
+  | OPML
+  | OpenDocument
+  | Org
+  | PlainText
+  | ReStructuredText
+  | RTF
+  | Roff
+  | TEI
+  | TWiki
+  | Texinfo
+  | Textile
+  | TikiWiki
+  | Txt2tags
+  | Vimwiki
+  | ZimWiki
+  deriving (Bounded, Enum, Eq, Data, Generic, Ord, Read, Show, Typeable)
+
+-- | Short name of the format.
+name :: Format -> Text
+name PlainText = "plain"
+name ReStructuredText = "rst"
+name Txt2tags = "t2t"
+name f = T.toLower . T.pack $ show f
+
+-- | List of all formats of which pandoc is aware.
+allFormats :: Set Format
+allFormats = Set.fromAscList [minBound .. maxBound]
+
+-- | Map from format names to formats. A format may have multiple names.
+namedFormat :: Map Text Format
+namedFormat = Map.fromList $
+  map (\f -> (name f, f)) (Set.toList allFormats)
+
+-- | Get a format from a string identifier.
+formatFromName :: Text -> Maybe Format
+formatFromName = flip Map.lookup namedFormat
+
+-- | Use just the format's name to represent it in JSON; fully backwards
+-- compatible.
+instance ToJSON Format where
+  toJSON = toJSON . name
+
+-- | Read Format from a string; only partly backwards compatible, as unknown
+-- formats no longer work.
+instance FromJSON Format where
+  parseJSON = Aeson.withText "Format" $ \t ->
+    case formatFromName t of
+      Just f  -> return f
+      Nothing -> fail ("unknown format: " ++ T.unpack t)
+
+instance ToJSON Formats where
+  toJSON (OneOf fs)  = Aeson.object ["oneOf"  .= sort (Set.toList fs)]
+  toJSON (NoneOf fs) = Aeson.object ["noneOf" .= sort (Set.toList fs)]
+
+instance FromJSON Formats where
+  parseJSON = Aeson.withObject "Formats" $ \obj ->
+    (OneOf . Set.fromList <$> obj .: "oneOf") <|>
+    (NoneOf . Set.fromList <$> obj .: "noneOf")
+    -- <|> object .= "noneOf"
+
+instance NFData Format
+instance NFData Formats
+