Fix GHC 9.8 warnings
This commit is contained in:
parent
e02463f452
commit
388af30b51
@ -21,8 +21,7 @@ extra-source-files:
|
|||||||
CHANGELOG.md
|
CHANGELOG.md
|
||||||
README.md
|
README.md
|
||||||
tested-with:
|
tested-with:
|
||||||
GHC == 9.4.7,
|
GHC == 9.8.2
|
||||||
GHC == 9.6.3
|
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
type: git
|
type: git
|
||||||
|
@ -30,6 +30,7 @@ module Language.GraphQL.AST.Lexer
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative (Alternative(..))
|
import Control.Applicative (Alternative(..))
|
||||||
|
import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
|
||||||
import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
|
import Data.Char (chr, digitToInt, isAsciiLower, isAsciiUpper, ord)
|
||||||
import Data.Foldable (foldl')
|
import Data.Foldable (foldl')
|
||||||
import Data.List (dropWhileEnd)
|
import Data.List (dropWhileEnd)
|
||||||
@ -37,7 +38,8 @@ import qualified Data.List.NonEmpty as NonEmpty
|
|||||||
import Data.List.NonEmpty (NonEmpty(..))
|
import Data.List.NonEmpty (NonEmpty(..))
|
||||||
import Data.Proxy (Proxy(..))
|
import Data.Proxy (Proxy(..))
|
||||||
import Data.Void (Void)
|
import Data.Void (Void)
|
||||||
import Text.Megaparsec ( Parsec
|
import Text.Megaparsec
|
||||||
|
( Parsec
|
||||||
, (<?>)
|
, (<?>)
|
||||||
, between
|
, between
|
||||||
, chunk
|
, chunk
|
||||||
@ -47,7 +49,6 @@ import Text.Megaparsec ( Parsec
|
|||||||
, option
|
, option
|
||||||
, optional
|
, optional
|
||||||
, satisfy
|
, satisfy
|
||||||
, sepBy
|
|
||||||
, skipSome
|
, skipSome
|
||||||
, takeP
|
, takeP
|
||||||
, takeWhile1P
|
, takeWhile1P
|
||||||
@ -142,12 +143,13 @@ blockString :: Parser T.Text
|
|||||||
blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
|
blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
|
||||||
where
|
where
|
||||||
stringValue = do
|
stringValue = do
|
||||||
byLine <- sepBy (many blockStringCharacter) lineTerminator
|
byLine <- NonEmpty.sepBy1 (many blockStringCharacter) lineTerminator
|
||||||
let indentSize = foldr countIndent 0 $ tail byLine
|
let indentSize = foldr countIndent 0 $ NonEmpty.tail byLine
|
||||||
withoutIndent = head byLine : (removeIndent indentSize <$> tail byLine)
|
withoutIndent = NonEmpty.head byLine
|
||||||
|
: (removeIndent indentSize <$> NonEmpty.tail byLine)
|
||||||
withoutEmptyLines = liftA2 (.) dropWhile dropWhileEnd removeEmptyLine withoutIndent
|
withoutEmptyLines = liftA2 (.) dropWhile dropWhileEnd removeEmptyLine withoutIndent
|
||||||
|
|
||||||
return $ T.intercalate "\n" $ T.concat <$> withoutEmptyLines
|
pure $ T.intercalate "\n" $ T.concat <$> withoutEmptyLines
|
||||||
removeEmptyLine [] = True
|
removeEmptyLine [] = True
|
||||||
removeEmptyLine [x] = T.null x || isWhiteSpace (T.head x)
|
removeEmptyLine [x] = T.null x || isWhiteSpace (T.head x)
|
||||||
removeEmptyLine _ = False
|
removeEmptyLine _ = False
|
||||||
@ -180,8 +182,8 @@ name :: Parser T.Text
|
|||||||
name = do
|
name = do
|
||||||
firstLetter <- nameFirstLetter
|
firstLetter <- nameFirstLetter
|
||||||
rest <- many $ nameFirstLetter <|> digitChar
|
rest <- many $ nameFirstLetter <|> digitChar
|
||||||
_ <- spaceConsumer
|
void spaceConsumer
|
||||||
return $ TL.toStrict $ TL.cons firstLetter $ TL.pack rest
|
pure $ TL.toStrict $ TL.cons firstLetter $ TL.pack rest
|
||||||
where
|
where
|
||||||
nameFirstLetter = satisfy isAsciiUpper <|> satisfy isAsciiLower <|> char '_'
|
nameFirstLetter = satisfy isAsciiUpper <|> satisfy isAsciiLower <|> char '_'
|
||||||
|
|
||||||
@ -197,25 +199,25 @@ lineTerminator = chunk "\r\n" <|> chunk "\n" <|> chunk "\r"
|
|||||||
isSourceCharacter :: Char -> Bool
|
isSourceCharacter :: Char -> Bool
|
||||||
isSourceCharacter = isSourceCharacter' . ord
|
isSourceCharacter = isSourceCharacter' . ord
|
||||||
where
|
where
|
||||||
isSourceCharacter' code = code >= 0x0020
|
isSourceCharacter' code
|
||||||
|| code == 0x0009
|
= code >= 0x0020
|
||||||
|| code == 0x000a
|
|| elem code [0x0009, 0x000a, 0x000d]
|
||||||
|| code == 0x000d
|
|
||||||
|
|
||||||
escapeSequence :: Parser Char
|
escapeSequence :: Parser Char
|
||||||
escapeSequence = do
|
escapeSequence = do
|
||||||
_ <- char '\\'
|
void $ char '\\'
|
||||||
escaped <- oneOf ['"', '\\', '/', 'b', 'f', 'n', 'r', 't', 'u']
|
escaped <- oneOf ['"', '\\', '/', 'b', 'f', 'n', 'r', 't', 'u']
|
||||||
case escaped of
|
case escaped of
|
||||||
'b' -> return '\b'
|
'b' -> pure '\b'
|
||||||
'f' -> return '\f'
|
'f' -> pure '\f'
|
||||||
'n' -> return '\n'
|
'n' -> pure '\n'
|
||||||
'r' -> return '\r'
|
'r' -> pure '\r'
|
||||||
't' -> return '\t'
|
't' -> pure '\t'
|
||||||
'u' -> chr . foldl' step 0
|
'u' -> chr
|
||||||
|
. foldl' step 0
|
||||||
. chunkToTokens (Proxy :: Proxy T.Text)
|
. chunkToTokens (Proxy :: Proxy T.Text)
|
||||||
<$> takeP Nothing 4
|
<$> takeP Nothing 4
|
||||||
_ -> return escaped
|
_ -> pure escaped
|
||||||
where
|
where
|
||||||
step accumulator = (accumulator * 16 +) . digitToInt
|
step accumulator = (accumulator * 16 +) . digitToInt
|
||||||
|
|
||||||
|
@ -50,14 +50,15 @@ import Control.Monad.Trans.Class (MonadTrans(..))
|
|||||||
import Control.Monad.Trans.Reader (ReaderT(..), ask, asks, mapReaderT)
|
import Control.Monad.Trans.Reader (ReaderT(..), ask, asks, mapReaderT)
|
||||||
import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
|
import Control.Monad.Trans.State (StateT, evalStateT, gets, modify)
|
||||||
import Data.Bifunctor (first)
|
import Data.Bifunctor (first)
|
||||||
import Data.Foldable (find, fold, foldl', toList)
|
import Data.Foldable (Foldable(..), find)
|
||||||
import qualified Data.HashMap.Strict as HashMap
|
import qualified Data.HashMap.Strict as HashMap
|
||||||
import Data.HashMap.Strict (HashMap)
|
import Data.HashMap.Strict (HashMap)
|
||||||
import Data.HashSet (HashSet)
|
import Data.HashSet (HashSet)
|
||||||
import qualified Data.HashSet as 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.Maybe (fromMaybe, isJust, isNothing, mapMaybe)
|
||||||
import Data.List.NonEmpty (NonEmpty(..))
|
import Data.List.NonEmpty (NonEmpty(..))
|
||||||
|
import qualified Data.List.NonEmpty as NonEmpty
|
||||||
import Data.Ord (comparing)
|
import Data.Ord (comparing)
|
||||||
import Data.Sequence (Seq(..), (|>))
|
import Data.Sequence (Seq(..), (|>))
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.Sequence as Seq
|
||||||
@ -253,14 +254,16 @@ findDuplicates :: (Full.Definition -> [Full.Location] -> [Full.Location])
|
|||||||
-> Full.Location
|
-> Full.Location
|
||||||
-> String
|
-> String
|
||||||
-> RuleT m
|
-> RuleT m
|
||||||
findDuplicates filterByName thisLocation errorMessage = do
|
findDuplicates filterByName thisLocation errorMessage =
|
||||||
ast' <- asks ast
|
asks ast >>= go . foldr filterByName []
|
||||||
let locations' = foldr filterByName [] ast'
|
|
||||||
if length locations' > 1 && head locations' == thisLocation
|
|
||||||
then pure $ error' locations'
|
|
||||||
else lift mempty
|
|
||||||
where
|
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
|
{ message = errorMessage
|
||||||
, locations = locations'
|
, locations = locations'
|
||||||
}
|
}
|
||||||
@ -536,11 +539,6 @@ uniqueDirectiveNamesRule = DirectivesRule
|
|||||||
extract (Full.Directive directiveName _ location') =
|
extract (Full.Directive directiveName _ location') =
|
||||||
(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
|
filterDuplicates :: forall a
|
||||||
. (a -> (Text, Full.Location))
|
. (a -> (Text, Full.Location))
|
||||||
-> String
|
-> String
|
||||||
@ -549,12 +547,12 @@ filterDuplicates :: forall a
|
|||||||
filterDuplicates extract nodeType = Seq.fromList
|
filterDuplicates extract nodeType = Seq.fromList
|
||||||
. fmap makeError
|
. fmap makeError
|
||||||
. filter ((> 1) . length)
|
. filter ((> 1) . length)
|
||||||
. groupSorted getName
|
. NonEmpty.groupAllWith getName
|
||||||
where
|
where
|
||||||
getName = fst . extract
|
getName = fst . extract
|
||||||
makeError directives' = Error
|
makeError directives' = Error
|
||||||
{ message = makeMessage $ head directives'
|
{ message = makeMessage $ NonEmpty.head directives'
|
||||||
, locations = snd . extract <$> directives'
|
, locations = snd . extract <$> toList directives'
|
||||||
}
|
}
|
||||||
makeMessage directive = concat
|
makeMessage directive = concat
|
||||||
[ "There can be only one "
|
[ "There can be only one "
|
||||||
|
Loading…
Reference in New Issue
Block a user