From 7cd48217187911855cd2ad473e58d11df0c69d48 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sat, 23 May 2020 06:46:21 +0200 Subject: Don't fail on invalid fragments and variables --- src/Language/GraphQL/Type.hs | 38 +++++++++++++++++++++++--------------- 1 file changed, 23 insertions(+), 15 deletions(-) (limited to 'src/Language/GraphQL/Type.hs') diff --git a/src/Language/GraphQL/Type.hs b/src/Language/GraphQL/Type.hs index c8a9997..12b38dc 100644 --- a/src/Language/GraphQL/Type.hs +++ b/src/Language/GraphQL/Type.hs @@ -3,8 +3,9 @@ module Language.GraphQL.Type ( Wrapping(..) ) where -import Data.Aeson as Aeson (ToJSON, toJSON) -import qualified Data.Aeson as Aeson +import Data.HashMap.Strict (HashMap) +import Data.Text (Text) +import Language.GraphQL.AST.Document (Name) -- | GraphQL distinguishes between "wrapping" and "named" types. Each wrapping -- type can wrap other wrapping or named types. Wrapping types are lists and @@ -15,26 +16,38 @@ import qualified Data.Aeson as Aeson -- nullable or an (arbitrary nested) list. data Wrapping a = List [Wrapping a] -- ^ Arbitrary nested list - | Named a -- ^ Named type without further wrapping +-- | Named a -- ^ Named type without further wrapping | Null -- ^ Null + | O (HashMap Name a) + | I Int + | B Bool + | F Float + | E Text + | S Text deriving (Eq, Show) instance Functor Wrapping where fmap f (List list) = List $ fmap (fmap f) list - fmap f (Named named) = Named $ f named + fmap f (O map') = O $ f <$> map' fmap _ Null = Null + fmap _ (I i) = I i + fmap _ (B i) = B i + fmap _ (F i) = F i + fmap _ (E i) = E i + fmap _ (S i) = S i -instance Foldable Wrapping where + {-instance Foldable Wrapping where foldr f acc (List list) = foldr (flip $ foldr f) acc list - foldr f acc (Named named) = f named acc - foldr _ acc Null = acc + foldr f acc (O map') = foldr f acc map' + foldr _ acc _ = acc -} -instance Traversable Wrapping where + {-instance Traversable Wrapping where traverse f (List list) = List <$> traverse (traverse f) list traverse f (Named named) = Named <$> f named traverse _ Null = pure Null + traverse f (O map') = O <$> traverse f map'-} -instance Applicative Wrapping where +{-instance Applicative Wrapping where pure = Named Null <*> _ = Null _ <*> Null = Null @@ -47,9 +60,4 @@ instance Monad Wrapping where return = pure Null >>= _ = Null (Named x) >>= f = f x - (List xs) >>= f = List $ fmap (>>= f) xs - -instance ToJSON a => ToJSON (Wrapping a) where - toJSON (List list) = toJSON list - toJSON (Named named) = toJSON named - toJSON Null = Aeson.Null + (List xs) >>= f = List $ fmap (>>= f) xs-} -- cgit v1.2.3