From a27e2e8a4e6b4f8a28fe540511f48afccc503ef6 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Tue, 16 May 2017 22:42:34 +0200
Subject: Org reader: put tree parsing code into dedicated module

---
 src/Text/Pandoc/Readers/Org/DocumentTree.hs | 260 ++++++++++++++++++++++++++++
 1 file changed, 260 insertions(+)
 create mode 100644 src/Text/Pandoc/Readers/Org/DocumentTree.hs

(limited to 'src/Text/Pandoc/Readers/Org/DocumentTree.hs')

diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
new file mode 100644
index 000000000..3e2a046d4
--- /dev/null
+++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
@@ -0,0 +1,260 @@
+{-
+Copyright (C) 2014-2017 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
+-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RecordWildCards  #-}
+{-# LANGUAGE ViewPatterns     #-}
+{- |
+   Module      : Text.Pandoc.Readers.Org.DocumentTree
+   Copyright   : Copyright (C) 2014-2017 Albert Krewinkel
+   License     : GNU GPL, version 2 or above
+
+   Maintainer  : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>
+
+Parsers for org-mode headlines and document subtrees
+-}
+module Text.Pandoc.Readers.Org.DocumentTree
+  ( headline
+  , headlineToBlocks
+  ) where
+
+import Control.Monad (guard, void)
+import Data.Char (toLower, toUpper)
+import Data.Maybe (fromMaybe)
+import Data.Monoid ((<>))
+import Text.Pandoc.Builder (Blocks, Inlines)
+import Text.Pandoc.Class (PandocMonad)
+import Text.Pandoc.Definition
+import Text.Pandoc.Readers.Org.BlockStarts
+import Text.Pandoc.Readers.Org.Parsing
+import Text.Pandoc.Readers.Org.ParserState
+
+import qualified Text.Pandoc.Builder as B
+
+--
+-- Org headers
+--
+newtype Tag = Tag { fromTag :: String }
+  deriving (Show, Eq)
+
+-- | Create a tag containing the given string.
+toTag :: String -> Tag
+toTag = Tag
+
+-- | The key (also called name or type) of a property.
+newtype PropertyKey = PropertyKey { fromKey :: String }
+  deriving (Show, Eq, Ord)
+
+-- | Create a property key containing the given string.  Org mode keys are
+-- case insensitive and are hence converted to lower case.
+toPropertyKey :: String -> PropertyKey
+toPropertyKey = PropertyKey . map toLower
+
+-- | The value assigned to a property.
+newtype PropertyValue = PropertyValue { fromValue :: String }
+
+-- | Create a property value containing the given string.
+toPropertyValue :: String -> PropertyValue
+toPropertyValue = PropertyValue
+
+-- | Check whether the property value is non-nil (i.e. truish).
+isNonNil :: PropertyValue -> Bool
+isNonNil p = map toLower (fromValue p) `notElem` ["()", "{}", "nil"]
+
+-- | Key/value pairs from a PROPERTIES drawer
+type Properties = [(PropertyKey, PropertyValue)]
+
+-- | Org mode headline (i.e. a document subtree).
+data Headline = Headline
+  { headlineLevel      :: Int
+  , headlineTodoMarker :: Maybe TodoMarker
+  , headlineText       :: Inlines
+  , headlineTags       :: [Tag]
+  , headlineProperties :: Properties
+  , headlineContents   :: Blocks
+  , headlineChildren   :: [Headline]
+  }
+
+-- | Read an Org mode headline and its contents (i.e. a document subtree).
+-- @lvl@ gives the minimum acceptable level of the tree.
+headline :: PandocMonad m
+         => OrgParser m (F Blocks)
+         -> OrgParser m (F Inlines)
+         -> Int
+         -> OrgParser m (F Headline)
+headline blocks inline lvl = try $ do
+  level <- headerStart
+  guard (lvl <= level)
+  todoKw <- optionMaybe todoKeyword
+  title <- trimInlinesF . mconcat <$> manyTill inline endOfTitle
+  tags  <- option [] headerTags
+  newline
+  properties <- option mempty propertiesDrawer
+  contents   <- blocks
+  children   <- many (headline blocks inline (level + 1))
+  return $ do
+    title'    <- title
+    contents' <- contents
+    children' <- sequence children
+    return $ Headline
+      { headlineLevel = level
+      , headlineTodoMarker = todoKw
+      , headlineText = title'
+      , headlineTags = tags
+      , headlineProperties = properties
+      , headlineContents = contents'
+      , headlineChildren = children'
+      }
+ where
+   endOfTitle :: Monad m => OrgParser m ()
+   endOfTitle = void . lookAhead $ optional headerTags *> newline
+
+   headerTags :: Monad m => OrgParser m [Tag]
+   headerTags = try $
+     let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':'
+     in map toTag <$> (skipSpaces *> char ':' *> many1 tag <* skipSpaces)
+
+-- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks
+headlineToBlocks :: Monad m => Headline -> OrgParser m Blocks
+headlineToBlocks hdln@(Headline {..}) = do
+  maxHeadlineLevels <- getExportSetting exportHeadlineLevels
+  case () of
+    _ | any isNoExportTag headlineTags     -> return mempty
+    _ | any isArchiveTag  headlineTags     -> archivedHeadlineToBlocks hdln
+    _ | isCommentTitle headlineText        -> return mempty
+    _ | headlineLevel >= maxHeadlineLevels -> headlineToHeaderWithList hdln
+    _ | otherwise                          -> headlineToHeaderWithContents hdln
+
+isNoExportTag :: Tag -> Bool
+isNoExportTag = (== toTag "noexport")
+
+isArchiveTag :: Tag -> Bool
+isArchiveTag = (== toTag "ARCHIVE")
+
+-- | Check if the title starts with COMMENT.
+-- FIXME: This accesses builder internals not intended for use in situations
+-- like these.  Replace once keyword parsing is supported.
+isCommentTitle :: Inlines -> Bool
+isCommentTitle (B.toList -> (Str "COMMENT":_)) = True
+isCommentTitle _                               = False
+
+archivedHeadlineToBlocks :: Monad m => Headline -> OrgParser m Blocks
+archivedHeadlineToBlocks hdln = do
+  archivedTreesOption <- getExportSetting exportArchivedTrees
+  case archivedTreesOption of
+    ArchivedTreesNoExport     -> return mempty
+    ArchivedTreesExport       -> headlineToHeaderWithContents hdln
+    ArchivedTreesHeadlineOnly -> headlineToHeader hdln
+
+headlineToHeaderWithList :: Monad m => Headline -> OrgParser m Blocks
+headlineToHeaderWithList hdln@(Headline {..}) = do
+  maxHeadlineLevels <- getExportSetting exportHeadlineLevels
+  header        <- headlineToHeader hdln
+  listElements  <- sequence (map headlineToBlocks headlineChildren)
+  let listBlock  = if null listElements
+                   then mempty
+                   else B.orderedList listElements
+  let headerText = if maxHeadlineLevels == headlineLevel
+                   then header
+                   else flattenHeader header
+  return $ headerText <> headlineContents <> listBlock
+ where
+   flattenHeader :: Blocks -> Blocks
+   flattenHeader blks =
+     case B.toList blks of
+       (Header _ _ inlns:_) -> B.para (B.fromList inlns)
+       _                    -> mempty
+
+headlineToHeaderWithContents :: Monad m => Headline -> OrgParser m Blocks
+headlineToHeaderWithContents hdln@(Headline {..}) = do
+  header         <- headlineToHeader hdln
+  childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren)
+  return $ header <> headlineContents <> childrenBlocks
+
+headlineToHeader :: Monad m => Headline -> OrgParser m Blocks
+headlineToHeader (Headline {..}) = do
+  exportTodoKeyword <- getExportSetting exportWithTodoKeywords
+  let todoText    = if exportTodoKeyword
+                    then case headlineTodoMarker of
+                      Just kw -> todoKeywordToInlines kw <> B.space
+                      Nothing -> mempty
+                    else mempty
+  let text        = tagTitle (todoText <> headlineText) headlineTags
+  let propAttr    = propertiesToAttr headlineProperties
+  attr           <- registerHeader propAttr headlineText
+  return $ B.headerWith attr headlineLevel text
+
+todoKeyword :: Monad m => OrgParser m TodoMarker
+todoKeyword = try $ do
+  taskStates <- activeTodoMarkers <$> getState
+  let kwParser tdm = try $ (tdm <$ string (todoMarkerName tdm) <* spaceChar)
+  choice (map kwParser taskStates)
+
+todoKeywordToInlines :: TodoMarker -> Inlines
+todoKeywordToInlines tdm =
+  let todoText  = todoMarkerName tdm
+      todoState = map toLower . show $ todoMarkerState tdm
+      classes = [todoState, todoText]
+  in B.spanWith (mempty, classes, mempty) (B.str todoText)
+
+propertiesToAttr :: Properties -> Attr
+propertiesToAttr properties =
+  let
+    toStringPair prop = (fromKey (fst prop), fromValue (snd prop))
+    customIdKey = toPropertyKey "custom_id"
+    classKey    = toPropertyKey "class"
+    unnumberedKey = toPropertyKey "unnumbered"
+    specialProperties = [customIdKey, classKey, unnumberedKey]
+    id'  = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties
+    cls  = fromMaybe mempty . fmap fromValue . lookup classKey    $ properties
+    kvs' = map toStringPair . filter ((`notElem` specialProperties) . fst)
+           $ properties
+    isUnnumbered =
+      fromMaybe False . fmap isNonNil . lookup unnumberedKey $ properties
+  in
+    (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs')
+
+tagTitle :: Inlines -> [Tag] -> Inlines
+tagTitle title tags = title <> (mconcat $ map tagToInline tags)
+
+-- | Convert 
+tagToInline :: Tag -> Inlines
+tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty
+
+-- | Read a :PROPERTIES: drawer and return the key/value pairs contained
+-- within.
+propertiesDrawer :: Monad m => OrgParser m Properties
+propertiesDrawer = try $ do
+  drawerType <- drawerStart
+  guard $ map toUpper drawerType == "PROPERTIES"
+  manyTill property (try endOfDrawer)
+ where
+   property :: Monad m => OrgParser m (PropertyKey, PropertyValue)
+   property = try $ (,) <$> key <*> value
+
+   key :: Monad m => OrgParser m PropertyKey
+   key = fmap toPropertyKey . try $
+         skipSpaces *> char ':' *> many1Till nonspaceChar (char ':')
+
+   value :: Monad m => OrgParser m PropertyValue
+   value = fmap toPropertyValue . try $
+           skipSpaces *> manyTill anyChar (try $ skipSpaces *> newline)
+
+   endOfDrawer :: Monad m => OrgParser m String
+   endOfDrawer = try $
+     skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline
+
-- 
cgit v1.2.3


From 602cd6a327ad41e68e47689d3842f349cf33444d Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Tue, 16 May 2017 22:49:52 +0200
Subject: Org reader: replace `sequence . map` with `mapM`

---
 src/Text/Pandoc/Readers/Org/Blocks.hs       | 2 +-
 src/Text/Pandoc/Readers/Org/DocumentTree.hs | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

(limited to 'src/Text/Pandoc/Readers/Org/DocumentTree.hs')

diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index acede0c77..8c78e5157 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -65,7 +65,7 @@ blockList = do
   initialBlocks  <- blocks
   headlines      <- sequence <$> manyTill (headline blocks inline 1) eof
   st             <- getState
-  headlineBlocks <- fmap mconcat . sequence . map headlineToBlocks $ runF headlines st
+  headlineBlocks <- fmap mconcat . mapM headlineToBlocks $ runF headlines st
   return . B.toList $ (runF initialBlocks st) <> headlineBlocks
 
 -- | Get the meta information saved in the state.
diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
index 3e2a046d4..53ec2ef57 100644
--- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs
+++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
@@ -164,7 +164,7 @@ headlineToHeaderWithList :: Monad m => Headline -> OrgParser m Blocks
 headlineToHeaderWithList hdln@(Headline {..}) = do
   maxHeadlineLevels <- getExportSetting exportHeadlineLevels
   header        <- headlineToHeader hdln
-  listElements  <- sequence (map headlineToBlocks headlineChildren)
+  listElements  <- mapM headlineToBlocks headlineChildren
   let listBlock  = if null listElements
                    then mempty
                    else B.orderedList listElements
@@ -182,7 +182,7 @@ headlineToHeaderWithList hdln@(Headline {..}) = do
 headlineToHeaderWithContents :: Monad m => Headline -> OrgParser m Blocks
 headlineToHeaderWithContents hdln@(Headline {..}) = do
   header         <- headlineToHeader hdln
-  childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren)
+  childrenBlocks <- mconcat <$> mapM headlineToBlocks headlineChildren
   return $ header <> headlineContents <> childrenBlocks
 
 headlineToHeader :: Monad m => Headline -> OrgParser m Blocks
-- 
cgit v1.2.3


From bf93c07267bf138f4f4cab7625ff273fa2ac67cd Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sat, 27 May 2017 15:24:01 +0200
Subject: Org reader: subject full doc tree to headline transformations
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Emacs parses org documents into a tree structure, which is then
post-processed during exporting. The reader is changed to do the same,
turning the document into a single tree of headlines starting at
level 0.

Fixes: #3695
---
 src/Text/Pandoc/Readers/Org/Blocks.hs       | 10 ++++-----
 src/Text/Pandoc/Readers/Org/DocumentTree.hs | 33 ++++++++++++++++++++++++++++-
 test/Tests/Readers/Org.hs                   | 18 ++++++++++++++--
 3 files changed, 53 insertions(+), 8 deletions(-)

(limited to 'src/Text/Pandoc/Readers/Org/DocumentTree.hs')

diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index fa2f7fac5..52e990584 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -33,7 +33,7 @@ module Text.Pandoc.Readers.Org.Blocks
   ) where
 
 import Text.Pandoc.Readers.Org.BlockStarts
