From 693f9abb184c3d37864114f93d90a82c60f9ad0b Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:35:31 +1100 Subject: Allow haddock-library 1.2, by calling the Documentation.Haddock.Types.MetaDoc record accessor function _doc :: MetaDoc mod id -> DocH mod id --- src/Text/Pandoc/Readers/Haddock.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Readers/Haddock.hs b/src/Text/Pandoc/Readers/Haddock.hs index 4b46c869d..c03382c17 100644 --- a/src/Text/Pandoc/Readers/Haddock.hs +++ b/src/Text/Pandoc/Readers/Haddock.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {- | Module : Text.Pandoc.Readers.Haddock Copyright : Copyright (C) 2013 David Lazar @@ -29,7 +30,12 @@ import Debug.Trace (trace) readHaddock :: ReaderOptions -- ^ Reader options -> String -- ^ String to parse -> Pandoc -readHaddock opts = B.doc . docHToBlocks . trace' . parseParas +readHaddock opts = +#if MIN_VERSION_haddock_library(1,2,0) + B.doc . docHToBlocks . trace' . _doc . parseParas +#else + B.doc . docHToBlocks . trace' . parseParas +#endif where trace' x = if readerTrace opts then trace (show x) x else x -- cgit v1.2.3 From f18ceb1b5e9294699699f468ab9fe590b7100704 Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:38:06 +1100 Subject: 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/LaTeX.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Readers/LaTeX.hs b/src/Text/Pandoc/Readers/LaTeX.hs index 8b3743bca..6f3090e10 100644 --- a/src/Text/Pandoc/Readers/LaTeX.hs +++ b/src/Text/Pandoc/Readers/LaTeX.hs @@ -592,7 +592,7 @@ inNote ils = unescapeURL :: String -> String unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs - where isEscapable c = c `elem` "#$%&~_^\\{}" + where isEscapable c = c `elem` ("#$%&~_^\\{}" :: String) unescapeURL (x:xs) = x:unescapeURL xs unescapeURL [] = "" @@ -1225,7 +1225,7 @@ citationLabel = optional sp *> <* optional sp <* optional (char ',') <* optional sp) - where isBibtexKeyChar c = isAlphaNum c || c `elem` ".:;?!`'()/*@_+=-[]*" + where isBibtexKeyChar c = isAlphaNum c || c `elem` (".:;?!`'()/*@_+=-[]*" :: String) cites :: CitationMode -> Bool -> LP [Citation] cites mode multi = try $ do -- cgit v1.2.3 From 10d53989d8ca220315d2d4fc42977d867560f7fd Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:40:06 +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/Org.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Readers/Org.hs b/src/Text/Pandoc/Readers/Org.hs index 440b6d144..f16aed48d 100644 --- a/src/Text/Pandoc/Readers/Org.hs +++ b/src/Text/Pandoc/Readers/Org.hs @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE FlexibleContexts #-} {- Copyright (C) 2014 Albert Krewinkel @@ -1168,7 +1169,7 @@ isRelativeFilePath s = (("./" `isPrefixOf` s) || ("../" `isPrefixOf` s)) && isUri :: String -> Bool isUri s = let (scheme, path) = break (== ':') s - in all (\c -> isAlphaNum c || c `elem` ".-") scheme + in all (\c -> isAlphaNum c || c `elem` (".-" :: String)) scheme && not (null path) isAbsoluteFilePath :: String -> Bool @@ -1214,7 +1215,7 @@ solidify :: String -> String solidify = map replaceSpecialChar where replaceSpecialChar c | isAlphaNum c = c - | c `elem` "_.-:" = c + | c `elem` ("_.-:" :: String) = c | otherwise = '-' -- | Parses an inline code block and marks it as an babel block. @@ -1465,7 +1466,7 @@ inlineLaTeX = try $ do parseAsMathMLSym :: String -> Maybe Inlines parseAsMathMLSym cs = B.str <$> MathMLEntityMap.getUnicode (clean cs) -- dropWhileEnd would be nice here, but it's not available before base 4.5 - where clean = reverse . dropWhile (`elem` "{}") . reverse . drop 1 + where clean = reverse . dropWhile (`elem` ("{}" :: String)) . reverse . drop 1 state :: ParserState state = def{ stateOptions = def{ readerParseRaw = True }} -- cgit v1.2.3 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 From ed7606da9a130de1aaa533874dd0a60e9fba5817 Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:40:59 +1100 Subject: ghc 7.10.1 RC1 requires FlexibleContexts https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#Inferredtype-signaturesnowmayrequiretoenableFlexibleContextsGADTsorTypeFamilies --- src/Text/Pandoc/Readers/TWiki.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Readers/TWiki.hs b/src/Text/Pandoc/Readers/TWiki.hs index c2325c0ea..9f5738478 100644 --- a/src/Text/Pandoc/Readers/TWiki.hs +++ b/src/Text/Pandoc/Readers/TWiki.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE RelaxedPolyRec, FlexibleInstances, TypeSynonymInstances #-} +{-# LANGUAGE RelaxedPolyRec, FlexibleInstances, TypeSynonymInstances, FlexibleContexts #-} -- RelaxedPolyRec needed for inlinesBetween on GHC < 7 {- Copyright (C) 2014 Alexander Sulfrian -- cgit v1.2.3 From cd5b1fe5e3849ecb555f3890a74b41702c5745a9 Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:41:35 +1100 Subject: 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/Templates.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Templates.hs b/src/Text/Pandoc/Templates.hs index a92f91b41..eefce2744 100644 --- a/src/Text/Pandoc/Templates.hs +++ b/src/Text/Pandoc/Templates.hs @@ -124,7 +124,7 @@ getDefaultTemplate :: (Maybe FilePath) -- ^ User data directory to search first -> String -- ^ Name of writer -> IO (Either E.IOException String) getDefaultTemplate user writer = do - let format = takeWhile (`notElem` "+-") writer -- strip off extensions + let format = takeWhile (`notElem` ("+-" :: String)) writer -- strip off extensions case format of "native" -> return $ Right "" "json" -> return $ Right "" @@ -288,7 +288,7 @@ reservedWords :: [Text] reservedWords = ["else","endif","for","endfor","sep"] skipEndline :: Parser () -skipEndline = P.try $ P.skipMany (P.satisfy (`elem` " \t")) >> P.char '\n' >> return () +skipEndline = P.try $ P.skipMany (P.satisfy (`elem` (" \t" :: String))) >> P.char '\n' >> return () pConditional :: Parser Template pConditional = do -- cgit v1.2.3 From 4e3281c550727bfb30d4e23730433aedc2be3799 Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:41:54 +1100 Subject: 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/Writers/ConTeXt.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index ebdc4a3d3..edfb4d0ff 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -119,7 +119,7 @@ stringToConTeXt opts = concatMap (escapeCharForConTeXt opts) toLabel :: String -> String toLabel z = concatMap go z where go x - | elem x "\\#[]\",{}%()|=" = "ux" ++ printf "%x" (ord x) + | elem x ("\\#[]\",{}%()|=" :: String) = "ux" ++ printf "%x" (ord x) | otherwise = [x] -- | Convert Elements to ConTeXt -- cgit v1.2.3 From 2a6f68f4bffa53f42b1032f2882da7a6e0d0b963 Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:42:26 +1100 Subject: ghc 7.10.1 RC1 requires FlexibleContexts https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#Inferredtype-signaturesnowmayrequiretoenableFlexibleContextsGADTsorTypeFamilies --- src/Text/Pandoc/Writers/EPUB.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/EPUB.hs b/src/Text/Pandoc/Writers/EPUB.hs index 32da3a2d3..212206ac6 100644 --- a/src/Text/Pandoc/Writers/EPUB.hs +++ b/src/Text/Pandoc/Writers/EPUB.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternGuards, CPP, ScopedTypeVariables, ViewPatterns #-} +{-# LANGUAGE PatternGuards, CPP, ScopedTypeVariables, ViewPatterns, FlexibleContexts #-} {- Copyright (C) 2010-2014 John MacFarlane -- cgit v1.2.3 From e4c7894d013d403e877df080a6e61b47bd51b7e5 Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:42:45 +1100 Subject: ghc 7.10.1 RC1 requires FlexibleContexts https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#Inferredtype-signaturesnowmayrequiretoenableFlexibleContextsGADTsorTypeFamilies --- src/Text/Pandoc/Writers/ICML.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs index 181c63df7..75afa43e5 100644 --- a/src/Text/Pandoc/Writers/ICML.hs +++ b/src/Text/Pandoc/Writers/ICML.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, FlexibleContexts #-} {- | Module : Text.Pandoc.Writers.ICML -- cgit v1.2.3 From 8b9bded796b76a3f343c4cc1b8bb04a4b293ff55 Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:46:15 +1100 Subject: 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/Writers/LaTeX.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 3698d275c..eb514698a 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -240,7 +240,7 @@ toLabel z = go `fmap` stringToLaTeX URLString z where go [] = "" go (x:xs) | (isLetter x || isDigit x) && isAscii x = x:go xs - | elem x "-+=:;." = x:go xs + | elem x ("-+=:;." :: String) = x:go xs | otherwise = "ux" ++ printf "%x" (ord x) ++ go xs -- | Puts contents into LaTeX command. -- cgit v1.2.3 From c80c9ac9dab01ea3e886b58dd500b3d2b83ff4fd Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:46:40 +1100 Subject: 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/Writers/Markdown.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index f06f1d6cc..d71f0daf8 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -323,9 +323,9 @@ blockToMarkdown opts (Plain inlines) = do then Just $ writerColumns opts else Nothing let rendered = render colwidth contents - let escapeDelimiter (x:xs) | x `elem` ".()" = '\\':x:xs - | otherwise = x : escapeDelimiter xs - escapeDelimiter [] = [] + let escapeDelimiter (x:xs) | x `elem` (".()" :: String) = '\\':x:xs + | otherwise = x : escapeDelimiter xs + escapeDelimiter [] = [] let contents' = if isEnabled Ext_all_symbols_escapable opts && not (stPlain st) && beginsWithOrderedListMarker rendered then text $ escapeDelimiter rendered @@ -681,7 +681,7 @@ inlineListToMarkdown opts lst = mapM (inlineToMarkdown opts) (avoidBadWraps lst) >>= return . cat where avoidBadWraps [] = [] avoidBadWraps (Space:Str (c:cs):xs) - | c `elem` "-*+>" = Str (' ':c:cs) : avoidBadWraps xs + | c `elem` ("-*+>" :: String) = Str (' ':c:cs) : avoidBadWraps xs avoidBadWraps (x:xs) = x : avoidBadWraps xs escapeSpaces :: Inline -> Inline @@ -821,8 +821,8 @@ inlineToMarkdown opts (Cite (c:cs) lst) sdoc <- inlineListToMarkdown opts sinlines let k' = text (modekey m ++ "@" ++ k) r = case sinlines of - Str (y:_):_ | y `elem` ",;]@" -> k' <> sdoc - _ -> k' <+> sdoc + Str (y:_):_ | y `elem` (",;]@" :: String) -> k' <> sdoc + _ -> k' <+> sdoc return $ pdoc <+> r modekey SuppressAuthor = "-" modekey _ = "" -- cgit v1.2.3 From 5ea3856bb05de01620909a6301e9752cdfcfd443 Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:46:57 +1100 Subject: ghc 7.10.1 RC1 requires FlexibleContexts https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#Inferredtype-signaturesnowmayrequiretoenableFlexibleContextsGADTsorTypeFamilies --- src/Text/Pandoc/Writers/OpenDocument.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs index 773d142f4..901f827fb 100644 --- a/src/Text/Pandoc/Writers/OpenDocument.hs +++ b/src/Text/Pandoc/Writers/OpenDocument.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternGuards, OverloadedStrings #-} +{-# LANGUAGE PatternGuards, OverloadedStrings, FlexibleContexts #-} {- Copyright (C) 2008-2014 Andrea Rossato and John MacFarlane. -- cgit v1.2.3 From dbe1b3881604a5b981a813cd166cdc8a67508479 Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:47:33 +1100 Subject: 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/Writers/RST.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index 5ba4c9983..717a47000 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -105,7 +105,7 @@ keyToRST :: ([Inline], (String, String)) -> State WriterState Doc keyToRST (label, (src, _)) = do label' <- inlineListToRST label - let label'' = if ':' `elem` (render Nothing label') + let label'' = if ':' `elem` ((render Nothing label') :: String) then char '`' <> label' <> char '`' else label' return $ nowrap $ ".. _" <> label'' <> ": " <> text src @@ -333,12 +333,12 @@ inlineListToRST lst = okAfterComplex :: Inline -> Bool okAfterComplex Space = True okAfterComplex LineBreak = True - okAfterComplex (Str (c:_)) = isSpace c || c `elem` "-.,:;!?\\/'\")]}>–—" + okAfterComplex (Str (c:_)) = isSpace c || c `elem` ("-.,:;!?\\/'\")]}>–—" :: String) okAfterComplex _ = False okBeforeComplex :: Inline -> Bool okBeforeComplex Space = True okBeforeComplex LineBreak = True - okBeforeComplex (Str (c:_)) = isSpace c || c `elem` "-:/'\"<([{–—" + okBeforeComplex (Str (c:_)) = isSpace c || c `elem` ("-:/'\"<([{–—" :: String) okBeforeComplex _ = False isComplex :: Inline -> Bool isComplex (Emph _) = True -- cgit v1.2.3 From 9c68017786932e355461168d3ca0593e36d8d7f8 Mon Sep 17 00:00:00 2001 From: Mark Wright Date: Mon, 5 Jan 2015 14:48:01 +1100 Subject: 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/Writers/Texinfo.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/Texinfo.hs b/src/Text/Pandoc/Writers/Texinfo.hs index 8ac717bab..8fd177fd3 100644 --- a/src/Text/Pandoc/Writers/Texinfo.hs +++ b/src/Text/Pandoc/Writers/Texinfo.hs @@ -368,7 +368,7 @@ inlineListForNode = return . text . stringToTexinfo . -- periods, commas, colons, and parentheses are disallowed in node names disallowedInNode :: Char -> Bool -disallowedInNode c = c `elem` ".,:()" +disallowedInNode c = c `elem` (".,:()" :: String) -- | Convert inline element to Texinfo inlineToTexinfo :: Inline -- ^ Inline to convert -- cgit v1.2.3