From 5747b8896955ca0d092a203318be22f7b8a4c48c Mon Sep 17 00:00:00 2001
From: Benedict Aas <x@shou.io>
Date: Mon, 20 Aug 2018 19:59:07 +0100
Subject: [PATCH] Simplify GenericInputObjectFieldDefinitions
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

We simplify `GenericInputObjectFieldDefinitions` by using
tree-recursion, resulting in better error messages. Example
code to reproduce below, where the 'true' error is usage of
lists.

```hs
data family Test :: Nat -> Type
data instance Test 1 = Test
  { testField1 :: Int32
  , testField2 :: Text
  , testField3 :: Text
  , testField4 :: [Int32]
  } deriving (Show, Generic)
instance HasAnnotatedInputType Test
```

Before
```
        • No instance for (GraphQL.Internal.API.GenericInputObjectFieldDefinitions
                             ((S1
                                 ('MetaSel
                                    ('Just "testField1")
                                    'NoSourceUnpackedness
                                    'NoSourceStrictness
                                    'DecidedLazy)
                                 (Rec0 Int32)
                               :*: S1
                                     ('MetaSel
                                        ('Just "testField2")
                                        'NoSourceUnpackedness
                                        'NoSourceStrictness
                                        'DecidedLazy)
                                     (Rec0 Text))
                              :*: (S1
                                     ('MetaSel
                                        ('Just "testField3")
                                        'NoSourceUnpackedness
                                        'NoSourceStrictness
                                        'DecidedLazy)
                                     (Rec0 Text)
                                   :*: S1
                                         ('MetaSel
                                            ('Just "testField4")
                                            'NoSourceUnpackedness
                                            'NoSourceStrictness
                                            'DecidedLazy)
                                         (Rec0 [Int32]))))
            arising from a use of ‘GraphQL.Internal.API.$dmgetAnnotatedInputType’
        • In the expression:
            GraphQL.Internal.API.$dmgetAnnotatedInputType @(Test 1)
          In an equation for ‘QL.getAnnotatedInputType’:
              QL.getAnnotatedInputType
                = GraphQL.Internal.API.$dmgetAnnotatedInputType @(Test 1)
          In the instance declaration for ‘QL.HasAnnotatedInputType (Test 1)’
       |
    72 | instance QL.HasAnnotatedInputType (Test 1)
       |
```

After
```
    • No instance for (QL.HasAnnotatedInputType [Int32])
      arising from a use of ‘GraphQL.Internal.API.$dmgetAnnotatedInputType’
    • In the expression:
        GraphQL.Internal.API.$dmgetAnnotatedInputType @(Test 1)
      In an equation for ‘QL.getAnnotatedInputType’:
          QL.getAnnotatedInputType
            = GraphQL.Internal.API.$dmgetAnnotatedInputType @(Test 1)
      In the instance declaration for ‘QL.HasAnnotatedInputType (Test 1)’
    |
72  | instance QL.HasAnnotatedInputType (Test 1)
    |
```
---
 scripts/hpc-ratchet         |  4 ++--
 src/GraphQL/Internal/API.hs | 18 ++++++++----------
 2 files changed, 10 insertions(+), 12 deletions(-)

diff --git a/scripts/hpc-ratchet b/scripts/hpc-ratchet
index 4eeace0..0ce8298 100755
--- a/scripts/hpc-ratchet
+++ b/scripts/hpc-ratchet
@@ -37,8 +37,8 @@ Each item represents the number of "things" we are OK with not being covered.
 COVERAGE_TOLERANCE = {
     ALTERNATIVES: 161,
     BOOLEANS: 8,
-    EXPRESSIONS: 1416,
-    LOCAL_DECLS: 14,
+    EXPRESSIONS: 1412,
+    LOCAL_DECLS: 13,
     TOP_LEVEL_DECLS: 669,
 }
 
diff --git a/src/GraphQL/Internal/API.hs b/src/GraphQL/Internal/API.hs
index aecebb0..dd7eda5 100644
--- a/src/GraphQL/Internal/API.hs
+++ b/src/GraphQL/Internal/API.hs
@@ -38,6 +38,7 @@ module GraphQL.Internal.API
 import Protolude hiding (Enum, TypeError)
 
 import qualified Data.List.NonEmpty as NonEmpty
+import Data.Semigroup as S ((<>))
 import GHC.Generics ((:*:)(..))
 import GHC.TypeLits (Symbol, KnownSymbol, TypeError, ErrorMessage(..))
 import GHC.Types (Type)
@@ -374,17 +375,14 @@ instance forall dataName consName records s l p.
           . Schema.InputObjectTypeDefinition name
         ) (genericGetInputObjectFieldDefinitions @records)
 
-instance forall wrappedType fieldName rest u s l.
-  ( KnownSymbol fieldName
-  , HasAnnotatedInputType wrappedType
-  , GenericInputObjectFieldDefinitions rest
-  ) => GenericInputObjectFieldDefinitions (S1 ('MetaSel ('Just fieldName) u s l) (Rec0 wrappedType) :*: rest) where
+instance forall a b.
+  ( GenericInputObjectFieldDefinitions a
+  , GenericInputObjectFieldDefinitions b
+  ) => GenericInputObjectFieldDefinitions (a :*: b) where
   genericGetInputObjectFieldDefinitions = do
-    name <- nameFromSymbol @fieldName
-    annotatedInputType <- getAnnotatedInputType @wrappedType
-    let l = Schema.InputObjectFieldDefinition name annotatedInputType Nothing
-    r <- genericGetInputObjectFieldDefinitions @rest
-    pure (NonEmpty.cons l r)
+    l <- genericGetInputObjectFieldDefinitions @a
+    r <- genericGetInputObjectFieldDefinitions @b
+    pure (l S.<> r)
 
 instance forall wrappedType fieldName u s l.
   ( KnownSymbol fieldName