-import Text.Pandoc.Readers.Org.DocumentTree (headline, headlineToBlocks)
+import Text.Pandoc.Readers.Org.DocumentTree (documentTree, headlineToBlocks)
 import Text.Pandoc.Readers.Org.Inlines
 import Text.Pandoc.Readers.Org.Meta (metaExport, metaKey, metaLine)
 import Text.Pandoc.Readers.Org.ParserState
@@ -62,11 +62,11 @@ import Data.Monoid ((<>))
 -- | Get a list of blocks.
 blockList :: PandocMonad m => OrgParser m [Block]
 blockList = do
-  initialBlocks  <- blocks
-  headlines      <- sequence <$> manyTill (headline blocks inline 1) eof
+  headlines      <- documentTree blocks inline
   st             <- getState
-  headlineBlocks <- fmap mconcat . mapM headlineToBlocks $ runF headlines st
-  return . B.toList $ (runF initialBlocks st) <> headlineBlocks
+  headlineBlocks <- headlineToBlocks $ runF headlines st
+  -- ignore first headline, it's the document's title
+  return . drop 1 . B.toList $ headlineBlocks
 
 -- | Get the meta information saved in the state.
 meta :: Monad m => OrgParser m Meta
diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
index 53ec2ef57..8c2a8482a 100644
--- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs
+++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
@@ -28,7 +28,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 Parsers for org-mode headlines and document subtrees
 -}
 module Text.Pandoc.Readers.Org.DocumentTree
-  ( headline
+  ( documentTree
   , headlineToBlocks
   ) where
 
@@ -43,11 +43,42 @@ import Text.Pandoc.Readers.Org.BlockStarts
 import Text.Pandoc.Readers.Org.Parsing
 import Text.Pandoc.Readers.Org.ParserState
 
+import qualified Data.Map as Map
 import qualified Text.Pandoc.Builder as B
 
 --
 -- Org headers
 --
+
+-- | Parse input as org document tree.
+documentTree :: PandocMonad m
+             => OrgParser m (F Blocks)
+             -> OrgParser m (F Inlines)
+             -> OrgParser m (F Headline)
+documentTree blocks inline = do
+  initialBlocks <- blocks
+  headlines <- sequence <$> manyTill (headline blocks inline 1) eof
+  title <- fmap (getTitle . unMeta) . orgStateMeta <$> getState
+  return $ do
+    headlines' <- headlines
+    initialBlocks' <- initialBlocks
+    title' <- title
+    return Headline
+      { headlineLevel = 0
+      , headlineTodoMarker = Nothing
+      , headlineText = B.fromList title'
+      , headlineTags = mempty
+      , headlineProperties = mempty
+      , headlineContents = initialBlocks'
+      , headlineChildren = headlines'
+      }
+ where
+  getTitle :: Map.Map String MetaValue -> [Inline]
+  getTitle metamap =
+    case Map.lookup "title" metamap of
+      Just (MetaInlines inlns) -> inlns
+      _ -> []
+
 newtype Tag = Tag { fromTag :: String }
   deriving (Show, Eq)
 
diff --git a/test/Tests/Readers/Org.hs b/test/Tests/Readers/Org.hs
index eb5b68dc9..37ad2462b 100644
--- a/test/Tests/Readers/Org.hs
+++ b/test/Tests/Readers/Org.hs
@@ -708,16 +708,30 @@ tests =
 
           , "limit headline depth" =:
               unlines [ "#+OPTIONS: H:2"
-                      , "* section"
+                      , "* top-level section"
                       , "** subsection"
                       , "*** list item 1"
                       , "*** list item 2"
                       ] =?>
-              mconcat [ headerWith ("section", [], [])    1 "section"
+              mconcat [ headerWith ("top-level-section", [], [])    1 "top-level section"
                       , headerWith ("subsection", [], []) 2 "subsection"
                       , orderedList [ para "list item 1", para "list item 2" ]
                       ]
 
+          , "turn all headlines into lists" =:
+              unlines [ "#+OPTIONS: H:0"
+                      , "first block"
+                      , "* top-level section 1"
+                      , "** subsection"
+                      , "* top-level section 2"
+                      ] =?>
+              mconcat [ para "first block"
+                      , orderedList
+                        [ (para "top-level section 1" <>
+                           orderedList [ para "subsection" ])
+                        , para "top-level section 2" ]
+                      ]
+
           , "disable author export" =:
               unlines [ "#+OPTIONS: author:nil"
                       , "#+AUTHOR: ShyGuy"
-- 
cgit v1.2.3


From 33a1e4ae1af769eb45b671794da4984bcba25340 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Wed, 31 May 2017 20:43:30 +0200
Subject: Org reader: include tags in headlines

The Emacs default is to include tags in the headline when exporting.
Instead of just empty spans, which contain the tag name as attribute,
tags are rendered as small caps and wrapped in those spans.
Non-breaking spaces serve as separators for multiple tags.
---
 src/Text/Pandoc/Readers/Org/DocumentTree.hs | 22 +++++++++++++-----
 test/Tests/Readers/Org.hs                   | 36 +++++++++++++++--------------
 2 files changed, 35 insertions(+), 23 deletions(-)

(limited to 'src/Text/Pandoc/Readers/Org/DocumentTree.hs')

diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
index 8c2a8482a..66ccd4655 100644
--- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs
+++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
@@ -34,6 +34,7 @@ module Text.Pandoc.Readers.Org.DocumentTree
 
 import Control.Monad (guard, void)
 import Data.Char (toLower, toUpper)
+import Data.List ( intersperse )
 import Data.Maybe (fromMaybe)
 import Data.Monoid ((<>))
 import Text.Pandoc.Builder (Blocks, Inlines)
@@ -224,7 +225,7 @@ headlineToHeader (Headline {..}) = do
                       Just kw -> todoKeywordToInlines kw <> B.space
                       Nothing -> mempty
                     else mempty
-  let text        = tagTitle (todoText <> headlineText) headlineTags
+  let text        = todoText <> headlineText <> tagsToInlines headlineTags
   let propAttr    = propertiesToAttr headlineProperties
   attr           <- registerHeader propAttr headlineText
   return $ B.headerWith attr headlineLevel text
@@ -259,12 +260,21 @@ propertiesToAttr properties =
   in
     (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs')
 
-tagTitle :: Inlines -> [Tag] -> Inlines
-tagTitle title tags = title <> (mconcat $ map tagToInline tags)
+tagsToInlines :: [Tag] -> Inlines
+tagsToInlines [] = mempty
+tagsToInlines tags =
+  (B.space <>) . mconcat . intersperse (B.str "\160") . map tagToInline $ tags
+ where
+  tagToInline :: Tag -> Inlines
+  tagToInline t = tagSpan t . B.smallcaps . B.str $ fromTag t
+
+-- | Wrap the given inline in a span, marking it as a tag.
+tagSpan :: Tag -> Inlines -> Inlines
+tagSpan t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)])
+
+
+
 
--- | Convert 
-tagToInline :: Tag -> Inlines
-tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty
 
 -- | Read a :PROPERTIES: drawer and return the key/value pairs contained
 -- within.
diff --git a/test/Tests/Readers/Org.hs b/test/Tests/Readers/Org.hs
index 3302e0c3e..63b32c688 100644
--- a/test/Tests/Readers/Org.hs
+++ b/test/Tests/Readers/Org.hs
@@ -28,6 +28,10 @@ simpleTable' :: Int
              -> Blocks
 simpleTable' n = table "" (replicate n (AlignDefault, 0.0))
 
+-- | Create a span for the given tag.
+tagSpan :: String -> Inlines
+tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) . smallcaps $ str t
+
 tests :: [TestTree]
 tests =
   [ testGroup "Inlines" $
@@ -729,18 +733,17 @@ tests =
                       , "* old  :ARCHIVE:"
                       , "  boring"
                       ] =?>
