From b748833889dcf21cbe2f418838abb423b565079d Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:40:30 +1100 Subject: ghc 7.10.1 RC1 requires FlexibleContexts https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#Inferredtype-signaturesnowmayrequiretoenableFlexibleContextsGADTsorTypeFamilies ; ghc 7.10.1 RC1 requires specifying the type of String literals https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#GHCsaysNoinstanceforFoldable...arisingfromtheuseof... --- src/Text/Pandoc/Readers/RST.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 8bfc6f606..b9a77c5d6 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} {- Copyright (C) 2006-2014 John MacFarlane @@ -708,7 +709,7 @@ extractCaption = do toChunks :: String -> [String] toChunks = dropWhile null . map (trim . unlines) - . splitBy (all (`elem` " \t")) . lines + . splitBy (all (`elem` (" \t" :: String))) . lines codeblock :: Maybe String -> String -> String -> RSTParser Blocks codeblock numberLines lang body = -- cgit v1.2.3