From 5156a4fe3c2438eeb0caa4a85e8adfdbea94e59d Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Fri, 27 Jan 2017 21:36:45 +0100 Subject: [PATCH] Shared: rename compactify', compactify'DL -> compactify, compactifyDL. --- src/Text/Pandoc/Parsing.hs | 2 +- src/Text/Pandoc/Readers/Markdown.hs | 8 ++++---- src/Text/Pandoc/Readers/Odt/ContentReader.hs | 4 ++-- src/Text/Pandoc/Readers/Org/Blocks.hs | 8 ++++---- src/Text/Pandoc/Readers/RST.hs | 4 ++-- src/Text/Pandoc/Readers/Txt2Tags.hs | 8 ++++---- src/Text/Pandoc/Shared.hs | 16 ++++++++-------- tests/Tests/Shared.hs | 8 ++++---- 8 files changed, 29 insertions(+), 29 deletions(-) diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index b1cc8cc48..5e9ff7fd1 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -868,7 +868,7 @@ removeOneLeadingSpace xs = startsWithSpace (y:_) = y == ' ' compactifyCell :: Blocks -> Blocks -compactifyCell bs = head $ compactify' [bs] +compactifyCell bs = head $ compactify [bs] -- | Parse footer for a grid table. gridTableFooter :: Stream s m Char => ParserT s ParserState m [Char] diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index 5052f52bf..1d8f7c78e 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -909,12 +909,12 @@ orderedList = try $ do atMostSpaces (tabStop - (endpos - startpos)) return res ) start' <- option 1 $ guardEnabled Ext_startnum >> return start - return $ B.orderedListWith (start', style, delim) <$> fmap compactify' items + return $ B.orderedListWith (start', style, delim) <$> fmap compactify items bulletList :: PandocMonad m => MarkdownParser m (F Blocks) bulletList = do items <- fmap sequence $ many1 $ listItem bulletListStart - return $ B.bulletList <$> fmap compactify' items + return $ B.bulletList <$> fmap compactify items -- definition lists @@ -972,7 +972,7 @@ compactDefinitionList :: PandocMonad m => MarkdownParser m (F Blocks) compactDefinitionList = do guardEnabled Ext_compact_definition_lists items <- fmap sequence $ many1 $ definitionListItem True - return $ B.definitionList <$> fmap compactify'DL items + return $ B.definitionList <$> fmap compactifyDL items normalDefinitionList :: PandocMonad m => MarkdownParser m (F Blocks) normalDefinitionList = do @@ -1349,7 +1349,7 @@ gridTableRow indices = do colLines <- many1 (gridTableRawLine indices) let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $ transpose colLines - fmap compactify' <$> fmap sequence (mapM (parseFromString parseBlocks) cols) + fmap compactify <$> fmap sequence (mapM (parseFromString parseBlocks) cols) removeOneLeadingSpace :: [String] -> [String] removeOneLeadingSpace xs = diff --git a/src/Text/Pandoc/Readers/Odt/ContentReader.hs b/src/Text/Pandoc/Readers/Odt/ContentReader.hs index 2672b01ef..a1bd8cb59 100644 --- a/src/Text/Pandoc/Readers/Odt/ContentReader.hs +++ b/src/Text/Pandoc/Readers/Odt/ContentReader.hs @@ -663,7 +663,7 @@ read_list = matchingElement NsText "list" -- read_list_item :: ElementMatcher [Blocks] read_list_item = matchingElement NsText "list-item" - $ liftA (compactify'.(:[])) + $ liftA (compactify.(:[])) ( matchChildContent' [ read_paragraph , read_header , read_list @@ -749,7 +749,7 @@ read_table_row = matchingElement NsTable "table-row" -- read_table_cell :: ElementMatcher [Blocks] read_table_cell = matchingElement NsTable "table-cell" - $ liftA (compactify'.(:[])) + $ liftA (compactify.(:[])) $ matchChildContent' [ read_paragraph ] diff --git a/src/Text/Pandoc/Readers/Org/Blocks.hs b/src/Text/Pandoc/Readers/Org/Blocks.hs index 8ffc0bb19..78ac8d0d1 100644 --- a/src/Text/Pandoc/Readers/Org/Blocks.hs +++ b/src/Text/Pandoc/Readers/Org/Blocks.hs @@ -47,7 +47,7 @@ import Text.Pandoc.Builder ( Inlines, Blocks ) import Text.Pandoc.Class (PandocMonad) import Text.Pandoc.Definition import Text.Pandoc.Options -import Text.Pandoc.Shared ( compactify', compactify'DL, safeRead ) +import Text.Pandoc.Shared ( compactify, compactifyDL, safeRead ) import Control.Monad ( foldM, guard, mzero, void ) import Data.Char ( isSpace, toLower, toUpper) @@ -898,16 +898,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 compactify'DL . sequence + fmap B.definitionList . fmap 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 . fmap 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 . fmap compactify . sequence <$> many1 (listItem orderedListStart) bulletListStart' :: Monad m => Maybe Int -> OrgParser m Int diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 96b5c4a9d..c9868c11f 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -574,11 +574,11 @@ orderedList :: PandocMonad m => RSTParser m Blocks orderedList = try $ do (start, style, delim) <- lookAhead (anyOrderedListMarker <* spaceChar) items <- many1 (listItem (orderedListStart style delim)) - let items' = compactify' items + let items' = compactify items return $ B.orderedListWith (start, style, delim) items' bulletList :: PandocMonad m => RSTParser m Blocks -bulletList = B.bulletList . compactify' <$> many1 (listItem bulletListStart) +bulletList = B.bulletList . compactify <$> many1 (listItem bulletListStart) -- -- directive (e.g. comment, container, compound-paragraph) diff --git a/src/Text/Pandoc/Readers/Txt2Tags.hs b/src/Text/Pandoc/Readers/Txt2Tags.hs index d2459ba47..9e2b6963d 100644 --- a/src/Text/Pandoc/Readers/Txt2Tags.hs +++ b/src/Text/Pandoc/Readers/Txt2Tags.hs @@ -37,7 +37,7 @@ import Text.Pandoc.Builder ( Inlines, Blocks, trimInlines ) import Data.Monoid ((<>)) import Text.Pandoc.Definition import Text.Pandoc.Options -import Text.Pandoc.Shared (escapeURI,compactify', compactify'DL) +import Text.Pandoc.Shared (escapeURI,compactify, compactifyDL) import Text.Pandoc.Parsing hiding (space, spaces, uri, macro) import Data.Char (toLower) import Data.List (transpose, intersperse, intercalate) @@ -225,16 +225,16 @@ list :: T2T Blocks list = choice [bulletList, orderedList, definitionList] bulletList :: T2T Blocks -bulletList = B.bulletList . compactify' +bulletList = B.bulletList . compactify <$> many1 (listItem bulletListStart parseBlocks) orderedList :: T2T Blocks -orderedList = B.orderedList . compactify' +orderedList = B.orderedList . compactify <$> many1 (listItem orderedListStart parseBlocks) definitionList :: T2T Blocks definitionList = try $ do - B.definitionList . compactify'DL <$> + B.definitionList . compactifyDL <$> many1 (listItem definitionListStart definitionListEnd) definitionListEnd :: T2T (Inlines, [Blocks]) diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index 5f49c2723..22847931f 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -59,8 +59,8 @@ module Text.Pandoc.Shared ( deNote, stringify, capitalize, - compactify', - compactify'DL, + compactify, + compactifyDL, linesToPara, Element (..), hierarchicalize, @@ -434,10 +434,10 @@ capitalize = walk go -- | Change final list item from @Para@ to @Plain@ if the list contains -- no other @Para@ blocks. Like compactify, but operates on @Blocks@ rather -- than @[Block]@. -compactify' :: [Blocks] -- ^ List of list items (each a list of blocks) +compactify :: [Blocks] -- ^ List of list items (each a list of blocks) -> [Blocks] -compactify' [] = [] -compactify' items = +compactify [] = [] +compactify items = let (others, final) = (init items, last items) in case reverse (B.toList final) of (Para a:xs) -> case [Para x | Para x <- concatMap B.toList items] of @@ -446,9 +446,9 @@ compactify' items = _ -> items _ -> items --- | Like @compactify'@, but acts on items of definition lists. -compactify'DL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])] -compactify'DL items = +-- | Like @compactify@, but acts on items of definition lists. +compactifyDL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])] +compactifyDL items = let defs = concatMap snd items in case reverse (concatMap B.toList defs) of (Para x:xs) diff --git a/tests/Tests/Shared.hs b/tests/Tests/Shared.hs index 4ff1dc837..9b9aeb6a3 100644 --- a/tests/Tests/Shared.hs +++ b/tests/Tests/Shared.hs @@ -9,11 +9,11 @@ import Text.Pandoc.Builder import System.FilePath.Posix (joinPath) tests :: [Test] -tests = [ testGroup "compactify'DL" - [ testCase "compactify'DL with empty def" $ - assertBool "compactify'DL" +tests = [ testGroup "compactifyDL" + [ testCase "compactifyDL with empty def" $ + assertBool "compactifyDL" (let x = [(str "word", [para (str "def"), mempty])] - in compactify'DL x == x) + in compactifyDL x == x) ] , testGroup "collapseFilePath" testCollapse ]