-              let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
-              in mconcat [ headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE")
-                         , para "boring"
-                         ]
+              mconcat [ headerWith ("old", [], mempty) 1
+                                   ("old" <> space <> tagSpan "ARCHIVE")
+                      , para "boring"
+                      ]
 
           , "include archive tree header only" =:
               unlines [ "#+OPTIONS: arch:headline"
                       , "* old  :ARCHIVE:"
                       , "  boring"
                       ] =?>
-              let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
-              in headerWith ("old", [], mempty) 1 ("old" <> tagSpan "ARCHIVE")
+              headerWith ("old", [], mempty) 1 ("old" <> space <> tagSpan "ARCHIVE")
 
           , "limit headline depth" =:
               unlines [ "#+OPTIONS: H:2"
@@ -898,17 +901,16 @@ tests =
                     , "** Call Mom      :@PHONE:"
                     , "** Call John     :@PHONE:JOHN: "
                     ] =?>
-            let tagSpan t = spanWith ("", ["tag"], [("data-tag-name", t)]) mempty
-            in mconcat [ headerWith ("personal", [], [])
-                                    1
-                                    ("Personal" <> tagSpan "PERSONAL")
-                       , headerWith ("call-mom", [], [])
-                                    2
-                                    ("Call Mom" <> tagSpan "@PHONE")
-                       , headerWith ("call-john", [], [])
-                                    2
-                                    ("Call John" <> tagSpan "@PHONE" <> tagSpan "JOHN")
-                       ]
+            mconcat [ headerWith ("personal", [], [])
+                                 1
+                                 ("Personal " <> tagSpan "PERSONAL")
+                    , headerWith ("call-mom", [], [])
+                                 2
+                                 ("Call Mom " <> tagSpan "@PHONE")
+                    , headerWith ("call-john", [], [])
+                                 2
+                                 ("Call John " <> tagSpan "@PHONE" <> "\160" <> tagSpan "JOHN")
+                    ]
 
         , "Untagged header containing colons" =:
             "* This: is not: tagged" =?>
-- 
cgit v1.2.3


From e1a066668921e60dd3ca1e1154a5741650294463 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
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/DocumentTree.hs   | 6 +++++-
 src/Text/Pandoc/Readers/Org/ExportSettings.hs | 2 +-
 src/Text/Pandoc/Readers/Org/ParserState.hs    | 2 ++
 test/Tests/Readers/Org.hs                     | 6 ++++++
 4 files changed, 14 insertions(+), 2 deletions(-)

(limited to 'src/Text/Pandoc/Readers/Org/DocumentTree.hs')

diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
index 66ccd4655..4abbe7be8 100644
--- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs
+++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
@@ -220,12 +220,16 @@ headlineToHeaderWithContents hdln@(Headline {..}) = do
 headlineToHeader :: Monad m => Headline -> OrgParser m Blocks
 headlineToHeader (Headline {..}) = do
   exportTodoKeyword <- getExportSetting exportWithTodoKeywords
+  exportTags        <- getExportSetting exportWithTags
   let todoText    = if exportTodoKeyword
                     then case headlineTodoMarker of
                       Just kw -> todoKeywordToInlines kw <> B.space
                       Nothing -> mempty
                     else mempty
-  let text        = todoText <> headlineText <> tagsToInlines headlineTags
+  let text        = todoText <> headlineText <>
+                    if exportTags
+                    then tagsToInlines headlineTags
+                    else mempty
   let propAttr    = propertiesToAttr headlineProperties
   attr           <- registerHeader propAttr headlineText
   return $ B.headerWith attr headlineLevel text
diff --git a/src/Text/Pandoc/Readers/Org/ExportSettings.hs b/src/Text/Pandoc/Readers/Org/ExportSettings.hs
index c49b5ec07..11f0972d5 100644
--- a/src/Text/Pandoc/Readers/Org/ExportSettings.hs
+++ b/src/Text/Pandoc/Readers/Org/ExportSettings.hs
@@ -71,7 +71,7 @@ exportSetting = choice
   , ignoredSetting "pri"
   , ignoredSetting "prop"
   , ignoredSetting "stat"
-  , ignoredSetting "tags"
+  , booleanSetting "tags" (\val es -> es { exportWithTags = val })
   , ignoredSetting "tasks"
   , ignoredSetting "tex"
   , ignoredSetting "timestamp"
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
   }
diff --git a/test/Tests/Readers/Org.hs b/test/Tests/Readers/Org.hs
index 63b32c688..4644d13a0 100644
--- a/test/Tests/Readers/Org.hs
+++ b/test/Tests/Readers/Org.hs
@@ -794,6 +794,12 @@ tests =
                       , "** DONE todo export"
                       ] =?>
               headerWith ("todo-export", [], []) 2 "todo export"
+
+          , "remove tags from headlines" =:
+              unlines [ "#+OPTIONS: tags:nil"
+                      , "* Headline :hello:world:"
+                      ] =?>
+              headerWith ("headline", [], mempty) 1 "Headline"
           ]
       ]
 
-- 
cgit v1.2.3


From d55f01c65f0a149b0951d4350293622385cceae9 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Fri, 2 Jun 2017 23:54:15 +0200
Subject: Org reader: apply hlint suggestions

---
 src/Text/Pandoc/Readers/Org/BlockStarts.hs  |  9 ++--
 src/Text/Pandoc/Readers/Org/Blocks.hs       | 63 ++++++++++++++--------------
 src/Text/Pandoc/Readers/Org/DocumentTree.hs | 25 ++++++-----
 src/Text/Pandoc/Readers/Org/Inlines.hs      | 64 +++++++++++++++--------------
 src/Text/Pandoc/Readers/Org/Meta.hs         |  9 ++--
 src/Text/Pandoc/Readers/Org/ParserState.hs  |  1 -
 src/Text/Pandoc/Readers/Org/Shared.hs       |  2 +-
 7 files changed, 84 insertions(+), 89 deletions(-)

(limited to 'src/Text/Pandoc/Readers/Org/DocumentTree.hs')

diff --git a/src/Text/Pandoc/Readers/Org/BlockStarts.hs b/src/Text/Pandoc/Readers/Org/BlockStarts.hs
index fb2b52654..9c6614c99 100644
--- a/src/Text/Pandoc/Readers/Org/BlockStarts.hs
+++ b/src/Text/Pandoc/Readers/Org/BlockStarts.hs
@@ -66,7 +66,7 @@ gridTableStart = try $ skipSpaces <* char '+' <* char '-'
 
 
 latexEnvStart :: Monad m => OrgParser m String
-latexEnvStart = try $ do
+latexEnvStart = try $
   skipSpaces *> string "\\begin{"
              *> latexEnvName
              <* string "}"
@@ -97,8 +97,7 @@ orderedListStart = genericListStart orderedListMarker
   where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")
 
 drawerStart :: Monad m => OrgParser m String
-drawerStart = try $
-  skipSpaces *> drawerName <* skipSpaces <* newline
+drawerStart = try $ skipSpaces *> drawerName <* skipSpaces <* newline
  where drawerName = char ':' *> manyTill nonspaceChar (char ':')
 
 metaLineStart :: Monad m => OrgParser m ()
@@ -120,8 +119,8 @@ noteMarker = try $ do
 
 -- | Succeeds if the parser is at the end of a block.
 endOfBlock :: Monad m => OrgParser m ()
