aboutsummaryrefslogtreecommitdiff
path: root/src/Language/GraphQL/AST
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/GraphQL/AST')
-rw-r--r--src/Language/GraphQL/AST/DirectiveLocation.hs2
-rw-r--r--src/Language/GraphQL/AST/Document.hs8
-rw-r--r--src/Language/GraphQL/AST/Encoder.hs5
-rw-r--r--src/Language/GraphQL/AST/Lexer.hs80
-rw-r--r--src/Language/GraphQL/AST/Parser.hs4
5 files changed, 54 insertions, 45 deletions
diff --git a/src/Language/GraphQL/AST/DirectiveLocation.hs b/src/Language/GraphQL/AST/DirectiveLocation.hs
index d109666..600f931 100644
--- a/src/Language/GraphQL/AST/DirectiveLocation.hs
+++ b/src/Language/GraphQL/AST/DirectiveLocation.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE Safe #-}
--- | Various parts of a GraphQL document can be annotated with directives.
+-- | Various parts of a GraphQL document can be annotated with directives.
-- This module describes locations in a document where directives can appear.
module Language.GraphQL.AST.DirectiveLocation
( DirectiveLocation(..)
diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs
index 66fc246..101cf78 100644
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@@ -380,7 +380,11 @@ instance Show NonNullType where
--
-- Directives begin with "@", can accept arguments, and can be applied to the
-- most GraphQL elements, providing additional information.
-data Directive = Directive Name [Argument] Location deriving (Eq, Show)
+data Directive = Directive
+ { name :: Name
+ , arguments :: [Argument]
+ , location :: Location
+ } deriving (Eq, Show)
-- * Type System
@@ -405,7 +409,7 @@ data TypeSystemDefinition
= SchemaDefinition [Directive] (NonEmpty OperationTypeDefinition)
| TypeDefinition TypeDefinition
| DirectiveDefinition
- Description Name ArgumentsDefinition (NonEmpty DirectiveLocation)
+ Description Name ArgumentsDefinition Bool (NonEmpty DirectiveLocation)
deriving (Eq, Show)
-- ** Type System Extensions
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index 120fb64..a1076e4 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -159,11 +159,12 @@ typeSystemDefinition formatter = \case
<> optempty (directives formatter) operationDirectives
<> bracesList formatter (operationTypeDefinition formatter) (NonEmpty.toList operationTypeDefinitions')
Full.TypeDefinition typeDefinition' -> typeDefinition formatter typeDefinition'
- Full.DirectiveDefinition description' name' arguments' locations
+ Full.DirectiveDefinition description' name' arguments' repeatable locations
-> description formatter description'
<> "@"
<> Lazy.Text.fromStrict name'
<> argumentsDefinition formatter arguments'
+ <> (if repeatable then " repeatable" else mempty)
<> " on"
<> pipeList formatter (directiveLocation <$> locations)
@@ -276,7 +277,7 @@ pipeList :: Foldable t => Formatter -> t Lazy.Text -> Lazy.Text
pipeList Minified = (" " <>) . Lazy.Text.intercalate " | " . toList
pipeList (Pretty _) = Lazy.Text.concat
. fmap (("\n" <> indentSymbol <> "| ") <>)
- . toList
+ . toList
enumValueDefinition :: Formatter -> Full.EnumValueDefinition -> Lazy.Text
enumValueDefinition (Pretty _) enumValue =
diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs
index ab1f36f..62cf4d2 100644
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@@ -29,7 +29,8 @@ module Language.GraphQL.AST.Lexer
, unicodeBOM
) where
-import Control.Applicative (Alternative(..), liftA2)
+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
diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs
index e19823c..f325ee7 100644
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@@ -8,7 +8,7 @@ module Language.GraphQL.AST.Parser
( document
) where
-import Control.Applicative (Alternative(..), liftA2, optional)
+import Control.Applicative (Alternative(..), optional)
import Control.Applicative.Combinators (sepBy1)
import qualified Control.Applicative.Combinators.NonEmpty as NonEmpty
import Data.List.NonEmpty (NonEmpty(..))
@@ -27,6 +27,7 @@ import Text.Megaparsec
, unPos
, (<?>)
)
+import Data.Maybe (isJust)
-- | Parser for the GraphQL documents.
document :: Parser Full.Document
@@ -82,6 +83,7 @@ directiveDefinition description' = Full.DirectiveDefinition description'
<* at
<*> name
<*> argumentsDefinition
+ <*> (isJust <$> optional (symbol "repeatable"))
<* symbol "on"
<*> directiveLocations
<?> "DirectiveDefinition"
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 08:51:25 +0000