From c1f6bd2640ba028af61ec51f744842350a53246b Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 2 Jul 2016 10:04:47 +0200 Subject: 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. --- src/Text/Pandoc/Readers/Org/Blocks.hs | 118 +------------------ src/Text/Pandoc/Readers/Org/ExportSettings.hs | 159 ++++++++++++++++++++++++++ src/Text/Pandoc/Readers/Org/ParserState.hs | 105 +++++------------ 3 files changed, 191 insertions(+), 191 deletions(-) create mode 100644 src/Text/Pandoc/Readers/Org/ExportSettings.hs (limited to 'src/Text/Pandoc/Readers') 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 + +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 + +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 --- 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 +-- 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 + } -- -- cgit v1.2.3