-endOfBlock = lookAhead . try $ do
-    void blankline <|> anyBlockStart
+endOfBlock = lookAhead . try $
+  void blankline <|> anyBlockStart
  where
    -- Succeeds if there is a new block starting at this position.
    anyBlockStart :: Monad m => OrgParser m ()
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index b650721b3..f669abc27 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -17,7 +17,6 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 -}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE RecordWildCards  #-}
-{-# LANGUAGE ViewPatterns     #-}
 {- |
    Module      : Text.Pandoc.Readers.Org.Blocks
    Copyright   : Copyright (C) 2014-2017 Albert Krewinkel
@@ -52,7 +51,7 @@ import Control.Monad (foldM, guard, mzero, void)
 import Data.Char (isSpace, toLower, toUpper)
 import Data.Default (Default)
 import Data.List (foldl', isPrefixOf)
-import Data.Maybe (fromMaybe, isNothing)
+import Data.Maybe (fromMaybe, isJust, isNothing)
 import Data.Monoid ((<>))
 
 --
@@ -113,7 +112,7 @@ data BlockAttributes = BlockAttributes
 
 -- | Convert BlockAttributes into pandoc Attr
 attrFromBlockAttributes :: BlockAttributes -> Attr
-attrFromBlockAttributes (BlockAttributes{..}) =
+attrFromBlockAttributes BlockAttributes{..} =
   let
     ident   = fromMaybe mempty $ lookup "id" blockAttrKeyValues
     classes = case lookup "class" blockAttrKeyValues of
@@ -142,7 +141,7 @@ blockAttributes = try $ do
                    Nothing -> return Nothing
                    Just s  -> Just <$> parseFromString inlines (s ++ "\n")
   kvAttrs' <- parseFromString keyValues . (++ "\n") $ fromMaybe mempty kvAttrs
-  return $ BlockAttributes
+  return BlockAttributes
            { blockAttrName = name
            , blockAttrLabel = label
            , blockAttrCaption = caption'
@@ -187,7 +186,7 @@ orgBlock = try $ do
   blockAttrs <- blockAttributes
   blkType <- blockHeaderStart
   ($ blkType) $
-    case (map toLower blkType) of
+    case map toLower blkType of
       "export"  -> exportBlock
       "comment" -> rawBlockLines (const mempty)
       "html"    -> rawBlockLines (return . B.rawBlock (lowercase blkType))
@@ -208,10 +207,10 @@ orgBlock = try $ do
    lowercase = map toLower
 
 rawBlockLines :: Monad m => (String   -> F Blocks) -> String -> OrgParser m (F Blocks)
-rawBlockLines f blockType = (ignHeaders *> (f <$> rawBlockContent blockType))
+rawBlockLines f blockType = ignHeaders *> (f <$> rawBlockContent blockType)
 
 parseBlockLines :: PandocMonad m => (F Blocks -> F Blocks) -> String -> OrgParser m (F Blocks)
-parseBlockLines f blockType = (ignHeaders *> (f <$> parsedBlockContent))
+parseBlockLines f blockType = ignHeaders *> (f <$> parsedBlockContent)
  where
    parsedBlockContent :: PandocMonad m => OrgParser m (F Blocks)
    parsedBlockContent = try $ do
@@ -239,8 +238,7 @@ rawBlockContent blockType = try $ do
    stripIndent strs = map (drop (shortestIndent strs)) strs
 
    shortestIndent :: [String] -> Int
-   shortestIndent = foldr min maxBound
-                    . map (length . takeWhile isSpace)
+   shortestIndent = foldr (min . length . takeWhile isSpace) maxBound
                     . filter (not . null)
 
    tabsToSpaces :: Int -> String -> String
@@ -336,13 +334,13 @@ codeHeaderArgs = try $ do
   language   <- skipSpaces *> orgArgWord
   (switchClasses, switchKv) <- switchesAsAttributes
   parameters <- manyTill blockOption newline
-  return $ ( translateLang language : switchClasses
-           , originalLang language <> switchKv <> parameters
-           )
+  return ( translateLang language : switchClasses
+         , originalLang language <> switchKv <> parameters
+         )
 
 switchesAsAttributes :: Monad m => OrgParser m ([String], [(String, String)])
 switchesAsAttributes = try $ do
-  switches <- skipSpaces *> (try $ switch `sepBy` (many1 spaceChar))
+  switches <- skipSpaces *> try (switch `sepBy` many1 spaceChar)
   return $ foldr addToAttr ([], []) switches
  where
   addToAttr :: (Char, Maybe String, SwitchPolarity)
@@ -350,7 +348,7 @@ switchesAsAttributes = try $ do
             -> ([String], [(String, String)])
   addToAttr ('n', lineNum, pol) (cls, kv) =
     let kv' = case lineNum of
-                Just num -> (("startFrom", num):kv)
+                Just num -> ("startFrom", num):kv
                 Nothing  -> kv
         cls' = case pol of
                  SwitchPlus -> "continuedSourceBlock":cls
@@ -382,7 +380,7 @@ genericSwitch :: Monad m
 genericSwitch c p = try $ do
   polarity <- switchPolarity <* char c <* skipSpaces
   arg <- optionMaybe p
-  return $ (c, arg, polarity)
+  return (c, arg, polarity)
 
 -- | Reads a line number switch option. The line number switch can be used with
 -- example and source blocks.
@@ -402,8 +400,8 @@ orgParamValue = try $
     *> noneOf "\n\r" `many1Till` endOfValue
     <* skipSpaces
  where
-  endOfValue = lookAhead $  (try $ skipSpaces <* oneOf "\n\r")
-                        <|> (try $ skipSpaces1 <* orgArgKey)
+  endOfValue = lookAhead $  try (skipSpaces <* oneOf "\n\r")
+                        <|> try (skipSpaces1 <* orgArgKey)
 
 
 --
@@ -421,7 +419,7 @@ genericDrawer = try $ do
   -- Include drawer if it is explicitly included in or not explicitly excluded
   -- from the list of drawers that should be exported.  PROPERTIES drawers are
   -- never exported.
-  case (exportDrawers . orgStateExportSettings $ state) of
+  case exportDrawers . orgStateExportSettings $ state of
     _           | name == "PROPERTIES" -> return mempty
     Left  names | name `elem`    names -> return mempty
     Right names | name `notElem` names -> return mempty
@@ -455,7 +453,7 @@ figure = try $ do
     Nothing     -> mzero
     Just imgSrc -> do
       guard (isImageFilename imgSrc)
-      let isFigure = not . isNothing $ blockAttrCaption figAttrs
+      let isFigure = isJust $ blockAttrCaption figAttrs
       return $ imageBlock isFigure figAttrs imgSrc
  where
    selfTarget :: PandocMonad m => OrgParser m String
@@ -490,8 +488,7 @@ endOfParagraph = try $ skipSpaces *> newline *> endOfBlock
 
 -- | Example code marked up by a leading colon.
 example :: Monad m => OrgParser m (F Blocks)
-example = try $ do
-  returnF . exampleCode =<< unlines <$> many1 exampleLine
+example = try $ returnF . exampleCode =<< unlines <$> many1 exampleLine
  where
    exampleLine :: Monad m => OrgParser m String
    exampleLine = try $ exampleLineStart *> anyLine
@@ -514,7 +511,7 @@ include = try $ do
   filename <- includeTarget
   blockType <- optionMaybe $ skipSpaces *> many1 alphaNum
   blocksParser <- case blockType of
-                    Just "example" -> do
+                    Just "example" ->
                       return $ pure . B.codeBlock <$> parseRaw
                     Just "export" -> do
                       format <- skipSpaces *> many (noneOf "\n\r\t ")
@@ -580,8 +577,8 @@ orgTable :: PandocMonad m => OrgParser m (F Blocks)
 orgTable = try $ do
   -- don't allow a table on the first line of a list item; org requires that
   -- tables start at first non-space character on the line
-  let isFirstInListItem st = (orgStateParserContext st == ListItemState) &&
-                             (orgStateLastPreCharPos st == Nothing)
+  let isFirstInListItem st = orgStateParserContext st == ListItemState &&
+                             isNothing (orgStateLastPreCharPos st)
   guard =<< not . isFirstInListItem <$> getState
   blockAttrs <- blockAttributes
   lookAhead tableStart
@@ -594,7 +591,7 @@ orgToPandocTable :: OrgTable
                  -> Inlines
                  -> Blocks
 orgToPandocTable (OrgTable colProps heads lns) caption =
-  let totalWidth = if any (not . isNothing) (map columnRelWidth colProps)
+  let totalWidth = if any isJust (map columnRelWidth colProps)
                    then Just . sum $ map (fromMaybe 1 . columnRelWidth) colProps
                    else Nothing
   in B.table caption (map (convertColProp totalWidth) colProps) heads lns
@@ -604,7 +601,7 @@ orgToPandocTable (OrgTable colProps heads lns) caption =
      let
        align' = fromMaybe AlignDefault $ columnAlignment colProp
        width' = fromMaybe 0 $ (\w t -> (fromIntegral w / fromIntegral t))
-                              <$> (columnRelWidth colProp)
+                              <$> columnRelWidth colProp
                               <*> totalWidth
      in (align', width')
 
@@ -630,7 +627,7 @@ tableAlignRow = try $ do
 columnPropertyCell :: Monad m => OrgParser m ColumnProperty
 columnPropertyCell = emptyCell <|> propCell <?> "alignment info"
  where
-   emptyCell = ColumnProperty Nothing Nothing <$ (try $ skipSpaces *> endOfCell)
+   emptyCell = ColumnProperty Nothing Nothing <$ try (skipSpaces *> endOfCell)
    propCell = try $ ColumnProperty
                  <$> (skipSpaces
                       *> char '<'
@@ -684,7 +681,7 @@ rowToContent tbl row =
  where
    singleRowPromotedToHeader :: OrgTable
    singleRowPromotedToHeader = case tbl of
-     OrgTable{ orgTableHeader = [], orgTableRows = b:[] } ->
+     OrgTable{ orgTableHeader = [], orgTableRows = [b] } ->
             tbl{ orgTableHeader = b , orgTableRows = [] }
      _   -> tbl
 
@@ -739,7 +736,7 @@ noteBlock = try $ do
 paraOrPlain :: PandocMonad m => OrgParser m (F Blocks)
 paraOrPlain = try $ do
   -- Make sure we are not looking at a headline
-  notFollowedBy' (char '*' *> (oneOf " *"))
+  notFollowedBy' (char '*' *> oneOf " *")
   ils <- inlines
   nl <- option False (newline *> return True)
   -- Read block as paragraph, except if we are in a list context and the block
@@ -748,7 +745,7 @@ paraOrPlain = try $ do
   try (guard nl
        *> notFollowedBy (inList *> (() <$ orderedListStart <|> bulletListStart))
        *> return (B.para <$> ils))
-    <|>  (return (B.plain <$> ils))
+    <|>  return (B.plain <$> ils)
 
 
 --
@@ -760,16 +757,16 @@ list = choice [ definitionList, bulletList, orderedList ] <?> "list"
 
 definitionList :: PandocMonad m => OrgParser m (F Blocks)
 definitionList = try $ do n <- lookAhead (bulletListStart' Nothing)
-                          fmap B.definitionList . fmap compactifyDL . sequence
+                          fmap (B.definitionList . compactifyDL) . sequence
                             <$> many1 (definitionListItem $ bulletListStart' (Just n))
 
 bulletList :: PandocMonad m => OrgParser m (F Blocks)
 bulletList = try $ do n <- lookAhead (bulletListStart' Nothing)
-                      fmap B.bulletList . fmap compactify . sequence
+                      fmap (B.bulletList . compactify) . sequence
                         <$> many1 (listItem (bulletListStart' $ Just n))
 
 orderedList :: PandocMonad m => OrgParser m (F Blocks)
-orderedList = fmap B.orderedList . fmap compactify . sequence
+orderedList = fmap (B.orderedList . compactify) . sequence
               <$> many1 (listItem orderedListStart)
 
 bulletListStart' :: Monad m => Maybe Int -> OrgParser m Int
diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
index 4abbe7be8..cee740e30 100644
--- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs
+++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
@@ -32,10 +32,10 @@ module Text.Pandoc.Readers.Org.DocumentTree
   , headlineToBlocks
   ) where
 
+import Control.Arrow ((***))
 import Control.Monad (guard, void)
 import Data.Char (toLower, toUpper)
 import Data.List ( intersperse )
-import Data.Maybe (fromMaybe)
 import Data.Monoid ((<>))
 import Text.Pandoc.Builder (Blocks, Inlines)
 import Text.Pandoc.Class (PandocMonad)
@@ -142,7 +142,7 @@ headline blocks inline lvl = try $ do
     title'    <- title
     contents' <- contents
     children' <- sequence children
-    return $ Headline
+    return Headline
       { headlineLevel = level
       , headlineTodoMarker = todoKw
       , headlineText = title'
@@ -162,7 +162,7 @@ headline blocks inline lvl = try $ do
 
 -- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks
 headlineToBlocks :: Monad m => Headline -> OrgParser m Blocks
-headlineToBlocks hdln@(Headline {..}) = do
+headlineToBlocks hdln@Headline {..} = do
   maxHeadlineLevels <- getExportSetting exportHeadlineLevels
   case () of
     _ | any isNoExportTag headlineTags     -> return mempty
@@ -193,7 +193,7 @@ archivedHeadlineToBlocks hdln = do
     ArchivedTreesHeadlineOnly -> headlineToHeader hdln
 
 headlineToHeaderWithList :: Monad m => Headline -> OrgParser m Blocks
-headlineToHeaderWithList hdln@(Headline {..}) = do
+headlineToHeaderWithList hdln@Headline {..} = do
   maxHeadlineLevels <- getExportSetting exportHeadlineLevels
   header        <- headlineToHeader hdln
   listElements  <- mapM headlineToBlocks headlineChildren
@@ -212,13 +212,13 @@ headlineToHeaderWithList hdln@(Headline {..}) = do
        _                    -> mempty
 
 headlineToHeaderWithContents :: Monad m => Headline -> OrgParser m Blocks
-headlineToHeaderWithContents hdln@(Headline {..}) = do
+headlineToHeaderWithContents hdln@Headline {..} = do
   header         <- headlineToHeader hdln
   childrenBlocks <- mconcat <$> mapM headlineToBlocks headlineChildren
   return $ header <> headlineContents <> childrenBlocks
 
 headlineToHeader :: Monad m => Headline -> OrgParser m Blocks
-headlineToHeader (Headline {..}) = do
+headlineToHeader Headline {..} = do
   exportTodoKeyword <- getExportSetting exportWithTodoKeywords
   exportTags        <- getExportSetting exportWithTags
   let todoText    = if exportTodoKeyword
@@ -237,7 +237,7 @@ headlineToHeader (Headline {..}) = do
 todoKeyword :: Monad m => OrgParser m TodoMarker
 todoKeyword = try $ do
   taskStates <- activeTodoMarkers <$> getState
-  let kwParser tdm = try $ (tdm <$ string (todoMarkerName tdm) <* spaceChar)
+  let kwParser tdm = try (tdm <$ string (todoMarkerName tdm) <* spaceChar)
   choice (map kwParser taskStates)
 
 todoKeywordToInlines :: TodoMarker -> Inlines
@@ -250,19 +250,19 @@ todoKeywordToInlines tdm =
 propertiesToAttr :: Properties -> Attr
 propertiesToAttr properties =
   let
-    toStringPair prop = (fromKey (fst prop), fromValue (snd prop))
+    toStringPair = fromKey *** fromValue
     customIdKey = toPropertyKey "custom_id"
     classKey    = toPropertyKey "class"
     unnumberedKey = toPropertyKey "unnumbered"
     specialProperties = [customIdKey, classKey, unnumberedKey]
-    id'  = fromMaybe mempty . fmap fromValue . lookup customIdKey $ properties
-    cls  = fromMaybe mempty . fmap fromValue . lookup classKey    $ properties
+    id'  = maybe mempty fromValue . lookup customIdKey $ properties
+    cls  = maybe mempty fromValue . lookup classKey    $ properties
     kvs' = map toStringPair . filter ((`notElem` specialProperties) . fst)
            $ properties
     isUnnumbered =
-      fromMaybe False . fmap isNonNil . lookup unnumberedKey $ properties
+      maybe False isNonNil . lookup unnumberedKey $ properties
   in
-    (id', words cls ++ (if isUnnumbered then ["unnumbered"] else []), kvs')
+    (id', words cls ++ ["unnumbered" | isUnnumbered], kvs')
 
 tagsToInlines :: [Tag] -> Inlines
 tagsToInlines [] = mempty
@@ -302,4 +302,3 @@ propertiesDrawer = try $ do
    endOfDrawer :: Monad m => OrgParser m String
    endOfDrawer = try $
      skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline
-
diff --git a/src/Text/Pandoc/Readers/Org/Inlines.hs b/src/Text/Pandoc/Readers/Org/Inlines.hs
index ad5a1e4de..af28701d7 100644
--- a/src/Text/Pandoc/Readers/Org/Inlines.hs
+++ b/src/Text/Pandoc/Readers/Org/Inlines.hs
@@ -48,7 +48,7 @@ import Text.Pandoc.Readers.LaTeX (inlineCommand, rawLaTeXInline)
 import Text.TeXMath (DisplayType (..), readTeX, writePandoc)
 import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap
 
-import Control.Monad (guard, mplus, mzero, void, when)
+import Control.Monad (guard, mplus, mzero, unless, void, when)
 import Control.Monad.Trans (lift)
 import Data.Char (isAlphaNum, isSpace)
 import Data.List (intersperse)
@@ -63,7 +63,7 @@ import Prelude hiding (sequence)
 --
 recordAnchorId :: PandocMonad m => String -> OrgParser m ()
 recordAnchorId i = updateState $ \s ->
-  s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }
+  s{ orgStateAnchorIds = i : orgStateAnchorIds s }
 
 pushToInlineCharStack :: PandocMonad m => Char -> OrgParser m ()
 pushToInlineCharStack c = updateState $ \s ->
@@ -184,7 +184,7 @@ cite = try $ berkeleyCite <|> do
                , orgRefCite
                , berkeleyTextualCite
                ]
-  return $ (flip B.cite (B.text raw)) <$> cs
+  return $ flip B.cite (B.text raw) <$> cs
 
 -- | A citation in Pandoc Org-mode style (@[prefix \@citekey suffix]@).
 pandocOrgCite :: PandocMonad m => OrgParser m (F [Citation])
@@ -209,7 +209,7 @@ normalOrgRefCite = try $ do
   orgRefCiteList :: PandocMonad m => CitationMode -> OrgParser m (F Citation)
   orgRefCiteList citeMode = try $ do
     key <- orgRefCiteKey
-    returnF $ Citation
+    returnF Citation
      { citationId      = key
      , citationPrefix  = mempty
      , citationSuffix  = mempty
@@ -232,11 +232,11 @@ berkeleyCite = try $ do
     return $
       if parens
       then toCite
-           . maybe id (\p -> alterFirst (prependPrefix p)) prefix
-           . maybe id (\s -> alterLast  (appendSuffix  s)) suffix
+           . maybe id (alterFirst . prependPrefix) prefix
+           . maybe id (alterLast . appendSuffix) suffix
            $ citationList
       else maybe mempty (<> " ") prefix
-             <> (toListOfCites $ map toInTextMode citationList)
+             <> toListOfCites (map toInTextMode citationList)
              <> maybe mempty (", " <>) suffix
  where
    toCite :: [Citation] -> Inlines
@@ -250,7 +250,7 @@ berkeleyCite = try $ do
 
    alterFirst, alterLast :: (a -> a) -> [a] -> [a]
    alterFirst _ []     = []
-   alterFirst f (c:cs) = (f c):cs
+   alterFirst f (c:cs) = f c : cs
    alterLast  f = reverse . alterFirst f . reverse
 
    prependPrefix, appendSuffix :: Inlines -> Citation -> Citation
@@ -271,7 +271,7 @@ berkeleyCitationList = try $ do
   skipSpaces
   commonPrefix <- optionMaybe (try $ citationListPart <* char ';')
   citations    <- citeList
-  commonSuffix <- optionMaybe (try $ citationListPart)
+  commonSuffix <- optionMaybe (try citationListPart)
   char ']'
   return (BerkeleyCitationList parens
     <$> sequence commonPrefix
@@ -344,7 +344,7 @@ orgRefCiteKey =
       isCiteKeySpecialChar c = c `elem` citeKeySpecialChars
       isCiteKeyChar c = isAlphaNum c || isCiteKeySpecialChar c
 
-  in try $ many1Till (satisfy $ isCiteKeyChar)
+  in try $ many1Till (satisfy isCiteKeyChar)
            $ try . lookAhead $ do
                many . satisfy $ isCiteKeySpecialChar
                satisfy $ not . isCiteKeyChar
@@ -374,15 +374,16 @@ citation = try $ do
   return $ do
     x <- pref
     y <- suff
-    return $ Citation{ citationId      = key
-                     , citationPrefix  = B.toList x
-                     , citationSuffix  = B.toList y
-                     , citationMode    = if suppress_author
-                                            then SuppressAuthor
-                                            else NormalCitation
-                     , citationNoteNum = 0
-                     , citationHash    = 0
-                     }
+    return Citation
+      { citationId      = key
+      , citationPrefix  = B.toList x
+      , citationSuffix  = B.toList y
+      , citationMode    = if suppress_author
+                          then SuppressAuthor
+                          else NormalCitation
+      , citationNoteNum = 0
+      , citationHash    = 0
+      }
  where
    prefix = trimInlinesF . mconcat <$>
             manyTill inline (char ']' <|> (']' <$ lookAhead citeKey))
@@ -404,7 +405,7 @@ inlineNote = try $ do
   ref <- many alphaNum
   char ':'
   note <- fmap B.para . trimInlinesF . mconcat <$> many1Till inline (char ']')
-  when (not $ null ref) $
+  unless (null ref) $
        addToNotesTable ("fn:" ++ ref, note)
   return $ B.note <$> note
 
@@ -780,7 +781,7 @@ notAfterForbiddenBorderChar = do
 -- | Read a sub- or superscript expression
 subOrSuperExpr :: PandocMonad m => OrgParser m (F Inlines)
 subOrSuperExpr = try $
-  choice [ id                   <$> charsInBalanced '{' '}' (noneOf "\n\r")
+  choice [ charsInBalanced '{' '}' (noneOf "\n\r")
          , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")
          , simpleSubOrSuperString
          ] >>= parseFromString (mconcat <$> many inline)
@@ -818,7 +819,7 @@ inlineLaTeX = try $ do
                     enableExtension Ext_raw_tex (readerExtensions def) } }
 
    texMathToPandoc :: String -> Maybe [Inline]
-   texMathToPandoc cs = (maybeRight $ readTeX cs) >>= writePandoc DisplayInline
+   texMathToPandoc cs = maybeRight (readTeX cs) >>= writePandoc DisplayInline
 
 maybeRight :: Either a b -> Maybe b
 maybeRight = either (const Nothing) Just
@@ -869,21 +870,19 @@ macro = try $ do
   eoa = string ")}}}"
 
 smart :: PandocMonad m => OrgParser m (F Inlines)
-smart = do
-  doubleQuoted <|> singleQuoted <|>
-    choice (map (return <$>) [orgApostrophe, orgDash, orgEllipses])
+smart = choice [doubleQuoted, singleQuoted, orgApostrophe, orgDash, orgEllipses]
   where
     orgDash = do
       guardOrSmartEnabled =<< getExportSetting exportSpecialStrings
-      dash <* updatePositions '-'
+      pure <$> dash <* updatePositions '-'
     orgEllipses = do
       guardOrSmartEnabled =<< getExportSetting exportSpecialStrings
-      ellipses <* updatePositions '.'
+      pure <$> ellipses <* updatePositions '.'
     orgApostrophe = do
       guardEnabled Ext_smart
       (char '\'' <|> char '\8217') <* updateLastPreCharPos
                                    <* updateLastForbiddenCharPos
-      return (B.str "\x2019")
+      returnF (B.str "\x2019")
 
 guardOrSmartEnabled :: PandocMonad m => Bool -> OrgParser m ()
 guardOrSmartEnabled b = do
@@ -908,6 +907,9 @@ doubleQuoted = try $ do
   doubleQuoteStart
   updatePositions '"'
   contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)
-  (withQuoteContext InDoubleQuote $ (doubleQuoteEnd <* updateLastForbiddenCharPos) >> return
-       (fmap B.doubleQuoted . trimInlinesF $ contents))
-   <|> (return $ return (B.str "\8220") <> contents)
+  let doubleQuotedContent = withQuoteContext InDoubleQuote $ do
+        doubleQuoteEnd
+        updateLastForbiddenCharPos
+        return . fmap B.doubleQuoted . trimInlinesF $ contents
+  let leftQuoteAndContent = return $ pure (B.str "\8220") <> contents
+  doubleQuotedContent <|> leftQuoteAndContent
diff --git a/src/Text/Pandoc/Readers/Org/Meta.hs b/src/Text/Pandoc/Readers/Org/Meta.hs
index 33c212bca..a87042871 100644
--- a/src/Text/Pandoc/Readers/Org/Meta.hs
+++ b/src/Text/Pandoc/Readers/Org/Meta.hs
@@ -84,7 +84,7 @@ metaKey = map toLower <$> many1 (noneOf ": \n\r")
                       <*  char ':'
                       <*  skipSpaces
 
-metaValue :: PandocMonad m => String -> OrgParser m (String, (F MetaValue))
+metaValue :: PandocMonad m => String -> OrgParser m (String, F MetaValue)
 metaValue key =
   let inclKey = "header-includes"
   in case key of
@@ -111,7 +111,7 @@ metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline
 
 metaInlinesCommaSeparated :: PandocMonad m => OrgParser m (F MetaValue)
 metaInlinesCommaSeparated = do
-  itemStrs <- (many1 (noneOf ",\n")) `sepBy1` (char ',')
+  itemStrs <- many1 (noneOf ",\n") `sepBy1` char ','
   newline
   items <- mapM (parseFromString inlinesTillNewline . (++ "\n")) itemStrs
   let toMetaInlines = MetaInlines . B.toList
@@ -163,7 +163,7 @@ addLinkFormat key formatter = updateState $ \s ->
   let fs = orgStateLinkFormatters s
   in s{ orgStateLinkFormatters = M.insert key formatter fs }
 
-parseLinkFormat :: Monad m => OrgParser m ((String, String -> String))
+parseLinkFormat :: Monad m => OrgParser m (String, String -> String)
 parseLinkFormat = try $ do
   linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces
   linkSubst <- parseFormat
@@ -172,8 +172,7 @@ parseLinkFormat = try $ do
 -- | An ad-hoc, single-argument-only implementation of a printf-style format
 -- parser.
 parseFormat :: Monad m => OrgParser m (String -> String)
-parseFormat = try $ do
-  replacePlain <|> replaceUrl <|> justAppend
+parseFormat = try $ replacePlain <|> replaceUrl <|> justAppend
  where
    -- inefficient, but who cares
    replacePlain = try $ (\x -> concat . flip intersperse x)
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 <tarleb+pandoc@moltkeplatz.de>
diff --git a/src/Text/Pandoc/Readers/Org/Shared.hs b/src/Text/Pandoc/Readers/Org/Shared.hs
index d9414319a..952082ec1 100644
--- a/src/Text/Pandoc/Readers/Org/Shared.hs
+++ b/src/Text/Pandoc/Readers/Org/Shared.hs
@@ -56,7 +56,7 @@ cleanLinkString s =
     '.':'/':_              -> Just s                 -- relative path
     '.':'.':'/':_          -> Just s                 -- relative path
     -- Relative path or URL (file schema)
-    'f':'i':'l':'e':':':s' -> Just $ if ("//" `isPrefixOf` s') then s else s'
+    'f':'i':'l':'e':':':s' -> Just $ if "//" `isPrefixOf` s' then s else s'
     _                      | isUrl s            -> Just s                 -- URL
     _                      -> Nothing
  where
-- 
cgit v1.2.3


From 55d679e382954dd458acd6233609851748522d99 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sat, 3 Jun 2017 12:28:52 +0200
Subject: Improve code style in lua and org modules

---
 src/Text/Pandoc/Lua.hs                      | 18 ++++++++---------
 src/Text/Pandoc/Lua/Compat.hs               |  4 ++--
 src/Text/Pandoc/Lua/PandocModule.hs         | 26 ++++++++++++-------------
 src/Text/Pandoc/Lua/SharedInstances.hs      | 12 ++++++------
 src/Text/Pandoc/Lua/StackInstances.hs       | 12 ++++++------
 src/Text/Pandoc/Lua/Util.hs                 |  6 ++----
 src/Text/Pandoc/Readers/Org/Blocks.hs       |  2 +-
 src/Text/Pandoc/Readers/Org/DocumentTree.hs |  6 +++---
 src/Text/Pandoc/Readers/Org/Inlines.hs      | 13 ++++++-------
 src/Text/Pandoc/Readers/Org/Meta.hs         | 10 +++++-----
 src/Text/Pandoc/Readers/Org/ParserState.hs  | 19 +++++++++---------
 src/Text/Pandoc/Writers/Org.hs              | 30 ++++++++++++++---------------
 12 files changed, 75 insertions(+), 83 deletions(-)

(limited to 'src/Text/Pandoc/Readers/Org/DocumentTree.hs')

diff --git a/src/Text/Pandoc/Lua.hs b/src/Text/Pandoc/Lua.hs
index f4a22b92a..f74c0e425 100644
--- a/src/Text/Pandoc/Lua.hs
+++ b/src/Text/Pandoc/Lua.hs
@@ -15,8 +15,8 @@ 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
 -}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE FlexibleInstances     #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {- |
    Module      : Text.Pandoc.Lua
@@ -30,12 +30,12 @@ Pandoc lua utils.
 -}
 module Text.Pandoc.Lua ( runLuaFilter, pushPandocModule ) where
 
-import Control.Monad ( (>=>), when )
-import Control.Monad.Trans ( MonadIO(..) )
-import Data.Map ( Map )
-import Scripting.Lua ( LuaState, StackValue(..) )
+import Control.Monad (unless, when, (>=>))
+import Control.Monad.Trans (MonadIO (..))
+import Data.Map (Map)
+import Scripting.Lua (LuaState, StackValue (..))
 import Text.Pandoc.Definition
-import Text.Pandoc.Lua.PandocModule ( pushPandocModule )
+import Text.Pandoc.Lua.PandocModule (pushPandocModule)
 import Text.Pandoc.Lua.StackInstances ()
 import Text.Pandoc.Walk
 
@@ -80,7 +80,7 @@ pushGlobalFilter lua =
   *> Lua.rawseti lua (-2) 1
 
 runAll :: [LuaFilter] -> Pandoc -> IO Pandoc
-runAll [] = return
+runAll []     = return
 runAll (x:xs) = walkMWithLuaFilter x >=> runAll xs
 
 walkMWithLuaFilter :: LuaFilter -> Pandoc -> IO Pandoc
@@ -225,7 +225,7 @@ instance StackValue LuaFilterFunction where
   push lua v = pushFilterFunction lua v
   peek lua i = do
     isFn <- Lua.isfunction lua i
-    when (not isFn) (error $ "Not a function at index " ++ (show i))
+    unless isFn (error $ "Not a function at index " ++ (show i))
     Lua.pushvalue lua i
     push lua ("PANDOC_FILTER_FUNCTIONS"::String)
     Lua.rawget lua Lua.registryindex
diff --git a/src/Text/Pandoc/Lua/Compat.hs b/src/Text/Pandoc/Lua/Compat.hs
index 998d8d032..3fc81a15c 100644
--- a/src/Text/Pandoc/Lua/Compat.hs
+++ b/src/Text/Pandoc/Lua/Compat.hs
@@ -28,13 +28,13 @@ Compatibility helpers for hslua
 -}
 module Text.Pandoc.Lua.Compat ( loadstring ) where
 
-import Scripting.Lua ( LuaState )
+import Scripting.Lua (LuaState)
 import qualified Scripting.Lua as Lua
 
 -- | Interpret string as lua code and load into the lua environment.
 loadstring :: LuaState -> String -> String -> IO Int
 #if MIN_VERSION_hslua(0,5,0)
-loadstring lua script _ = Lua.loadstring lua script
+loadstring lua script _  = Lua.loadstring lua script
 #else
 loadstring lua script cn = Lua.loadstring lua script cn
 #endif
diff --git a/src/Text/Pandoc/Lua/PandocModule.hs b/src/Text/Pandoc/Lua/PandocModule.hs
index 15f19f024..8e0f3a5b4 100644
--- a/src/Text/Pandoc/Lua/PandocModule.hs
+++ b/src/Text/Pandoc/Lua/PandocModule.hs
@@ -27,25 +27,23 @@ Pandoc module for lua.
 -}
 module Text.Pandoc.Lua.PandocModule ( pushPandocModule ) where
 
-import Data.ByteString.Char8 ( unpack )
-import Data.Default ( Default(..) )
-import Scripting.Lua ( LuaState, call, push, pushhsfunction, rawset)
-import Text.Pandoc.Class hiding ( readDataFile )
-import Text.Pandoc.Definition ( Pandoc )
-import Text.Pandoc.Lua.Compat ( loadstring )
+import Control.Monad (unless)
+import Data.ByteString.Char8 (unpack)
+import Data.Default (Default (..))
+import Scripting.Lua (LuaState, call, push, pushhsfunction, rawset)
+import Text.Pandoc.Class hiding (readDataFile)
+import Text.Pandoc.Definition (Pandoc)
+import Text.Pandoc.Lua.Compat (loadstring)
 import Text.Pandoc.Lua.StackInstances ()
-import Text.Pandoc.Readers ( Reader(..), getReader )
-import Text.Pandoc.Shared ( readDataFile )
+import Text.Pandoc.Readers (Reader (..), getReader)
+import Text.Pandoc.Shared (readDataFile)
 
 -- | Push the "pandoc" on the lua stack.
 pushPandocModule :: LuaState -> IO ()
 pushPandocModule lua = do
   script <- pandocModuleScript
   status <- loadstring lua script "pandoc.lua"
-  if (status /= 0)
-    then return ()
-    else do
-      call lua 0 1
+  unless (status /= 0) $ call lua 0 1
   push lua "__read"
   pushhsfunction lua read_doc
   rawset lua (-3)
@@ -57,13 +55,13 @@ pandocModuleScript = unpack <$> readDataFile Nothing "pandoc.lua"
 read_doc :: String -> String -> IO (Either String Pandoc)
 read_doc formatSpec content = do
   case getReader formatSpec of
-    Left s -> return $ Left s
+    Left  s      -> return $ Left s
     Right reader ->
       case reader of
         StringReader r -> do
           res <- runIO $ r def content
           case res of
-            Left s -> return . Left $ show s
+            Left s   -> return . Left $ show s
             Right pd -> return $ Right pd
         _  -> return $ Left "Only string formats are supported at the moment."
 
diff --git a/src/Text/Pandoc/Lua/SharedInstances.hs b/src/Text/Pandoc/Lua/SharedInstances.hs
index 019a82446..a5d4ba1e9 100644
--- a/src/Text/Pandoc/Lua/SharedInstances.hs
+++ b/src/Text/Pandoc/Lua/SharedInstances.hs
@@ -16,9 +16,9 @@ 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
 -}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE CPP                  #-}
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE LambdaCase           #-}
 #if !MIN_VERSION_base(4,8,0)
 {-# LANGUAGE OverlappingInstances #-}
 #endif
@@ -36,8 +36,8 @@ Shared StackValue instances for pandoc and generic types.
 -}
 module Text.Pandoc.Lua.SharedInstances () where
 
-import Scripting.Lua ( LTYPE(..), StackValue(..), newtable )
-import Text.Pandoc.Lua.Util ( addRawInt, addValue, getRawInt, keyValuePairs )
+import Scripting.Lua (LTYPE (..), StackValue (..), newtable)
+import Text.Pandoc.Lua.Util (addRawInt, addValue, getRawInt, keyValuePairs)
 
 import qualified Data.Map as M
 import qualified Text.Pandoc.UTF8 as UTF8
@@ -112,5 +112,5 @@ instance (StackValue a, StackValue b) => StackValue (Either a b) where
   peek lua idx = peek lua idx >>= \case
       Just left -> return . Just $ Left left
       Nothing   -> fmap Right <$> peek lua idx
-  valuetype (Left x) = valuetype x
+  valuetype (Left x)  = valuetype x
   valuetype (Right x) = valuetype x
diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs
index cfc4389c2..d2e3f630a 100644
--- a/src/Text/Pandoc/Lua/StackInstances.hs
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -17,7 +17,7 @@ along with this program; if not, write to the Free Software
 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 -}
 {-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {- |
    Module      : Text.Pandoc.Lua.StackInstances
@@ -32,13 +32,13 @@ StackValue instances for pandoc types.
 -}
 module Text.Pandoc.Lua.StackInstances () where
 
-import Control.Applicative ( (<|>) )
-import Scripting.Lua
-  ( LTYPE(..), LuaState, StackValue(..), ltype, newtable, objlen )
+import Control.Applicative ((<|>))
+import Scripting.Lua (LTYPE (..), LuaState, StackValue (..), ltype, newtable,
+                      objlen)
 import Text.Pandoc.Definition
 import Text.Pandoc.Lua.SharedInstances ()
-import Text.Pandoc.Lua.Util ( addValue, getTable, pushViaConstructor )
-import Text.Pandoc.Shared ( safeRead )
+import Text.Pandoc.Lua.Util (addValue, getTable, pushViaConstructor)
+import Text.Pandoc.Shared (safeRead)
 
 instance StackValue Pandoc where
   push lua (Pandoc meta blocks) = do
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index ff07ba7d7..0a704d027 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -42,10 +42,8 @@ module Text.Pandoc.Lua.Util
   , pushViaConstructor
   ) where
 
-import Scripting.Lua
-  ( LuaState, StackValue(..)
-  , call, getglobal2, gettable, next, pop, pushnil, rawgeti, rawseti, settable
-  )
+import Scripting.Lua (LuaState, StackValue (..), call, getglobal2, gettable,
+                      next, pop, pushnil, rawgeti, rawseti, settable)
 
 -- | Adjust the stack index, assuming that @n@ new elements have been pushed on
 -- the stack.
diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs
index f669abc27..3e0ab0127 100644
--- a/src/Text/Pandoc/Readers/Org/Blocks.hs
+++ b/src/Text/Pandoc/Readers/Org/Blocks.hs
@@ -351,7 +351,7 @@ switchesAsAttributes = try $ do
                 Just num -> ("startFrom", num):kv
                 Nothing  -> kv
         cls' = case pol of
-                 SwitchPlus -> "continuedSourceBlock":cls
+                 SwitchPlus  -> "continuedSourceBlock":cls
                  SwitchMinus -> cls
     in ("numberLines":cls', kv')
   addToAttr _ x = x
diff --git a/src/Text/Pandoc/Readers/Org/DocumentTree.hs b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
index cee740e30..743f6cc0e 100644
--- a/src/Text/Pandoc/Readers/Org/DocumentTree.hs
+++ b/src/Text/Pandoc/Readers/Org/DocumentTree.hs
@@ -35,14 +35,14 @@ module Text.Pandoc.Readers.Org.DocumentTree
 import Control.Arrow ((***))
 import Control.Monad (guard, void)
 import Data.Char (toLower, toUpper)
-import Data.List ( intersperse )
+import Data.List (intersperse)
 import Data.Monoid ((<>))
 import Text.Pandoc.Builder (Blocks, Inlines)
 import Text.Pandoc.Class (PandocMonad)
 import Text.Pandoc.Definition
 import Text.Pandoc.Readers.Org.BlockStarts
-import Text.Pandoc.Readers.Org.Parsing
 import Text.Pandoc.Readers.Org.ParserState
+import Text.Pandoc.Readers.Org.Parsing
 
 import qualified Data.Map as Map
 import qualified Text.Pandoc.Builder as B
@@ -78,7 +78,7 @@ documentTree blocks inline = do
   getTitle metamap =
     case Map.lookup "title" metamap of
       Just (MetaInlines inlns) -> inlns
-      _ -> []
+      _                        -> []
 
 newtype Tag = Tag { fromTag :: String }
   deriving (Show, Eq)
diff --git a/src/Text/Pandoc/Readers/Org/Inlines.hs b/src/Text/Pandoc/Readers/Org/Inlines.hs
index af28701d7..66273e05d 100644
--- a/src/Text/Pandoc/Readers/Org/Inlines.hs
+++ b/src/Text/Pandoc/Readers/Org/Inlines.hs
@@ -343,11 +343,10 @@ orgRefCiteKey =
   let citeKeySpecialChars = "-_:\\./," :: String
       isCiteKeySpecialChar c = c `elem` citeKeySpecialChars
       isCiteKeyChar c = isAlphaNum c || isCiteKeySpecialChar c
-
-  in try $ many1Till (satisfy isCiteKeyChar)
-           $ try . lookAhead $ do
-               many . satisfy $ isCiteKeySpecialChar
-               satisfy $ not . isCiteKeyChar
+      endOfCitation = try $ do
+        many $ satisfy isCiteKeySpecialChar
+        satisfy $ not . isCiteKeyChar
+  in try $ satisfy isCiteKeyChar `many1Till` lookAhead endOfCitation
 
 
 -- | Supported citation types.  Only a small subset of org-ref types is
@@ -415,7 +414,7 @@ referencedNote = try $ do
   return $ do
     notes <- asksF orgStateNotes'
     case lookup ref notes of
-      Nothing   -> return $ B.str $ "[" ++ ref ++ "]"
+      Nothing   -> return . B.str $ "[" ++ ref ++ "]"
       Just contents  -> do
         st <- askF
         let contents' = runF contents st{ orgStateNotes' = [] }
