commit 4e4f9c2f2866c28c01985abdcca82064ed44002e Author: Mark Wright Date: Sat Jan 10 12:31:30 2015 +1100 ghc 7.10.1 RC1 requires FlexibleContexts https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#Inferredtype-signaturesnowmayrequiretoenableFlexibleContextsGADTsorTypeFamilies diff --git a/src/Text/CSL/Util.hs b/src/Text/CSL/Util.hs index 6e90bf7..bfe5f4c 100644 --- a/src/Text/CSL/Util.hs +++ b/src/Text/CSL/Util.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ScopedTypeVariables, PatternGuards #-} +{-# LANGUAGE ScopedTypeVariables, PatternGuards, FlexibleContexts #-} module Text.CSL.Util ( safeRead , readNum commit 34cc147f87f2714ff3ad821a7640ef7e80323688 Author: Mark Wright Date: Sat Jan 10 12:30:59 2015 +1100 ghc 7.10.1 RC1 requires specifying the type of the String literal https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#GHCsaysNoinstanceforFoldable...arisingfromtheuseof... diff --git a/src/Text/CSL/Style.hs b/src/Text/CSL/Style.hs index d5972b3..067a9e0 100644 --- a/src/Text/CSL/Style.hs +++ b/src/Text/CSL/Style.hs @@ -130,7 +130,7 @@ readCSLString s = Walk.walk handleSmallCapsSpans -- this is needed for versions of pandoc that don't turn -- a span with font-variant:small-caps into a SmallCaps element: where handleSmallCapsSpans (Span ("",[],[("style",sty)]) ils) - | filter (`notElem` " \t;") sty == "font-variant:small-caps" = + | filter (`notElem` (" \t;" :: String)) sty == "font-variant:small-caps" = SmallCaps ils handleSmallCapsSpans x = x @@ -206,15 +206,15 @@ appendWithPunct :: Formatted -> Formatted -> Formatted appendWithPunct (Formatted left) (Formatted right) = Formatted $ case concat [lastleft, firstright] of - [' ',d] | d `elem` ",.:;" -> initInline left ++ right - [c,d] | c `elem` " ,.:;", d == c -> left ++ tailInline right - [c,'.'] | c `elem` ",.!:;?" -> left ++ tailInline right - [c,':'] | c `elem` ",!:;?" -> left ++ tailInline right -- Mich.: 2005 - [c,'!'] | c `elem` ",.!:;?" -> left ++ tailInline right - [c,'?'] | c `elem` ",.!:;?" -> left ++ tailInline right - [c,';'] | c `elem` ",:;" -> left ++ tailInline right -- et al.; - [':',c] | c `elem` ",.!:;?" -> left ++ tailInline right - [';',c] | c `elem` ",.!:;?" -> left ++ tailInline right + [' ',d] | d `elem` (",.:;" :: String) -> initInline left ++ right + [c,d] | c `elem` (" ,.:;" :: String), d == c -> left ++ tailInline right + [c,'.'] | c `elem` (",.!:;?" :: String) -> left ++ tailInline right + [c,':'] | c `elem` (",!:;?" :: String) -> left ++ tailInline right -- Mich.: 2005 + [c,'!'] | c `elem` (",.!:;?" :: String) -> left ++ tailInline right + [c,'?'] | c `elem` (",.!:;?" :: String) -> left ++ tailInline right + [c,';'] | c `elem` (",:;" :: String) -> left ++ tailInline right -- et al.; + [':',c] | c `elem` (",.!:;?" :: String) -> left ++ tailInline right + [';',c] | c `elem` (",.!:;?" :: String) -> left ++ tailInline right -- ".;" -> right -- e.g. et al.; _ -> left ++ right where lastleft = lastInline left commit 8242c706af750f15d1f82d663e2be94f0f80dc34 Author: Mark Wright Date: Sat Jan 10 12:30:39 2015 +1100 ghc 7.10.1 RC1 requires specifying the type of the String literal https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#GHCsaysNoinstanceforFoldable...arisingfromtheuseof... diff --git a/src/Text/CSL/Proc.hs b/src/Text/CSL/Proc.hs index 3575a59..f98e021 100644 --- a/src/Text/CSL/Proc.hs +++ b/src/Text/CSL/Proc.hs @@ -288,7 +288,7 @@ formatCitLayout s (CG co f d cs) case ys of Formatted [] -> xs Formatted (Note _ : _) -> xs <> ys - Formatted (Str [c]:_) | c `elem` ", ;:" -> xs <> ys + Formatted (Str [c]:_) | c `elem` (", ;:" :: String) -> xs <> ys _ -> xs <> Formatted [Space] <> ys formatAuth = formatOutput . localMod formatCits = (if isNote then toNote else id) . @@ -328,7 +328,7 @@ localModifiers s b c | otherwise = id where isPunct' [] = False - isPunct' xs = all (`elem` ".,;:!? ") xs + isPunct' xs = all (`elem` (".,;:!? " :: String)) xs check o = case cleanOutput o of [] -> ONull x -> case trim' x of commit e59f88d317224a76daf7ee152eaacbf7d84fc8a1 Author: Mark Wright Date: Sat Jan 10 12:30:15 2015 +1100 ghc 7.10.1 RC1 requires specifying the type of the String literal https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#GHCsaysNoinstanceforFoldable...arisingfromtheuseof... diff --git a/src/Text/CSL/Parser.hs b/src/Text/CSL/Parser.hs index a5649bb..ea9b367 100644 --- a/src/Text/CSL/Parser.hs +++ b/src/Text/CSL/Parser.hs @@ -144,7 +144,7 @@ stringAttr t cur = parseCslTerm :: Cursor -> CslTerm parseCslTerm cur = - let body = unpack $ T.dropAround (`elem` " \t\r\n") $ + let body = unpack $ T.dropAround (`elem` (" \t\r\n" :: String)) $ T.concat $ cur $/ content in CT { cslTerm = stringAttr "name" cur commit ae6ca8694d9c077f46223a5018dc24d94070491c Author: Mark Wright Date: Sat Jan 10 12:29:58 2015 +1100 ghc 7.10.1 RC1 requires specifying the type of the String literal https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#GHCsaysNoinstanceforFoldable...arisingfromtheuseof... diff --git a/src/Text/CSL/Pandoc.hs b/src/Text/CSL/Pandoc.hs index ae48cb4..840702a 100644 --- a/src/Text/CSL/Pandoc.hs +++ b/src/Text/CSL/Pandoc.hs @@ -201,10 +201,10 @@ endWithPunct xs@(_:_) = case reverse (stringify xs) of && isEndPunct c -> True (c:_) | isEndPunct c -> True | otherwise -> False - where isEndPunct c = c `elem` ".,;:!?" + where isEndPunct c = c `elem` (".,;:!?" :: String) startWithPunct :: [Inline] -> Bool -startWithPunct = and . map (`elem` ".,;:!?") . headInline +startWithPunct = and . map (`elem` (".,;:!?" :: String)) . headInline deNote :: Pandoc -> Pandoc deNote = topDown go @@ -324,7 +324,7 @@ pWordWithDigits isfirst = try $ do sp <- option "" (pSpace >> return " ") r <- many1 (notFollowedBy pSpace >> notFollowedBy pLocatorPunct >> anyToken) let s = stringify r - guard $ any isDigit s || all (`elem` "IVXLCM") s + guard $ any isDigit s || all (`elem` ("IVXLCM" :: String)) s return $ punct ++ sp ++ s pDigit :: Parsec [Inline] st () commit f5a9fc70951c68b60455a1e2fa7755734c68a357 Author: Mark Wright Date: Sat Jan 10 12:28:40 2015 +1100 ghc 7.10.1 RC1 requires FlexibleContexts https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#Inferredtype-signaturesnowmayrequiretoenableFlexibleContextsGADTsorTypeFamilies diff --git a/src/Text/CSL/Eval/Names.hs b/src/Text/CSL/Eval/Names.hs index 23e9b8e..5a387a2 100644 --- a/src/Text/CSL/Eval/Names.hs +++ b/src/Text/CSL/Eval/Names.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE PatternGuards, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Eval.Names commit 780a554f9d3dc0c1a53d285de05065bdb36c1b99 Author: Mark Wright Date: Sat Jan 10 12:28:24 2015 +1100 ghc 7.10.1 RC1 requires FlexibleContexts https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10#Inferredtype-signaturesnowmayrequiretoenableFlexibleContextsGADTsorTypeFamilies diff --git a/src/Text/CSL/Eval.hs b/src/Text/CSL/Eval.hs index 57c10dd..cf1dbb5 100644 --- a/src/Text/CSL/Eval.hs +++ b/src/Text/CSL/Eval.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE PatternGuards #-} +{-# LANGUAGE PatternGuards, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Text.CSL.Eval