Don't fail on invalid fragments and variables

1 files changed, 23 insertions, 15 deletions

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-}