Add custom extensions.

T.P.Extensions [API change]:

+ Add CustomExtension constructor to Extension.
+ Remove Bounded, Enum instances for Extension.
+ Add `extensionsToList` function.
+ Revise `readExtension` so it can handle CustomExtension, and so
  that it returns a Text rather than Maybe Text.
+ Add `showExtension`.

T.P.Format:

+ Revise error checking to handle CustomExtension.

4 files changed, 38 insertions, 28 deletions

diff --git a/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/Format.hs b/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/Format.hs
index a71aeb952..377ce159b 100644
--- a/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/Format.hs
+++ b/pandoc-lua-engine/src/Text/Pandoc/Lua/Marshal/Format.hs
@@ -19,16 +19,12 @@ module Text.Pandoc.Lua.Marshal.Format
 import HsLua
 import Text.Pandoc.Extensions (Extension, Extensions, extensionsFromList, readExtension)
 import Text.Pandoc.Format (ExtensionsConfig (..))
-import qualified HsLua.Core.Utf8 as UTF8
 
 -- | Retrieves an 'Extensions' set from the Lua stack.
 peekExtension :: LuaError e => Peeker e Extension
 peekExtension idx = do
   extString <- peekString idx
-  case readExtension extString of
-    Just ext -> return ext
-    Nothing  -> failPeek . UTF8.fromString $
-                "Unknown extension: " <> extString
+  return $ readExtension extString
 {-# INLINE peekExtension #-}
 
 -- | Retrieves an 'Extensions' set from the Lua stack.
diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs
index b57a16fc6..58c9e9e2a 100644
--- a/src/Text/Pandoc/App/CommandLineOptions.hs
+++ b/src/Text/Pandoc/App/CommandLineOptions.hs
@@ -829,12 +829,10 @@ options =
     , Option "" ["list-extensions"]
                  (OptArg
                   (\arg _ -> do
-                     let extList :: [Extension]
-                         extList = [minBound..maxBound]
-                     let allExts =
-                           case arg of
-                             Nothing  -> extensionsFromList extList
-                             Just fmt -> getAllExtensions $ T.pack fmt
+                     let allExts = getAllExtensions $
+                                    case arg of
+                                      Nothing  -> "markdown"
+                                      Just fmt -> T.pack fmt
                      let formatName = maybe "markdown" T.pack arg
                      if formatName `notElem`
                          (map fst (readers :: [(Text, Reader PandocPure)]) ++
@@ -850,7 +848,7 @@ options =
                                            then '-'
                                            else ' ') : drop 4 (show x)
                           mapM_ (UTF8.hPutStrLn stdout . T.pack . showExt)
-                             [ex | ex <- extList, extensionEnabled ex allExts]
+                             (extensionsToList allExts)
                           exitSuccess )
                   "FORMAT")
                  ""
diff --git a/src/Text/Pandoc/Extensions.hs b/src/Text/Pandoc/Extensions.hs
index 048d234f8..a23659b2a 100644
--- a/src/Text/Pandoc/Extensions.hs
+++ b/src/Text/Pandoc/Extensions.hs
@@ -2,7 +2,6 @@
 {-# LANGUAGE DeriveDataTypeable         #-}
 {-# LANGUAGE DeriveGeneric              #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE TemplateHaskell            #-}
 {-# LANGUAGE OverloadedStrings          #-}
 {- |
    Module      : Text.Pandoc.Extensions
@@ -17,9 +16,11 @@ Data structures and functions for representing markup extensions.
 -}
 module Text.Pandoc.Extensions ( Extension(..)
                               , readExtension
+                              , showExtension
                               , Extensions
                               , emptyExtensions
                               , extensionsFromList
+                              , extensionsToList
                               , extensionEnabled
                               , enableExtension
                               , disableExtension
@@ -37,8 +38,8 @@ import qualified Data.Text as T
 import Data.Typeable (Typeable)
 import GHC.Generics (Generic)
 import Text.Read (readMaybe)
-import Data.Aeson.TH (deriveJSON)
 import Data.Aeson
+import Data.List (sort)
 import qualified Data.Set as Set
 
 -- | Individually selectable syntax extensions.
@@ -135,9 +136,14 @@ data Extension =
     | Ext_xrefs_name          -- ^ Use xrefs with names
     | Ext_xrefs_number        -- ^ Use xrefs with numbers
     | Ext_yaml_metadata_block -- ^ YAML metadata block
-    deriving (Show, Read, Enum, Eq, Ord, Bounded, Data, Typeable, Generic)
+    | CustomExtension T.Text  -- ^ Custom extension
+    deriving (Show, Read, Eq, Ord, Data, Typeable, Generic)
 
-$(deriveJSON defaultOptions{ constructorTagModifier = drop 4 } ''Extension)
+instance FromJSON Extension where
+  parseJSON = withText "Extension" (pure . readExtension . T.unpack)
+
+instance ToJSON Extension where
+ toJSON = String . showExtension
 
 newtype Extensions = Extensions (Set.Set Extension)
   deriving (Show, Read, Eq, Ord, Data, Typeable, Generic)
@@ -152,17 +158,28 @@ instance FromJSON Extensions where
   parseJSON = fmap extensionsFromList . parseJSON
 
 instance ToJSON Extensions where
-  toJSON exts = toJSON $
-    [ext | ext <- [minBound..maxBound], extensionEnabled ext exts]
+  toJSON (Extensions exts) = toJSON exts
 
 -- | Reads a single extension from a string.
-readExtension :: String -> Maybe Extension
-readExtension name = case name of
-  "lhs" -> Just Ext_literate_haskell
-  _     -> readMaybe ("Ext_" ++ name)
+readExtension :: String -> Extension
+readExtension "lhs" = Ext_literate_haskell
+readExtension name =
+  case readMaybe ("Ext_" ++ name) of
+    Just ext -> ext
+    Nothing -> CustomExtension (T.pack name)
+
+-- | Show an extension in human-readable form.
+showExtension :: Extension -> T.Text
+showExtension ext =
+  case ext of
+    CustomExtension t -> t
+    _ -> T.drop 4 $ T.pack $ show ext
 
 extensionsFromList :: [Extension] -> Extensions
-extensionsFromList = foldr enableExtension emptyExtensions
+extensionsFromList = Extensions . Set.fromList
+
+extensionsToList :: Extensions -> [Extension]
+extensionsToList (Extensions extset) = sort $ Set.toList extset
 
 emptyExtensions :: Extensions
 emptyExtensions = Extensions mempty
diff --git a/src/Text/Pandoc/Format.hs b/src/Text/Pandoc/Format.hs
index 2689a2834..a668969ed 100644
--- a/src/Text/Pandoc/Format.hs
+++ b/src/Text/Pandoc/Format.hs
@@ -31,6 +31,7 @@ import Text.Pandoc.Extensions
   , getAllExtensions
   , getDefaultExtensions
   , readExtension
+  , showExtension
   )
 import Text.Pandoc.Parsing
 import qualified Data.Text as T
@@ -84,8 +85,8 @@ applyExtensionsDiff extConf (FlavoredFormat fname extsDiff) = do
         filter (\ext -> not $ extensionEnabled ext (extsSupported extConf))
                (extsToEnable extsDiff ++ extsToDisable extsDiff)
   case unsupported of
-    ext:_ -> throwError $ PandocUnsupportedExtensionError
-             (T.drop 4 . T.pack $ show ext) fname
+    ext:_ -> throwError $ PandocUnsupportedExtensionError (showExtension ext)
+                          fname
     []    -> let enabled = foldr enableExtension
                                  (extsDefault extConf)
                                  (extsToEnable extsDiff)
@@ -126,9 +127,7 @@ pExtensionsDiff = foldl' (flip ($)) (ExtensionsDiff [] []) <$> many extMod
     extMod = do
       polarity <- oneOf "-+"
       name <- many $ noneOf "-+"
-      ext <- case readExtension name of
-               Just n  -> return n
-               Nothing -> unexpected $ "unknown extension: " ++ name
+      let ext = readExtension name
       return $ \extsDiff ->
         case polarity of
           '+' -> extsDiff{extsToEnable  = (ext : extsToEnable extsDiff)}