From 18f4490482aa4f21a1c4e4a9493fb3a88815dcfa Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Fri, 25 Jul 2014 10:53:04 -0700
Subject: [PATCH] Fixed runtime error with compactify'DL on certain lists.
Closes #1452. Added test.
---
src/Text/Pandoc/Shared.hs | 24 +++++++++++++-----------
tests/Tests/Shared.hs | 10 ++++++++++
2 files changed, 23 insertions(+), 11 deletions(-)
diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs
index bb13836f2..77180bd4b 100644
--- a/src/Text/Pandoc/Shared.hs
+++ b/src/Text/Pandoc/Shared.hs
@@ -553,20 +553,22 @@ compactify' items =
_ -> items
_ -> items
--- | Like @compactify'@, but akts on items of definition lists.
+-- | Like @compactify'@, but acts on items of definition lists.
compactify'DL :: [(Inlines, [Blocks])] -> [(Inlines, [Blocks])]
compactify'DL items =
let defs = concatMap snd items
- defBlocks = reverse $ concatMap B.toList defs
- in case defBlocks of
- (Para x:_) -> if not $ any isPara (drop 1 defBlocks)
- then let (t,ds) = last items
- lastDef = B.toList $ last ds
- ds' = init ds ++
- [B.fromList $ init lastDef ++ [Plain x]]
- in init items ++ [(t, ds')]
- else items
- _ -> items
+ in case reverse (concatMap B.toList defs) of
+ (Para x:xs)
+ | not (any isPara xs) ->
+ let (t,ds) = last items
+ lastDef = B.toList $ last ds
+ ds' = init ds ++
+ if null lastDef
+ then [B.fromList lastDef]
+ else [B.fromList $ init lastDef ++ [Plain x]]
+ in init items ++ [(t, ds')]
+ | otherwise -> items
+ _ -> items
isPara :: Block -> Bool
isPara (Para _) = True
diff --git a/tests/Tests/Shared.hs b/tests/Tests/Shared.hs
index 8c7c31674..c9e2e21f5 100644
--- a/tests/Tests/Shared.hs
+++ b/tests/Tests/Shared.hs
@@ -5,6 +5,10 @@ import Text.Pandoc.Shared
import Test.Framework
import Tests.Helpers
import Tests.Arbitrary()
+import Test.Framework.Providers.HUnit
+import Test.HUnit ( assertBool )
+import Text.Pandoc.Builder
+import Data.Monoid
tests :: [Test]
tests = [ testGroup "normalize"
@@ -13,6 +17,12 @@ tests = [ testGroup "normalize"
, property "p_normalize_no_trailing_spaces"
p_normalize_no_trailing_spaces
]
+ , testGroup "compactify'DL"
+ [ testCase "compactify'DL with empty def" $
+ assertBool "compactify'DL"
+ (let x = [(str "word", [para (str "def"), mempty])]
+ in compactify'DL x == x)
+ ]
]
p_normalize_blocks_rt :: [Block] -> Bool