Org reader: put export setting parser into module

Export option parsing is distinct enough from general block parsing to
justify putting it into a separate module.

4 files changed, 192 insertions, 191 deletions

diff --git a/pandoc.cabal b/pandoc.cabal
index 54f452514..3976eddca 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -399,6 +399,7 @@ Library
                    Text.Pandoc.Readers.Odt.Arrows.Utils,
                    Text.Pandoc.Readers.Org.BlockStarts,
                    Text.Pandoc.Readers.Org.Blocks,
+                   Text.Pandoc.Readers.Org.ExportSettings,
                    Text.Pandoc.Readers.Org.Inlines,
                    Text.Pandoc.Readers.Org.ParserState,
                    Text.Pandoc.Readers.Org.Parsing,
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 5d4a0cae2..af178d400 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -34,6 +34,7 @@ module Text.Pandoc.Readers.Org.Blocks
   ) where
 
 import           Text.Pandoc.Readers.Org.BlockStarts
+import           Text.Pandoc.Readers.Org.ExportSettings ( exportSettings )
 import           Text.Pandoc.Readers.Org.Inlines
 import           Text.Pandoc.Readers.Org.ParserState
 import           Text.Pandoc.Readers.Org.Parsing
@@ -620,7 +621,7 @@ optionLine = try $ do
   key <- metaKey
   case key of
     "link"    -> parseLinkFormat >>= uncurry addLinkFormat
-    "options" -> () <$ sepBy spaces exportSetting
+    "options" -> exportSettings
     _         -> mzero
 
 addLinkFormat :: String
@@ -630,121 +631,6 @@ addLinkFormat key formatter = updateState $ \s ->
   let fs = orgStateLinkFormatters s
   in s{ orgStateLinkFormatters = M.insert key formatter fs }
 
-
---
--- Export Settings
---
-
--- | Read and process org-mode specific export options.
-exportSetting :: OrgParser ()
-exportSetting = choice
-  [ booleanSetting "^" setExportSubSuperscripts
-  , booleanSetting "'" setExportSmartQuotes
-  , booleanSetting "*" setExportEmphasizedText
-  , booleanSetting "-" setExportSpecialStrings
-  , ignoredSetting ":"
-  , ignoredSetting "<"
-  , ignoredSetting "\\n"
-  , archivedTreeSetting "arch" setExportArchivedTrees
-  , ignoredSetting "author"
-  , ignoredSetting "c"
-  , ignoredSetting "creator"
-  , complementableListSetting "d" setExportDrawers
-  , ignoredSetting "date"
-  , ignoredSetting "e"
-  , ignoredSetting "email"
-  , ignoredSetting "f"
-  , ignoredSetting "H"
-  , ignoredSetting "inline"
-  , ignoredSetting "num"
-  , ignoredSetting "p"
-  , ignoredSetting "pri"
-  , ignoredSetting "prop"
-  , ignoredSetting "stat"
-  , ignoredSetting "tags"
-  , ignoredSetting "tasks"
-  , ignoredSetting "tex"
-  , ignoredSetting "timestamp"
-  , ignoredSetting "title"
-  , ignoredSetting "toc"
-  , ignoredSetting "todo"
-  , ignoredSetting "|"
-  ] <?> "export setting"
-
-booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser ()
-booleanSetting settingIdentifier setter = try $ do
-  string settingIdentifier
-  char ':'
-  value <- elispBoolean
-  updateState $ modifyExportSettings setter value
-
--- | Read an elisp boolean.  Only NIL is treated as false, non-NIL values are
--- interpreted as true.
-elispBoolean :: OrgParser Bool
-elispBoolean = try $ do
-  value <- many1 nonspaceChar
-  return $ case map toLower value of
-             "nil" -> False
-             "{}"  -> False
-             "()"  -> False
-             _     -> True
-
-archivedTreeSetting :: String
-                    -> ExportSettingSetter ArchivedTreesOption
-                    -> OrgParser ()
-archivedTreeSetting settingIdentifier setter = try $ do
-  string settingIdentifier
-  char ':'
-  value <- archivedTreesHeadlineSetting <|> archivedTreesBoolean
-  updateState $ modifyExportSettings setter value
- where
-   archivedTreesHeadlineSetting = try $ do
-     string "headline"
-     lookAhead (newline <|> spaceChar)
-     return ArchivedTreesHeadlineOnly
-
-   archivedTreesBoolean = try $ do
-     exportBool <- elispBoolean
-     return $
-       if exportBool
-       then ArchivedTreesExport
-       else ArchivedTreesNoExport
-
--- | A list or a complement list (i.e. a list starting with `not`).
-complementableListSetting :: String
-                          -> ExportSettingSetter (Either [String] [String])
-                          -> OrgParser ()
-complementableListSetting settingIdentifier setter = try $ do
-  _     <- string settingIdentifier <* char ':'
-  value <- choice [ Left <$> complementStringList
-                  , Right <$> stringList
-                  , (\b -> if b then Left [] else Right []) <$> elispBoolean
-                  ]
-  updateState $ modifyExportSettings setter value
- where
-   -- Read a plain list of strings.
-   stringList :: OrgParser [String]
-   stringList = try $
-     char '('
-       *> sepBy elispString spaces
-       <* char ')'
-
-   -- Read an emacs lisp list specifying a complement set.
-   complementStringList :: OrgParser [String]
-   complementStringList = try $
-     string "(not "
-       *> sepBy elispString spaces
-       <* char ')'
-
-   elispString :: OrgParser String
-   elispString = try $
-     char '"'
-       *> manyTill alphaNum (char '"')
-
-ignoredSetting :: String -> OrgParser ()
-ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar)
-
-
 parseLinkFormat :: OrgParser ((String, String -> String))
 parseLinkFormat = try $ do
   linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces
diff --git a/src/Text/Pandoc/Readers/Org/ExportSettings.hs b/src/Text/Pandoc/Readers/Org/ExportSettings.hs
new file mode 100644
index 000000000..9f844c8dd
--- /dev/null
+++ b/src/Text/Pandoc/Readers/Org/ExportSettings.hs
@@ -0,0 +1,159 @@
+{-
+Copyright (C) 2014-2016 Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+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.Readers.Org.Options
+   Copyright   : Copyright (C) 2016 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+Parsers for Org-mode export options.
+-}
+module Text.Pandoc.Readers.Org.ExportSettings
+  ( exportSettings
+  ) where
+
+import           Text.Pandoc.Readers.Org.ParserState
+import           Text.Pandoc.Readers.Org.Parsing
+
+import           Control.Monad ( void )
+import           Data.Char ( toLower )
+
+-- | Read and handle space separated org-mode export settings.
+exportSettings :: OrgParser ()
+exportSettings = void $ sepBy spaces exportSetting
+
+-- | Setter function for export settings.
+type ExportSettingSetter a = a -> ExportSettings -> ExportSettings
+
+-- | Read and process a single org-mode export option.
+exportSetting :: OrgParser ()
+exportSetting = choice
+  [ booleanSetting "^" (\val es -> es { exportSubSuperscripts = val })
+  , booleanSetting "'" (\val es -> es { exportSmartQuotes = val })
+  , booleanSetting "*" (\val es -> es { exportEmphasizedText = val })
+  , booleanSetting "-" (\val es -> es { exportSpecialStrings = val })
+  , ignoredSetting ":"
+  , ignoredSetting "<"
+  , ignoredSetting "\\n"
+  , archivedTreeSetting "arch" (\val es -> es { exportArchivedTrees = val })
+  , ignoredSetting "author"
+  , ignoredSetting "c"
+  , ignoredSetting "creator"
+  , complementableListSetting "d" (\val es -> es { exportDrawers = val })
+  , ignoredSetting "date"
+  , ignoredSetting "e"
+  , ignoredSetting "email"
+  , ignoredSetting "f"
+  , ignoredSetting "H"
+  , ignoredSetting "inline"
+  , ignoredSetting "num"
+  , ignoredSetting "p"
+  , ignoredSetting "pri"
+  , ignoredSetting "prop"
+  , ignoredSetting "stat"
+  , ignoredSetting "tags"
+  , ignoredSetting "tasks"
+  , ignoredSetting "tex"
+  , ignoredSetting "timestamp"
+  , ignoredSetting "title"
+  , ignoredSetting "toc"
+  , ignoredSetting "todo"
+  , ignoredSetting "|"
+  ] <?> "export setting"
+
+genericExportSetting :: OrgParser a
+                     -> String
+                     -> ExportSettingSetter a
+                     -> OrgParser ()
+genericExportSetting optionParser settingIdentifier setter = try $ do
+  _     <- string settingIdentifier *> char ':'
+  value <- optionParser
+  updateState $ modifyExportSettings value
+ where
+   modifyExportSettings val st =
+     st { orgStateExportSettings = setter val . orgStateExportSettings $ st }
+
+-- | A boolean option, either nil (False) or non-nil (True).
+booleanSetting :: String ->  ExportSettingSetter Bool -> OrgParser ()
+booleanSetting = genericExportSetting elispBoolean
+
+-- | Either the string "headline" or an elisp boolean and treated as an
+-- @ArchivedTreesOption@.
+archivedTreeSetting :: String
+                    -> ExportSettingSetter ArchivedTreesOption
+                    -> OrgParser ()
+archivedTreeSetting =
+  genericExportSetting $ archivedTreesHeadlineSetting <|> archivedTreesBoolean
+ where
+   archivedTreesHeadlineSetting = try $ do
+     _ <- string "headline"
+     lookAhead (newline <|> spaceChar)
+     return ArchivedTreesHeadlineOnly
+
+   archivedTreesBoolean = try $ do
+     exportBool <- elispBoolean
+     return $
+       if exportBool
+       then ArchivedTreesExport
+       else ArchivedTreesNoExport
+
+-- | A list or a complement list (i.e. a list starting with `not`).
+complementableListSetting :: String
+                          -> ExportSettingSetter (Either [String] [String])
+                          -> OrgParser ()
+complementableListSetting = genericExportSetting $ choice
+  [ Left  <$> complementStringList
+  , Right <$> stringList
+  , (\b -> if b then Left [] else Right []) <$> elispBoolean
+  ]
+ where
+   -- Read a plain list of strings.
+   stringList :: OrgParser [String]
+   stringList = try $
+     char '('
+       *> sepBy elispString spaces
+       <* char ')'
+
+   -- Read an emacs lisp list specifying a complement set.
+   complementStringList :: OrgParser [String]
+   complementStringList = try $
+     string "(not "
+       *> sepBy elispString spaces
+       <* char ')'
+
+   elispString :: OrgParser String
+   elispString = try $
+     char '"'
+       *> manyTill alphaNum (char '"')
+
+-- | Read but ignore the export setting.
+ignoredSetting :: String -> OrgParser ()
+ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar)
+
+-- | Read an elisp boolean.  Only NIL is treated as false, non-NIL values are
+-- interpreted as true.
+elispBoolean :: OrgParser Bool
+elispBoolean = try $ do
+  value <- many1 nonspaceChar
+  return $ case map toLower value of
+             "nil" -> False
+             "{}"  -> False
+             "()"  -> False
+             _     -> True
diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs
index 93be92ae8..19524960b 100644
--- a/src/Text/Pandoc/Readers/Org/ParserState.hs
+++ b/src/Text/Pandoc/Readers/Org/ParserState.hs
@@ -40,16 +40,8 @@ module Text.Pandoc.Readers.Org.ParserState
   , trimInlinesF
   , runF
   , returnF