@@ -439,7 +438,7 @@ explicitOrImageLink = try $ do
     src <- srcF
     case cleanLinkString title of
       Just imgSrc | isImageFilename imgSrc ->
-        pure $ B.link src "" $ B.image imgSrc mempty mempty
+        pure . B.link src "" $ B.image imgSrc mempty mempty
       _ ->
         linkToInlinesF src =<< title'
 
diff --git a/src/Text/Pandoc/Readers/Org/Meta.hs b/src/Text/Pandoc/Readers/Org/Meta.hs
index a87042871..d22902eae 100644
--- a/src/Text/Pandoc/Readers/Org/Meta.hs
+++ b/src/Text/Pandoc/Readers/Org/Meta.hs
@@ -75,9 +75,9 @@ declarationLine :: PandocMonad m => OrgParser m ()
 declarationLine = try $ do
   key   <- map toLower <$> metaKey
   (key', value) <- metaValue key
-  when (key' /= "results") $
-    updateState $ \st ->
-      st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }
+  let addMetaValue st =
+        st { orgStateMeta = B.setMeta key' <$> value <*> orgStateMeta st }
+  when (key' /= "results") $ updateState addMetaValue
 
 metaKey :: Monad m => OrgParser m String
 metaKey = map toLower <$> many1 (noneOf ": \n\r")
@@ -236,8 +236,8 @@ macroDefinition = try $ do
   expansionPart = try $ many (notFollowedBy placeholder *> noneOf "\n\r")
 
   alternate :: [a] -> [a] -> [a]
-  alternate [] ys = ys
-  alternate xs [] = xs
+  alternate []     ys     = ys
+  alternate xs     []     = xs
   alternate (x:xs) (y:ys) = x : y : alternate xs ys
 
   reorder :: [Int] -> [String] -> [String]
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 <tarleb+pandoc@moltkeplatz.de>
 
@@ -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.
diff --git a/src/Text/Pandoc/Writers/Org.hs b/src/Text/Pandoc/Writers/Org.hs
index ef60e2f6c..78c102db6 100644
--- a/src/Text/Pandoc/Writers/Org.hs
+++ b/src/Text/Pandoc/Writers/Org.hs
@@ -34,7 +34,7 @@ Conversion of 'Pandoc' documents to Emacs Org-Mode.
 
 Org-Mode:  <http://orgmode.org>
 -}
-module Text.Pandoc.Writers.Org ( writeOrg) where
+module Text.Pandoc.Writers.Org (writeOrg) where
 import Control.Monad.State
 import Data.Char (isAlphaNum, toLower)
 import Data.List (intersect, intersperse, isPrefixOf, partition, transpose)
@@ -77,9 +77,9 @@ pandocToOrg (Pandoc meta blocks) = do
   body <- blockListToOrg blocks
   notes <- gets (reverse . stNotes) >>= notesToOrg
   hasMath <- gets stHasMath
-  let main = render colwidth $ foldl ($+$) empty $ [body, notes]
+  let main = render colwidth . foldl ($+$) empty $ [body, notes]
   let context = defField "body" main
-              $ defField "math" hasMath
+              . defField "math" hasMath
               $ metadata
   case writerTemplate opts of
        Nothing  -> return main
@@ -88,8 +88,7 @@ pandocToOrg (Pandoc meta blocks) = do
 -- | Return Org representation of notes.
 notesToOrg :: PandocMonad m => [[Block]] -> Org m Doc
 notesToOrg notes =
-  mapM (\(num, note) -> noteToOrg num note) (zip [1..] notes) >>=
-  return . vsep
+  vsep <$> zipWithM noteToOrg [1..] notes
 
 -- | Return Org representation of a note.
 noteToOrg :: PandocMonad m => Int -> [Block] -> Org m Doc
@@ -221,16 +220,16 @@ blockToOrg (Table caption' _ _ headers rows) =  do
   -- FIXME: Org doesn't allow blocks with height more than 1.
   let hpipeBlocks blocks = hcat [beg, middle, end]
         where h      = maximum (1 : map height blocks)
-              sep'   = lblock 3 $ vcat (map text $ replicate h " | ")
-              beg    = lblock 2 $ vcat (map text $ replicate h "| ")
-              end    = lblock 2 $ vcat (map text $ replicate h " |")
+              sep'   = lblock 3 $ vcat (replicate h (text " | "))
+              beg    = lblock 2 $ vcat (replicate h (text "| "))
+              end    = lblock 2 $ vcat (replicate h (text " |"))
               middle = hcat $ intersperse sep' blocks
   let makeRow = hpipeBlocks . zipWith lblock widthsInChars
   let head' = makeRow headers'
   rows' <- mapM (\row -> do cols <- mapM blockListToOrg row
                             return $ makeRow cols) rows
   let border ch = char '|' <> char ch <>
-                  (hcat $ intersperse (char ch <> char '+' <> char ch) $
+                  (hcat . intersperse (char ch <> char '+' <> char ch) $
                           map (\l -> text $ replicate l ch) widthsInChars) <>
                   char ch <> char '|'
   let body = vcat rows'
@@ -251,8 +250,7 @@ blockToOrg (OrderedList (start, _, delim) items) = do
   let maxMarkerLength = maximum $ map length markers
   let markers' = map (\m -> let s = maxMarkerLength - length m
                             in  m ++ replicate s ' ') markers
-  contents <- mapM (\(item, num) -> orderedListItemToOrg item num) $
-              zip markers' items
+  contents <- zipWithM orderedListItemToOrg markers' items
   -- ensure that sublists have preceding blank line
   return $ blankline $$ vcat contents $$ blankline
 blockToOrg (DefinitionList items) = do
@@ -279,8 +277,8 @@ definitionListItemToOrg :: PandocMonad m
                         => ([Inline], [[Block]]) -> Org m Doc
 definitionListItemToOrg (label, defs) = do
   label' <- inlineListToOrg label
-  contents <- liftM vcat $ mapM blockListToOrg defs
-  return $ hang 2 "- " $ label' <> " :: " <> (contents <> cr)
+  contents <- vcat <$> mapM blockListToOrg defs
+  return . hang 2 "- " $ label' <> " :: " <> (contents <> cr)
 
 -- | Convert list of key/value pairs to Org :PROPERTIES: drawer.
 propertiesDrawer :: Attr -> Doc
@@ -312,13 +310,13 @@ attrHtml (ident, classes, kvs) =
 blockListToOrg :: PandocMonad m
                => [Block]       -- ^ List of block elements
                -> Org m Doc
-blockListToOrg blocks = mapM blockToOrg blocks >>= return . vcat
+blockListToOrg blocks = vcat <$> mapM blockToOrg blocks
 
 -- | Convert list of Pandoc inline elements to Org.
 inlineListToOrg :: PandocMonad m
                 => [Inline]
                 -> Org m Doc
-inlineListToOrg lst = mapM inlineToOrg lst >>= return . hcat
+inlineListToOrg lst = hcat <$> mapM inlineToOrg lst
 
 -- | Convert Pandoc inline element to Org.
 inlineToOrg :: PandocMonad m => Inline -> Org m Doc
@@ -350,7 +348,7 @@ inlineToOrg (Quoted DoubleQuote lst) = do
   return $ "\"" <> contents <> "\""
 inlineToOrg (Cite _  lst) = inlineListToOrg lst
 inlineToOrg (Code _ str) = return $ "=" <> text str <> "="
-inlineToOrg (Str str) = return $ text $ escapeString str
+inlineToOrg (Str str) = return . text $ escapeString str
 inlineToOrg (Math t str) = do
   modify $ \st -> st{ stHasMath = True }
   return $ if t == InlineMath
-- 
cgit v1.2.3