From c1f6bd2640ba028af61ec51f744842350a53246b Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sat, 2 Jul 2016 10:04:47 +0200
Subject: [PATCH] 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.
---
pandoc.cabal | 1 +
src/Text/Pandoc/Readers/Org/Blocks.hs | 118 +------------
src/Text/Pandoc/Readers/Org/ExportSettings.hs | 159 ++++++++++++++++++
src/Text/Pandoc/Readers/Org/ParserState.hs | 107 ++++--------
4 files changed, 193 insertions(+), 192 deletions(-)
create mode 100644 src/Text/Pandoc/Readers/Org/ExportSettings.hs
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,6 +135,37 @@ defaultOrgParserState = OrgParserState
, orgStateParserContext = NullState
}
+optionsToParserState :: ReaderOptions -> OrgParserState
+optionsToParserState opts =
+ def { orgStateOptions = opts }
+
+--
+-- Export Settings
+--
+
+-- | 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
+ }
+
+instance Default ExportSettings where
+ def = defaultExportSettings
+
defaultExportSettings :: ExportSettings
defaultExportSettings = ExportSettings
{ exportArchivedTrees = ArchivedTreesHeadlineOnly
@@ -176,51 +176,6 @@ defaultExportSettings = ExportSettings
, exportSubSuperscripts = True
}
-optionsToParserState :: ReaderOptions -> OrgParserState
-optionsToParserState opts =
- def { orgStateOptions = opts }
-
-
---
--- Setter for exporting options
---
-
--- 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 }
-
--- | Set export options for parsing of special strings (like em/en dashes or
--- ellipses).
-setExportSpecialStrings :: ExportSettingSetter Bool
-setExportSpecialStrings val es = es { exportSpecialStrings = val }
-
--- | 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 }
-
--- | Modify a parser state
-modifyExportSettings :: ExportSettingSetter a -> a -> OrgParserState -> OrgParserState
-modifyExportSettings setter val state =
- state { orgStateExportSettings = setter val . orgStateExportSettings $ state }
-
--
-- Parser state reader