-  , ExportSettingSetter
   , ExportSettings (..)
   , ArchivedTreesOption (..)
-  , setExportArchivedTrees
-  , setExportDrawers
-  , setExportEmphasizedText
-  , setExportSmartQuotes
-  , setExportSpecialStrings
-  , setExportSubSuperscripts
-  , modifyExportSettings
   , optionsToParserState
   ) where
 
@@ -80,26 +72,6 @@ type OrgNoteTable = [OrgNoteRecord]
 -- link-type, the corresponding function transforms the given link string.
 type OrgLinkFormatters = M.Map String (String -> String)
 
--- | Options for the way archived trees are handled.
-data ArchivedTreesOption =
-    ArchivedTreesExport       -- ^ Export the complete tree
-  | ArchivedTreesNoExport     -- ^ Exclude archived trees from exporting
-  | ArchivedTreesHeadlineOnly -- ^ Export only the headline, discard the contents
-
--- | Export settings <http://orgmode.org/manual/Export-settings.html>
--- These settings can be changed via OPTIONS statements.
-data ExportSettings = ExportSettings
-  { exportArchivedTrees   :: ArchivedTreesOption -- ^ How to treat archived trees
-  , exportDrawers         :: Either [String] [String]
-  -- ^ Specify drawer names which should be exported.  @Left@ names are
-  -- explicitly excluded from the resulting output while @Right@ means that
-  -- only the listed drawer names should be included.
-  , exportEmphasizedText  :: Bool -- ^ Parse emphasized text
-  , exportSmartQuotes     :: Bool -- ^ Parse quotes smartly
-  , exportSpecialStrings  :: Bool -- ^ Parse ellipses and dashes smartly
-  , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts
-  }
-
 -- | Org-mode parser state
 data OrgParserState = OrgParserState
   { orgStateAnchorIds            :: [String]
@@ -142,9 +114,6 @@ instance HasHeaderMap OrgParserState where
   extractHeaderMap = orgStateHeaderMap
   updateHeaderMap  f s = s{ orgStateHeaderMap = f (orgStateHeaderMap s) }
 
-instance Default ExportSettings where
-  def = defaultExportSettings
-
 instance Default OrgParserState where
   def = defaultOrgParserState
 
@@ -166,60 +135,46 @@ defaultOrgParserState = OrgParserState
   , orgStateParserContext = NullState
   }
 
