Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Fixed runtime error with compactify'DL on certain lists.

Browse source 
Closes #1452.  Added test.
This commit is contained in:
John MacFarlane 2014-07-25 10:53:04 -07:00
parent 9c3f7688ee
commit 18f4490482
2 changed files with 23 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

24
src/Text/Pandoc/Shared.hs
View file

@ -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

10
tests/Tests/Shared.hs
View file

@ -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