Fix GHC 9.8 warnings

graphql.cabal

@@ -21,8 +21,7 @@ extra-source-files:
   CHANGELOG.md
   README.md
 tested-with:
-  GHC == 9.4.7,
-  GHC == 9.6.3
+  GHC == 9.8.2
 
 source-repository head
   type: git

src/Language/GraphQL/AST/Lexer.hs

@@ -30,6 +30,7 @@ module Language.GraphQL.AST.Lexer
     ) where
 
 import Control.Applicative (Alternative(..))
+import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
 import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
 import Data.Foldable (foldl')
 import Data.List (dropWhileEnd)
@@ -37,22 +38,22 @@ import qualified Data.List.NonEmpty as NonEmpty
 import Data.List.NonEmpty (NonEmpty(..))
 import Data.Proxy (Proxy(..))
 import Data.Void (Void)
-import Text.Megaparsec ( Parsec
-                       , (<?>)
-                       , between
-                       , chunk
-                       , chunkToTokens
-                       , notFollowedBy
-                       , oneOf
-                       , option
-                       , optional
-                       , satisfy
-                       , sepBy
-                       , skipSome
-                       , takeP
-                       , takeWhile1P
-                       , try
-                       )
+import Text.Megaparsec
+    ( Parsec
+    , (<?>)
+    , between
+    , chunk
+    , chunkToTokens
+    , notFollowedBy
+    , oneOf
+    , option
+    , optional
+    , satisfy
+    , skipSome
+    , takeP
+    , takeWhile1P
+    , try
+    )
 import Text.Megaparsec.Char (char, digitChar, space1)
 import qualified Text.Megaparsec.Char.Lexer as Lexer
 import Data.Text (Text)
@@ -142,12 +143,13 @@ blockString :: Parser T.Text
 blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
   where
     stringValue = do
-        byLine <- sepBy (many blockStringCharacter) lineTerminator
-        let indentSize = foldr countIndent 0 $ tail byLine
-            withoutIndent = head byLine : (removeIndent indentSize <$> tail byLine)
+        byLine <- NonEmpty.sepBy1 (many blockStringCharacter) lineTerminator
+        let indentSize = foldr countIndent 0 $ NonEmpty.tail byLine
+            withoutIndent = NonEmpty.head byLine
+                : (removeIndent indentSize <$> NonEmpty.tail byLine)
             withoutEmptyLines = liftA2 (.) dropWhile dropWhileEnd removeEmptyLine withoutIndent
 
-        return $ T.intercalate "\n" $ T.concat <$> withoutEmptyLines
+        pure $ T.intercalate "\n" $ T.concat <$> withoutEmptyLines
     removeEmptyLine [] = True
     removeEmptyLine [x] = T.null x || isWhiteSpace (T.head x)
     removeEmptyLine _ = False
@@ -180,10 +182,10 @@ name :: Parser T.Text
 name = do
     firstLetter <- nameFirstLetter
     rest <- many $ nameFirstLetter <|> digitChar
-    _ <- spaceConsumer
-    return $ TL.toStrict $ TL.cons firstLetter $ TL.pack rest
-      where
-        nameFirstLetter = satisfy isAsciiUpper <|> satisfy isAsciiLower <|> char '_'
+    void spaceConsumer
+    pure $ TL.toStrict $ TL.cons firstLetter $ TL.pack rest
+  where
+    nameFirstLetter = satisfy isAsciiUpper <|> satisfy isAsciiLower <|> char '_'
 
 isChunkDelimiter :: Char -> Bool
 isChunkDelimiter = flip notElem ['"', '\\', '\n', '\r']
@@ -197,25 +199,25 @@ lineTerminator = chunk "\r\n" <|> chunk "\n" <|> chunk "\r"
 isSourceCharacter :: Char -> Bool
 isSourceCharacter = isSourceCharacter' . ord
   where
-    isSourceCharacter' code = code >= 0x0020
-                           || code == 0x0009
-                           || code == 0x000a
-                           || code == 0x000d
+    isSourceCharacter' code
+        = code >= 0x0020
+        || elem code [0x0009, 0x000a, 0x000d]
 
 escapeSequence :: Parser Char
 escapeSequence = do
-    _ <- char '\\'
+    void $ char '\\'
     escaped <- oneOf ['"', '\\', '/', 'b', 'f', 'n', 'r', 't', 'u']
     case escaped of
-        'b' -> return '\b'
-        'f' -> return '\f'
-        'n' -> return '\n'
-        'r' -> return '\r'
-        't' -> return '\t'
-        'u' -> chr . foldl' step 0
-                   . chunkToTokens (Proxy :: Proxy T.Text)
-                 <$> takeP Nothing 4
-        _ -> return escaped
+        'b' -> pure '\b'
+        'f' -> pure '\f'
+        'n' -> pure '\n'
+        'r' -> pure '\r'
+        't' -> pure '\t'
+        'u' -> chr
+            . foldl' step 0
+            . chunkToTokens (Proxy :: Proxy T.Text)
+            <$> takeP Nothing 4
+        _ -> pure escaped
   where
     step accumulator = (accumulator * 16 +) . digitToInt
 

src/Language/GraphQL/Validate/Rules.hs

@@ -50,14 +50,15 @@ import Control.Monad.Trans.Class (MonadTrans(..))
 import Control.Monad.Trans.Reader (ReaderT(..), ask, asks, mapReaderT)
 import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
 import Data.Bifunctor (first)
-import Data.Foldable (find, fold, foldl', toList)
+import Data.Foldable (Foldable(..), find)
 import qualified Data.HashMap.Strict as HashMap
 import Data.HashMap.Strict (HashMap)
 import Data.HashSet (HashSet)
 import qualified Data.HashSet as HashSet
-import Data.List (groupBy, sortBy, sortOn)
+import Data.List (sortBy)
 import Data.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
 import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty as NonEmpty
 import Data.Ord (comparing)
 import Data.Sequence (Seq(..), (|>))
 import qualified Data.Sequence as Seq
@@ -253,14 +254,16 @@ findDuplicates :: (Full.Definition -> [Full.Location] -> [Full.Location])
     -> Full.Location
     -> String
     -> RuleT m
-findDuplicates filterByName thisLocation errorMessage = do
-    ast' <- asks ast
-    let locations' = foldr filterByName [] ast'
-    if length locations' > 1 && head locations' == thisLocation
-        then pure $ error' locations'
-        else lift mempty
+findDuplicates filterByName thisLocation errorMessage =
+    asks ast >>= go . foldr filterByName []
   where
-    error' locations' = Error 
+    go locations' =
+        case locations' of
+            headLocation : otherLocations -- length locations' > 1
+                | not $ null otherLocations
+                , headLocation == thisLocation -> pure $ makeError locations'
+            _ -> lift mempty
+    makeError locations' = Error
         { message = errorMessage
         , locations = locations'
         }
@@ -536,11 +539,6 @@ uniqueDirectiveNamesRule = DirectivesRule
     extract (Full.Directive directiveName _ location') =
         (directiveName, location')
 
-groupSorted :: forall a. (a -> Text) -> [a] -> [[a]]
-groupSorted getName = groupBy equalByName . sortOn getName
-  where
-    equalByName lhs rhs = getName lhs == getName rhs
-
 filterDuplicates :: forall a
     . (a -> (Text, Full.Location))
     -> String
@@ -549,12 +547,12 @@ filterDuplicates :: forall a
 filterDuplicates extract nodeType = Seq.fromList
     . fmap makeError
     . filter ((> 1) . length)
-    . groupSorted getName
+    . NonEmpty.groupAllWith getName
   where
     getName = fst . extract
     makeError directives' = Error
-        { message = makeMessage $ head directives'
-        , locations = snd . extract <$> directives'
+        { message = makeMessage $ NonEmpty.head directives'
+        , locations = snd . extract <$> toList directives'
         }
     makeMessage directive = concat
         [ "There can be only one "