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.
This commit is contained in:
Albert Krewinkel 2016-07-02 10:04:47 +02:00
parent c4cf6d237f
commit c1f6bd2640
No known key found for this signature in database
GPG key ID: 388DC0B21F631124
4 changed files with 193 additions and 192 deletions

View file

@ -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,

View file

@ -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

View file

@ -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

View file

@ -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