From b53ebcdf8e8e1f7098a0c93ead4b5bf99971c77f Mon Sep 17 00:00:00 2001 From: Jesse Rosenthal Date: Mon, 28 Nov 2016 17:13:46 -0500 Subject: Working on readers. --- src/Text/Pandoc/Readers/Org/ParserState.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 38f95ca95..181dd1d5c 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -51,7 +51,7 @@ module Text.Pandoc.Readers.Org.ParserState ) where import Control.Monad (liftM, liftM2) -import Control.Monad.Reader (Reader, runReader, ask, asks, local) +import Control.Monad.Reader (Reader, runReader, ReaderT, ask, asks, local) import Data.Default (Default(..)) import qualified Data.Map as M @@ -122,7 +122,7 @@ instance HasLastStrPosition OrgParserState where getLastStrPos = orgStateLastStrPos setLastStrPos pos st = st{ orgStateLastStrPos = Just pos } -instance HasQuoteContext st (Reader OrgParserLocal) where +instance Monad m => HasQuoteContext st (ReaderT OrgParserLocal m) where getQuoteContext = asks orgLocalQuoteContext withQuoteContext q = local (\s -> s{orgLocalQuoteContext = q}) -- cgit v1.2.3 From e256c8ce1778ff6fbb2e8d59556d48fb3c53393d Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sat, 4 Mar 2017 13:03:41 +0100 Subject: Stylish-haskell automatic formatting changes. --- src/Text/Pandoc/Readers/Org/ParserState.hs | 48 ++++++++++++++---------------- 1 file changed, 22 insertions(+), 26 deletions(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 181dd1d5c..0bbe27991 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -1,6 +1,6 @@ -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE MultiParamTypeClasses #-} {- Copyright (C) 2014-2016 Albert Krewinkel @@ -50,24 +50,20 @@ module Text.Pandoc.Readers.Org.ParserState , optionsToParserState ) where -import Control.Monad (liftM, liftM2) -import Control.Monad.Reader (Reader, runReader, ReaderT, ask, asks, local) +import Control.Monad (liftM, liftM2) +import Control.Monad.Reader (Reader, ReaderT, ask, asks, local, runReader) -import Data.Default (Default(..)) +import Data.Default (Default (..)) import qualified Data.Map as M import qualified Data.Set as Set -import Text.Pandoc.Builder ( Inlines, Blocks, trimInlines ) -import Text.Pandoc.Definition ( Meta(..), nullMeta ) -import Text.Pandoc.Options ( ReaderOptions(..) ) -import Text.Pandoc.Parsing ( HasHeaderMap(..) - , HasIdentifierList(..) - , HasLastStrPosition(..) - , HasQuoteContext(..) - , HasReaderOptions(..) - , ParserContext(..) - , QuoteContext(..) - , SourcePos ) +import Text.Pandoc.Builder (Blocks, Inlines, trimInlines) +import Text.Pandoc.Definition (Meta (..), nullMeta) +import Text.Pandoc.Options (ReaderOptions (..)) +import Text.Pandoc.Parsing (HasHeaderMap (..), HasIdentifierList (..), + HasLastStrPosition (..), HasQuoteContext (..), + HasReaderOptions (..), ParserContext (..), + QuoteContext (..), SourcePos) -- | An inline note / footnote containing the note key and its (inline) value. type OrgNoteRecord = (String, F Blocks) @@ -191,20 +187,20 @@ data ArchivedTreesOption = -- | Export settings -- These settings can be changed via OPTIONS statements. data ExportSettings = ExportSettings - { exportArchivedTrees :: ArchivedTreesOption -- ^ How to treat archived trees - , exportDrawers :: Either [String] [String] + { 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 - , exportHeadlineLevels :: Int + , exportEmphasizedText :: Bool -- ^ Parse emphasized text + , exportHeadlineLevels :: Int -- ^ Maximum depth of headlines, deeper headlines are convert to list - , exportSmartQuotes :: Bool -- ^ Parse quotes smartly - , exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly - , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts - , exportWithAuthor :: Bool -- ^ Include author in final meta-data - , exportWithCreator :: Bool -- ^ Include creator in final meta-data - , exportWithEmail :: Bool -- ^ Include email in final meta-data + , exportSmartQuotes :: Bool -- ^ Parse quotes smartly + , exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly + , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts + , exportWithAuthor :: Bool -- ^ Include author in final meta-data + , exportWithCreator :: Bool -- ^ Include creator in final meta-data + , exportWithEmail :: Bool -- ^ Include email in final meta-data , exportWithTodoKeywords :: Bool -- ^ Keep TODO keywords in headers } -- cgit v1.2.3 From 2f8f8f0da64388fa01d83fccf3cf1f2899c64269 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sun, 12 Mar 2017 22:03:10 +0100 Subject: Issue warning for duplicate header identifiers. As noted in the previous commit, an autogenerated identifier may still coincide with an explicit identifier that is given for a header later in the document, or with an identifier on a div, span, link, or image. This commit adds a warning in this case, so users can supply an explicit identifier. * Added `DuplicateIdentifier` to LogMessage. * Modified HTML, Org, MediaWiki readers so their custom state type is an instance of HasLogMessages. This is necessary for `registerHeader` to issue warnings. See #1745. --- src/Text/Pandoc/Readers/Org/ParserState.hs | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 0bbe27991..6bed2a547 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -60,7 +60,9 @@ import qualified Data.Set as Set import Text.Pandoc.Builder (Blocks, Inlines, trimInlines) import Text.Pandoc.Definition (Meta (..), nullMeta) import Text.Pandoc.Options (ReaderOptions (..)) +import Text.Pandoc.Logging import Text.Pandoc.Parsing (HasHeaderMap (..), HasIdentifierList (..), + HasLogMessages (..), HasLastStrPosition (..), HasQuoteContext (..), HasReaderOptions (..), ParserContext (..), QuoteContext (..), SourcePos) @@ -104,6 +106,7 @@ data OrgParserState = OrgParserState , orgStateOptions :: ReaderOptions , orgStateParserContext :: ParserContext , orgStateTodoSequences :: [TodoSequence] + , orgLogMessages :: [LogMessage] } data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext } @@ -130,6 +133,10 @@ instance HasHeaderMap OrgParserState where extractHeaderMap = orgStateHeaderMap updateHeaderMap f s = s{ orgStateHeaderMap = f (orgStateHeaderMap s) } +instance HasLogMessages OrgParserState where + addLogMessage msg st = st{ orgLogMessages = msg : orgLogMessages st } + getLogMessages st = reverse $ orgLogMessages st + instance Default OrgParserState where def = defaultOrgParserState @@ -150,6 +157,7 @@ defaultOrgParserState = OrgParserState , orgStateOptions = def , orgStateParserContext = NullState , orgStateTodoSequences = [] + , orgLogMessages = [] } optionsToParserState :: ReaderOptions -> OrgParserState -- cgit v1.2.3 From 31caa616a9353e073eb86be7889b7087e14a48ac Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Thu, 27 Apr 2017 21:48:32 +0200 Subject: Provide shared F monad functions for Markdown and Org readers The `F` monads used for delayed evaluation of certain values in the Markdown and Org readers are based on a shared data type capturing the common pattern of both `F` types. --- src/Text/Pandoc/Readers/Org/ParserState.hs | 46 ++++++------------------------ 1 file changed, 9 insertions(+), 37 deletions(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 6bed2a547..bdd1dc951 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -39,7 +39,7 @@ module Text.Pandoc.Readers.Org.ParserState , TodoState (..) , activeTodoMarkers , registerTodoSequence - , F(..) + , F , askF , asksF , trimInlinesF @@ -50,14 +50,13 @@ module Text.Pandoc.Readers.Org.ParserState , optionsToParserState ) where -import Control.Monad (liftM, liftM2) -import Control.Monad.Reader (Reader, ReaderT, ask, asks, local, runReader) +import Control.Monad.Reader (ReaderT, asks, local) import Data.Default (Default (..)) import qualified Data.Map as M import qualified Data.Set as Set -import Text.Pandoc.Builder (Blocks, Inlines, trimInlines) +import Text.Pandoc.Builder (Blocks, Inlines) import Text.Pandoc.Definition (Meta (..), nullMeta) import Text.Pandoc.Options (ReaderOptions (..)) import Text.Pandoc.Logging @@ -65,7 +64,12 @@ import Text.Pandoc.Parsing (HasHeaderMap (..), HasIdentifierList (..), HasLogMessages (..), HasLastStrPosition (..), HasQuoteContext (..), HasReaderOptions (..), ParserContext (..), - QuoteContext (..), SourcePos) + QuoteContext (..), SourcePos, Future, + askF, asksF, returnF, runF, trimInlinesF) + +-- | This is used to delay evaluation until all relevant information has been +-- parsed and made available in the parser state. +type F = Future OrgParserState -- | An inline note / footnote containing the note key and its (inline) value. type OrgNoteRecord = (String, F Blocks) @@ -229,35 +233,3 @@ defaultExportSettings = ExportSettings , exportWithEmail = True , exportWithTodoKeywords = True } - - --- --- Parser state reader --- - --- | Reader monad wrapping the parser state. This is used to delay evaluation --- until all relevant information has been parsed and made available in the --- parser state. See also the newtype of the same name in --- Text.Pandoc.Parsing. -newtype F a = F { unF :: Reader OrgParserState a - } deriving (Functor, Applicative, Monad) - -instance Monoid a => Monoid (F a) where - mempty = return mempty - mappend = liftM2 mappend - mconcat = fmap mconcat . sequence - -runF :: F a -> OrgParserState -> a -runF = runReader . unF - -askF :: F OrgParserState -askF = F ask - -asksF :: (OrgParserState -> a) -> F a -asksF f = F $ asks f - -trimInlinesF :: F Inlines -> F Inlines -trimInlinesF = liftM trimInlines - -returnF :: Monad m => a -> m (F a) -returnF = return . return -- cgit v1.2.3 From da8c153a6872a040440f8853a37f559bb3b26b02 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 6 May 2017 10:59:40 +0200 Subject: Org reader: support macros Closes: #3401 --- src/Text/Pandoc/Readers/Org/ParserState.hs | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index bdd1dc951..e47565814 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -39,6 +39,9 @@ module Text.Pandoc.Readers.Org.ParserState , TodoState (..) , activeTodoMarkers , registerTodoSequence + , MacroExpander + , lookupMacro + , registerMacro , F , askF , asksF @@ -78,6 +81,8 @@ type OrgNoteTable = [OrgNoteRecord] -- | Map of functions for link transformations. The map key is refers to the -- link-type, the corresponding function transforms the given link string. type OrgLinkFormatters = M.Map String (String -> String) +-- | Macro expander function +type MacroExpander = [String] -> String -- | The states in which a todo item can be data TodoState = Todo | Done @@ -105,6 +110,8 @@ data OrgParserState = OrgParserState , orgStateLastPreCharPos :: Maybe SourcePos , orgStateLastStrPos :: Maybe SourcePos , orgStateLinkFormatters :: OrgLinkFormatters + , orgStateMacros :: M.Map String MacroExpander + , orgStateMacroDepth :: Int , orgStateMeta :: F Meta , orgStateNotes' :: OrgNoteTable , orgStateOptions :: ReaderOptions @@ -156,6 +163,8 @@ defaultOrgParserState = OrgParserState , orgStateLastPreCharPos = Nothing , orgStateLastStrPos = Nothing , orgStateLinkFormatters = M.empty + , orgStateMacros = M.empty + , orgStateMacroDepth = 0 , orgStateMeta = return nullMeta , orgStateNotes' = [] , orgStateOptions = def @@ -185,6 +194,15 @@ activeTodoSequences st = activeTodoMarkers :: OrgParserState -> TodoSequence activeTodoMarkers = concat . activeTodoSequences +lookupMacro :: String -> OrgParserState -> Maybe MacroExpander +lookupMacro macroName = M.lookup macroName . orgStateMacros + +registerMacro :: (String, MacroExpander) -> OrgParserState -> OrgParserState +registerMacro (name, expander) st = + let curMacros = orgStateMacros st + in st{ orgStateMacros = M.insert name expander curMacros } + + -- -- Export Settings -- cgit v1.2.3 From 965f1ddd4a9d1317455094b8c41016624d92f8ce Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 13 May 2017 23:30:13 +0200 Subject: Update dates in copyright notices This follows the suggestions given by the FSF for GPL licensed software. --- src/Text/Pandoc/Readers/Org/ParserState.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index e47565814..f530d1d03 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -2,7 +2,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {- -Copyright (C) 2014-2016 Albert Krewinkel +Copyright (C) 2014-2017 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 @@ -21,7 +21,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.Org.Options - Copyright : Copyright (C) 2014-2016 Albert Krewinkel + Copyright : Copyright (C) 2014-2017 Albert Krewinkel License : GNU GPL, version 2 or above Maintainer : Albert Krewinkel -- cgit v1.2.3 From af4bf91c5925b5c6a7431cef8a7997c16d4c7b2b Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sun, 14 May 2017 12:45:31 +0200 Subject: Org reader: add basic file inclusion mechanism Support for the `#+INCLUDE:` file inclusion mechanism was added. Recognized include types are *example*, *export*, *src*, and normal org file inclusion. Advanced features like line numbers and level selection are not implemented yet. Closes: #3510 --- src/Text/Pandoc/Readers/Org/ParserState.hs | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index f530d1d03..51666fc64 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -66,7 +66,8 @@ import Text.Pandoc.Logging import Text.Pandoc.Parsing (HasHeaderMap (..), HasIdentifierList (..), HasLogMessages (..), HasLastStrPosition (..), HasQuoteContext (..), - HasReaderOptions (..), ParserContext (..), + HasReaderOptions (..), HasIncludeFiles (..), + ParserContext (..), QuoteContext (..), SourcePos, Future, askF, asksF, returnF, runF, trimInlinesF) @@ -106,6 +107,7 @@ data OrgParserState = OrgParserState , orgStateExportSettings :: ExportSettings , orgStateHeaderMap :: M.Map Inlines String , orgStateIdentifiers :: Set.Set String + , orgStateIncludeFiles :: [String] , orgStateLastForbiddenCharPos :: Maybe SourcePos , orgStateLastPreCharPos :: Maybe SourcePos , orgStateLastStrPos :: Maybe SourcePos @@ -148,6 +150,12 @@ instance HasLogMessages OrgParserState where addLogMessage msg st = st{ orgLogMessages = msg : orgLogMessages st } getLogMessages st = reverse $ orgLogMessages st +instance HasIncludeFiles OrgParserState where + getIncludeFiles = orgStateIncludeFiles + addIncludeFile f st = st { orgStateIncludeFiles = f : orgStateIncludeFiles st } + dropLatestIncludeFile st = + st { orgStateIncludeFiles = drop 1 $ orgStateIncludeFiles st } + instance Default OrgParserState where def = defaultOrgParserState @@ -159,6 +167,7 @@ defaultOrgParserState = OrgParserState , orgStateExportSettings = def , orgStateHeaderMap = M.empty , orgStateIdentifiers = Set.empty + , orgStateIncludeFiles = [] , orgStateLastForbiddenCharPos = Nothing , orgStateLastPreCharPos = Nothing , orgStateLastStrPos = Nothing -- cgit v1.2.3 From 7a09b7b21dbbee34332047d07eae88fe152340b8 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Thu, 18 May 2017 23:12:17 +0200 Subject: Org reader: fix smart parsing behavior Parsing of smart quotes and special characters can either be enabled via the `smart` language extension or the `'` and `-` export options. Smart parsing is active if either the extension or export option is enabled. Only smart parsing of special characters (like ellipses and en and em dashes) is enabled by default, while smart quotes are disabled. This means that all smart parsing features will be enabled by adding the `smart` language extension. Fine-grained control is possible by leaving the language extension disabled. In that case, smart parsing is controlled via the aforementioned export OPTIONS only. Previously, all smart parsing was disabled unless the language extension was enabled. --- src/Text/Pandoc/Readers/Org/ParserState.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 51666fc64..1736cd881 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -252,7 +252,7 @@ defaultExportSettings = ExportSettings , exportDrawers = Left ["LOGBOOK"] , exportEmphasizedText = True , exportHeadlineLevels = 3 - , exportSmartQuotes = True + , exportSmartQuotes = False , exportSpecialStrings = True , exportSubSuperscripts = True , exportWithAuthor = True -- cgit v1.2.3 From 4b98d0459a8f3486ee4c63149746476e1e6dde80 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 31 May 2017 20:01:04 +0200 Subject: Org reader: fix module names in haddock comments Copy-pasting had lead to haddock module descriptions containing the wrong module names. --- src/Text/Pandoc/Readers/Org/ParserState.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 1736cd881..adc3b313e 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} {- | - Module : Text.Pandoc.Readers.Org.Options + Module : Text.Pandoc.Readers.Org.ParserState Copyright : Copyright (C) 2014-2017 Albert Krewinkel License : GNU GPL, version 2 or above -- cgit v1.2.3 From e1a066668921e60dd3ca1e1154a5741650294463 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 31 May 2017 21:26:07 +0200 Subject: Org reader: respect export option for tags Tags are appended to headlines by default, but will be omitted when the `tags` export option is set to nil. Closes: #3713 --- src/Text/Pandoc/Readers/Org/ParserState.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index adc3b313e..4520a5552 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -240,6 +240,7 @@ data ExportSettings = ExportSettings , exportWithAuthor :: Bool -- ^ Include author in final meta-data , exportWithCreator :: Bool -- ^ Include creator in final meta-data , exportWithEmail :: Bool -- ^ Include email in final meta-data + , exportWithTags :: Bool -- ^ Keep tags as part of headlines , exportWithTodoKeywords :: Bool -- ^ Keep TODO keywords in headers } @@ -258,5 +259,6 @@ defaultExportSettings = ExportSettings , exportWithAuthor = True , exportWithCreator = True , exportWithEmail = True + , exportWithTags = True , exportWithTodoKeywords = True } -- cgit v1.2.3 From d55f01c65f0a149b0951d4350293622385cceae9 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 2 Jun 2017 23:54:15 +0200 Subject: Org reader: apply hlint suggestions --- src/Text/Pandoc/Readers/Org/ParserState.hs | 1 - 1 file changed, 1 deletion(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 4520a5552..6a78ce276 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -1,5 +1,4 @@ {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {- Copyright (C) 2014-2017 Albert Krewinkel -- cgit v1.2.3 From 55d679e382954dd458acd6233609851748522d99 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Sat, 3 Jun 2017 12:28:52 +0200 Subject: Improve code style in lua and org modules --- src/Text/Pandoc/Readers/Org/ParserState.hs | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 6a78ce276..92f868516 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -1,5 +1,5 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} {- Copyright (C) 2014-2017 Albert Krewinkel @@ -60,15 +60,14 @@ import qualified Data.Set as Set import Text.Pandoc.Builder (Blocks, Inlines) import Text.Pandoc.Definition (Meta (..), nullMeta) -import Text.Pandoc.Options (ReaderOptions (..)) import Text.Pandoc.Logging -import Text.Pandoc.Parsing (HasHeaderMap (..), HasIdentifierList (..), - HasLogMessages (..), - HasLastStrPosition (..), HasQuoteContext (..), - HasReaderOptions (..), HasIncludeFiles (..), - ParserContext (..), - QuoteContext (..), SourcePos, Future, - askF, asksF, returnF, runF, trimInlinesF) +import Text.Pandoc.Options (ReaderOptions (..)) +import Text.Pandoc.Parsing (Future, HasHeaderMap (..), HasIdentifierList (..), + HasIncludeFiles (..), HasLastStrPosition (..), + HasLogMessages (..), HasQuoteContext (..), + HasReaderOptions (..), ParserContext (..), + QuoteContext (..), SourcePos, askF, asksF, returnF, + runF, trimInlinesF) -- | This is used to delay evaluation until all relevant information has been -- parsed and made available in the parser state. -- cgit v1.2.3 From 0feb7504b1c68cef76b30ea9987e2eae3101714c Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sat, 1 Jul 2017 19:31:43 +0200 Subject: Rewrote LaTeX reader with proper tokenization. This rewrite is primarily motivated by the need to get macros working properly. A side benefit is that the reader is significantly faster (27s -> 19s in one benchmark, and there is a lot of room for further optimization). We now tokenize the input text, then parse the token stream. Macros modify the token stream, so they should now be effective in any context, including math. Thus, we no longer need the clunky macro processing capacities of texmath. A custom state LaTeXState is used instead of ParserState. This, plus the tokenization, will require some rewriting of the exported functions rawLaTeXInline, inlineCommand, rawLaTeXBlock. * Added Text.Pandoc.Readers.LaTeX.Types (new exported module). Exports Macro, Tok, TokType, Line, Column. [API change] * Text.Pandoc.Parsing: adjusted type of `insertIncludedFile` so it can be used with token parser. * Removed old texmath macro stuff from Parsing. Use Macro from Text.Pandoc.Readers.LaTeX.Types instead. * Removed texmath macro material from Markdown reader. * Changed types for Text.Pandoc.Readers.LaTeX's rawLaTeXInline and rawLaTeXBlock. (Both now return a String, and they are polymorphic in state.) * Added orgMacros field to OrgState. [API change] * Removed readerApplyMacros from ReaderOptions. Now we just check the `latex_macros` reader extension. * Allow `\newcommand\foo{blah}` without braces. Fixes #1390. Fixes #2118. Fixes #3236. Fixes #3779. Fixes #934. Fixes #982. --- src/Text/Pandoc/Readers/Org/ParserState.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 92f868516..fc98213fb 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -33,6 +33,7 @@ module Text.Pandoc.Readers.Org.ParserState , OrgNoteRecord , HasReaderOptions (..) , HasQuoteContext (..) + , HasMacros (..) , TodoMarker (..) , TodoSequence , TodoState (..) @@ -57,14 +58,17 @@ import Control.Monad.Reader (ReaderT, asks, local) import Data.Default (Default (..)) import qualified Data.Map as M import qualified Data.Set as Set +import Data.Text (Text) import Text.Pandoc.Builder (Blocks, Inlines) import Text.Pandoc.Definition (Meta (..), nullMeta) import Text.Pandoc.Logging import Text.Pandoc.Options (ReaderOptions (..)) +import Text.Pandoc.Readers.LaTeX.Types (Macro) import Text.Pandoc.Parsing (Future, HasHeaderMap (..), HasIdentifierList (..), HasIncludeFiles (..), HasLastStrPosition (..), HasLogMessages (..), HasQuoteContext (..), + HasMacros (..), HasReaderOptions (..), ParserContext (..), QuoteContext (..), SourcePos, askF, asksF, returnF, runF, trimInlinesF) @@ -118,6 +122,7 @@ data OrgParserState = OrgParserState , orgStateParserContext :: ParserContext , orgStateTodoSequences :: [TodoSequence] , orgLogMessages :: [LogMessage] + , orgMacros :: M.Map Text Macro } data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext } @@ -148,6 +153,10 @@ instance HasLogMessages OrgParserState where addLogMessage msg st = st{ orgLogMessages = msg : orgLogMessages st } getLogMessages st = reverse $ orgLogMessages st +instance HasMacros OrgParserState where + extractMacros st = orgMacros st + updateMacros f st = st{ orgMacros = f (orgMacros st) } + instance HasIncludeFiles OrgParserState where getIncludeFiles = orgStateIncludeFiles addIncludeFile f st = st { orgStateIncludeFiles = f : orgStateIncludeFiles st } @@ -178,6 +187,7 @@ defaultOrgParserState = OrgParserState , orgStateParserContext = NullState , orgStateTodoSequences = [] , orgLogMessages = [] + , orgMacros = M.empty } optionsToParserState :: ReaderOptions -> OrgParserState -- cgit v1.2.3 From 514662e544a828e6c3904d2fec0216dc19bbcb9f Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Mon, 2 Oct 2017 23:11:58 +0200 Subject: Org reader: support `\n` export option The `\n` export option turns all newlines in the text into hard linebreaks. Closes #3950 --- src/Text/Pandoc/Readers/Org/ParserState.hs | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index fc98213fb..0349f7617 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -242,6 +242,7 @@ data ExportSettings = ExportSettings , exportEmphasizedText :: Bool -- ^ Parse emphasized text , exportHeadlineLevels :: Int -- ^ Maximum depth of headlines, deeper headlines are convert to list + , exportPreserveBreaks :: Bool -- ^ Whether to preserve linebreaks , exportSmartQuotes :: Bool -- ^ Parse quotes smartly , exportSpecialStrings :: Bool -- ^ Parse ellipses and dashes smartly , exportSubSuperscripts :: Bool -- ^ TeX-like syntax for sub- and superscripts @@ -261,6 +262,7 @@ defaultExportSettings = ExportSettings , exportDrawers = Left ["LOGBOOK"] , exportEmphasizedText = True , exportHeadlineLevels = 3 + , exportPreserveBreaks = False , exportSmartQuotes = False , exportSpecialStrings = True , exportSubSuperscripts = True -- cgit v1.2.3 From ff16db1aa306113132cc6cfaa70791a0db75e0a5 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 27 Oct 2017 20:28:29 -0700 Subject: Automatic reformating by stylish-haskell. --- src/Text/Pandoc/Readers/Org/ParserState.hs | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index 0349f7617..e0045fcd5 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -64,14 +64,13 @@ import Text.Pandoc.Builder (Blocks, Inlines) import Text.Pandoc.Definition (Meta (..), nullMeta) import Text.Pandoc.Logging import Text.Pandoc.Options (ReaderOptions (..)) -import Text.Pandoc.Readers.LaTeX.Types (Macro) import Text.Pandoc.Parsing (Future, HasHeaderMap (..), HasIdentifierList (..), HasIncludeFiles (..), HasLastStrPosition (..), - HasLogMessages (..), HasQuoteContext (..), - HasMacros (..), - HasReaderOptions (..), ParserContext (..), - QuoteContext (..), SourcePos, askF, asksF, returnF, - runF, trimInlinesF) + HasLogMessages (..), HasMacros (..), + HasQuoteContext (..), HasReaderOptions (..), + ParserContext (..), QuoteContext (..), SourcePos, + askF, asksF, returnF, runF, trimInlinesF) +import Text.Pandoc.Readers.LaTeX.Types (Macro) -- | This is used to delay evaluation until all relevant information has been -- parsed and made available in the parser state. -- cgit v1.2.3 From 0d935bd081bb4013168dc114461ab7c47fec2f44 Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 5 Jan 2018 20:19:47 +0100 Subject: Update copyright notices to include 2018 --- src/Text/Pandoc/Readers/Org/ParserState.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index e0045fcd5..e2acce5bf 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -1,7 +1,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {- -Copyright (C) 2014-2017 Albert Krewinkel +Copyright (C) 2014-2018 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 @@ -20,7 +20,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Readers.Org.ParserState - Copyright : Copyright (C) 2014-2017 Albert Krewinkel + Copyright : Copyright (C) 2014-2018 Albert Krewinkel License : GNU GPL, version 2 or above Maintainer : Albert Krewinkel -- cgit v1.2.3 From 00d20ccd09a8542fda631ab16c7f569098f2918d Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Wed, 21 Feb 2018 08:53:29 +0100 Subject: Org reader: allow changing emphasis syntax The characters allowed before and after emphasis can be configured via `#+pandoc-emphasis-pre` and `#+pandoc-emphasis-post`, respectively. This allows to change which strings are recognized as emphasized text on a per-document or even per-paragraph basis. The allowed characters must be given as (Haskell) string. #+pandoc-emphasis-pre: "-\t ('\"{" #+pandoc-emphasis-post: "-\t\n .,:!?;'\")}[" If the argument cannot be read as a string, the default value is restored. Closes: #4378 --- src/Text/Pandoc/Readers/Org/ParserState.hs | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) (limited to 'src/Text/Pandoc/Readers/Org/ParserState.hs') diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs index e2acce5bf..6316766fa 100644 --- a/src/Text/Pandoc/Readers/Org/ParserState.hs +++ b/src/Text/Pandoc/Readers/Org/ParserState.hs @@ -29,6 +29,7 @@ Define the Org-mode parser state. -} module Text.Pandoc.Readers.Org.ParserState ( OrgParserState (..) + , defaultOrgParserState , OrgParserLocal (..) , OrgNoteRecord , HasReaderOptions (..) @@ -104,6 +105,11 @@ type TodoSequence = [TodoMarker] data OrgParserState = OrgParserState { orgStateAnchorIds :: [String] , orgStateEmphasisCharStack :: [Char] + , orgStateEmphasisPreChars :: [Char] -- ^ Chars allowed to occur before + -- emphasis; spaces and newlines are + -- always ok in addition to what is + -- specified here. + , orgStateEmphasisPostChars :: [Char] -- ^ Chars allowed at after emphasis , orgStateEmphasisNewlines :: Maybe Int , orgStateExportSettings :: ExportSettings , orgStateHeaderMap :: M.Map Inlines String @@ -124,7 +130,9 @@ data OrgParserState = OrgParserState , orgMacros :: M.Map Text Macro } -data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext } +data OrgParserLocal = OrgParserLocal + { orgLocalQuoteContext :: QuoteContext + } instance Default OrgParserLocal where def = OrgParserLocal NoQuote @@ -168,6 +176,8 @@ instance Default OrgParserState where defaultOrgParserState :: OrgParserState defaultOrgParserState = OrgParserState { orgStateAnchorIds = [] + , orgStateEmphasisPreChars = "-\t ('\"{" + , orgStateEmphasisPostChars = "-\t\n .,:!?;'\")}[" , orgStateEmphasisCharStack = [] , orgStateEmphasisNewlines = Nothing , orgStateExportSettings = def -- cgit v1.2.3