-defaultExportSettings :: ExportSettings
-defaultExportSettings = ExportSettings
-  { exportArchivedTrees = ArchivedTreesHeadlineOnly
-  , exportDrawers = Left ["LOGBOOK"]
-  , exportEmphasizedText = True
-  , exportSmartQuotes = True
-  , exportSpecialStrings = True
-  , exportSubSuperscripts = True
-  }
-
 optionsToParserState :: ReaderOptions -> OrgParserState
 optionsToParserState opts =
   def { orgStateOptions = opts }
 
-
 --
--- Setter for exporting options
+-- Export Settings
 --
 
--- This whole section could be scraped if we were using lenses.
-
-type ExportSettingSetter a = a -> ExportSettings -> ExportSettings
-
--- | Set export options for archived trees.
-setExportArchivedTrees :: ExportSettingSetter ArchivedTreesOption
-setExportArchivedTrees val es = es { exportArchivedTrees = val }
-
--- | Set export options for drawers.  See the @exportDrawers@ in ADT
--- @ExportSettings@ for details.
-setExportDrawers :: ExportSettingSetter (Either [String] [String])
-setExportDrawers val es = es { exportDrawers = val }
-
--- | Set export options for emphasis parsing.
-setExportEmphasizedText :: ExportSettingSetter Bool
-setExportEmphasizedText val es = es { exportEmphasizedText = val }
-
--- | Set export options for parsing of smart quotes.
-setExportSmartQuotes :: ExportSettingSetter Bool
-setExportSmartQuotes val es = es { exportSmartQuotes = val }
+-- | Options for the way archived trees are handled.
+data ArchivedTreesOption =
+    ArchivedTreesExport       -- ^ Export the complete tree
+  | ArchivedTreesNoExport     -- ^ Exclude archived trees from exporting
+  | ArchivedTreesHeadlineOnly -- ^ Export only the headline, discard the contents
 
--- | Set export options for parsing of special strings (like em/en dashes or
--- ellipses).
-setExportSpecialStrings :: ExportSettingSetter Bool
-setExportSpecialStrings val es = es { exportSpecialStrings = val }
+-- | Export settings <http://orgmode.org/manual/Export-settings.html>
+-- These settings can be changed via OPTIONS statements.
+data ExportSettings = ExportSettings
+  { exportArchivedTrees   :: ArchivedTreesOption -- ^ How to treat archived trees
+  , exportDrawers         :: Either [String] [String]
+  -- ^ Specify drawer names which should be exported.  @Left@ names are
+  -- explicitly excluded from the resulting output while @Right@ means that
+  -- only the listed drawer names should be included.
+  , exportEmphasizedText  :: Bool -- ^ Parse emphasized text
+  , exportSmartQuotes     :: Bool -- ^ Parse quotes smartly
+  , exportSpecialStrings  :: Bool -- ^ Parse ellipses and dashes smartly
+  , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts
+  }
 
--- | Set export options for sub/superscript parsing.  The short syntax will
--- not be parsed if this is set set to @False@.
-setExportSubSuperscripts :: ExportSettingSetter Bool
-setExportSubSuperscripts val es = es { exportSubSuperscripts = val }
+instance Default ExportSettings where
+  def = defaultExportSettings
 
--- | Modify a parser state
-modifyExportSettings :: ExportSettingSetter a -> a -> OrgParserState -> OrgParserState
-modifyExportSettings setter val state =
-  state { orgStateExportSettings = setter val . orgStateExportSettings $ state }
+defaultExportSettings :: ExportSettings
+defaultExportSettings = ExportSettings
+  { exportArchivedTrees = ArchivedTreesHeadlineOnly
+  , exportDrawers = Left ["LOGBOOK"]
+  , exportEmphasizedText = True
+  , exportSmartQuotes = True
+  , exportSpecialStrings = True
+  , exportSubSuperscripts = True
+  }
 
 
 --