From 512bf2eebf5d59916b1154ef2025d776b367c035 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Mon, 30 May 2016 15:07:50 +0200
Subject: [PATCH] Org reader: undo code duplication
Some code was duplicated (copy-pasted) or placed in an inappropriate
module during the modularization refactoring. Those functions are moved
into a `Shared` module, as was originally intended but forgotten.
Better documentation of the respective functions is a positive
side-effect.
---
pandoc.cabal | 1 +
src/Text/Pandoc/Readers/Org/Blocks.hs | 24 +-------
src/Text/Pandoc/Readers/Org/Inlines.hs | 38 ++-----------
src/Text/Pandoc/Readers/Org/Shared.hs | 76 ++++++++++++++++++++++++++
4 files changed, 84 insertions(+), 55 deletions(-)
create mode 100644 src/Text/Pandoc/Readers/Org/Shared.hs
diff --git a/pandoc.cabal b/pandoc.cabal
index 7d7250a21..0484b3293 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -398,6 +398,7 @@ Library
Text.Pandoc.Readers.Org.Inlines,
Text.Pandoc.Readers.Org.ParserState,
Text.Pandoc.Readers.Org.Parsing,
+ Text.Pandoc.Readers.Org.Shared,
Text.Pandoc.Writers.Shared,
Text.Pandoc.Asciify,
Text.Pandoc.MIME,
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index 36645a356..e26beffdc 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -35,6 +35,9 @@ import Text.Pandoc.Readers.Org.BlockStarts
import Text.Pandoc.Readers.Org.Inlines
import Text.Pandoc.Readers.Org.ParserState
import Text.Pandoc.Readers.Org.Parsing
+import Text.Pandoc.Readers.Org.Shared
+ ( isImageFilename, rundocBlockClass, toRundocAttrib
+ , translateLang )
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Builder ( Inlines, Blocks )
@@ -43,7 +46,6 @@ import Text.Pandoc.Compat.Monoid ((<>))
import Text.Pandoc.Options
import Text.Pandoc.Shared ( compactify', compactify'DL )
-import Control.Arrow ( first )
import Control.Monad ( foldM, guard, mzero )
import Data.Char ( isSpace, toLower, toUpper)
import Data.List ( foldl', intersperse, isPrefixOf )
@@ -314,7 +316,6 @@ codeHeaderArgs = try $ do
else ([ pandocLang ], parameters)
where
hasRundocParameters = not . null
- toRundocAttrib = first ("rundoc-" ++)
switch :: OrgParser (Char, Maybe String)
switch = try $ simpleSwitch <|> lineNumbersSwitch
@@ -323,25 +324,6 @@ switch = try $ simpleSwitch <|> lineNumbersSwitch
lineNumbersSwitch = (\ls -> ('l', Just ls)) <$>
(string "-l \"" *> many1Till nonspaceChar (char '"'))
-translateLang :: String -> String
-translateLang "C" = "c"
-translateLang "C++" = "cpp"
-translateLang "emacs-lisp" = "commonlisp" -- emacs lisp is not supported
-translateLang "js" = "javascript"
-translateLang "lisp" = "commonlisp"
-translateLang "R" = "r"
-translateLang "sh" = "bash"
-translateLang "sqlite" = "sql"
-translateLang cs = cs
-
--- | Prefix used for Rundoc classes and arguments.
-rundocPrefix :: String
-rundocPrefix = "rundoc-"
-
--- | The class-name used to mark rundoc blocks.
-rundocBlockClass :: String
-rundocBlockClass = rundocPrefix ++ "block"
-
blockOption :: OrgParser (String, String)
blockOption = try $ do
argKey <- orgArgKey
diff --git a/src/Text/Pandoc/Readers/Org/Inlines.hs b/src/Text/Pandoc/Readers/Org/Inlines.hs
index 6971ca3c6..be7fc600a 100644
--- a/src/Text/Pandoc/Readers/Org/Inlines.hs
+++ b/src/Text/Pandoc/Readers/Org/Inlines.hs
@@ -30,13 +30,15 @@ module Text.Pandoc.Readers.Org.Inlines
( inline
, inlines
, addToNotesTable
- , isImageFilename
, linkTarget
) where
import Text.Pandoc.Readers.Org.BlockStarts
import Text.Pandoc.Readers.Org.ParserState
import Text.Pandoc.Readers.Org.Parsing
+import Text.Pandoc.Readers.Org.Shared
+ ( isImageFilename, rundocBlockClass, toRundocAttrib
+ , translateLang )
import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Builder ( Inlines )
@@ -47,35 +49,12 @@ import Text.Pandoc.Readers.LaTeX ( inlineCommand, rawLaTeXInline )
import Text.TeXMath ( readTeX, writePandoc, DisplayType(..) )
import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap
-import Control.Arrow ( first )
import Control.Monad ( guard, mplus, mzero, when )
import Data.Char ( isAlphaNum, isSpace )
-import Data.List ( isPrefixOf, isSuffixOf )
+import Data.List ( isPrefixOf )
import Data.Maybe ( fromMaybe )
import qualified Data.Map as M
--- | Prefix used for Rundoc classes and arguments.
-rundocPrefix :: String
-rundocPrefix = "rundoc-"
-
--- | The class-name used to mark rundoc blocks.
-rundocBlockClass :: String
-rundocBlockClass = rundocPrefix ++ "block"
-
-toRundocAttrib :: (String, String) -> (String, String)
-toRundocAttrib = first ("rundoc-" ++)
-
-translateLang :: String -> String
-translateLang "C" = "c"
-translateLang "C++" = "cpp"
-translateLang "emacs-lisp" = "commonlisp" -- emacs lisp is not supported
-translateLang "js" = "javascript"
-translateLang "lisp" = "commonlisp"
-translateLang "R" = "r"
-translateLang "sh" = "bash"
-translateLang "sqlite" = "sql"
-translateLang cs = cs
-
--
-- Functions acting on the parser state
--
@@ -405,15 +384,6 @@ cleanLinkString s =
in all (\c -> isAlphaNum c || c `elem` (".-"::String)) scheme
&& not (null path)
-isImageFilename :: String -> Bool
-isImageFilename filename =
- any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&
- (any (\x -> (x++":") `isPrefixOf` filename) protocols ||
- ':' `notElem` filename)
- where
- imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
- protocols = [ "file", "http", "https" ]
-
internalLink :: String -> Inlines -> F Inlines
internalLink link title = do
anchorB <- (link `elem`) <$> asksF orgStateAnchorIds
diff --git a/src/Text/Pandoc/Readers/Org/Shared.hs b/src/Text/Pandoc/Readers/Org/Shared.hs
new file mode 100644
index 000000000..3ba46b9e4
--- /dev/null
+++ b/src/Text/Pandoc/Readers/Org/Shared.hs
@@ -0,0 +1,76 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-
+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) 2014-2016 Albert Krewinkel
+ License : GNU GPL, version 2 or above
+
+ Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+Utility functions used in other Pandoc Org modules.
+-}
+module Text.Pandoc.Readers.Org.Shared
+ ( isImageFilename
+ , rundocBlockClass
+ , toRundocAttrib
+ , translateLang
+ ) where
+
+import Control.Arrow ( first )
+import Data.List ( isPrefixOf, isSuffixOf )
+
+
+-- | Check whether the given string looks like the path to of URL of an image.
+isImageFilename :: String -> Bool
+isImageFilename filename =
+ any (\x -> ('.':x) `isSuffixOf` filename) imageExtensions &&
+ (any (\x -> (x++":") `isPrefixOf` filename) protocols ||
+ ':' `notElem` filename)
+ where
+ imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]
+ protocols = [ "file", "http", "https" ]
+
+-- | Prefix used for Rundoc classes and arguments.
+rundocPrefix :: String
+rundocPrefix = "rundoc-"
+
+-- | The class-name used to mark rundoc blocks.
+rundocBlockClass :: String
+rundocBlockClass = rundocPrefix ++ "block"
+
+-- | Prefix the name of a attribute, marking it as a code execution parameter.
+toRundocAttrib :: (String, String) -> (String, String)
+toRundocAttrib = first (rundocPrefix ++)
+
+-- | Translate from Org-mode's programming language identifiers to those used
+-- by Pandoc. This is useful to allow for proper syntax highlighting in
+-- Pandoc output.
+translateLang :: String -> String
+translateLang cs =
+ case cs of
+ "C" -> "c"
+ "C++" -> "cpp"
+ "emacs-lisp" -> "commonlisp" -- emacs lisp is not supported
+ "js" -> "javascript"
+ "lisp" -> "commonlisp"
+ "R" -> "r"
+ "sh" -> "bash"
+ "sqlite" -> "sql"
+ _ -> cs