more helpful errors

ekmett · Jan 23, 2013 · e6bbbd4 · e6bbbd4
1 parent 926f26a
commit e6bbbd4
Showing 1 changed file with 7 additions and 3 deletions.
diff --git a/src/Control/Lens/TH.hs b/src/Control/Lens/TH.hs
@@ -832,6 +832,13 @@ hasClassAndInstance :: FieldRules -> Name -> Q [Dec]
 hasClassAndInstance cfg src = do
     c <- newName "c"
     e <- newName "e"
+    (vs, rs) <- do
+        s <- reify src
+        case s of 
+            TyConI (DataD _ _ vs' [Rec _ rs''] _) -> case rs'' of 
+                [Rec _ rs'] -> return (vs', rs')
+                _           -> error "Can't makeFields for sum types."
+            _ -> error "Invalid source type."
     TyConI (DataD _ _ vs [RecC _ rs] _) <- reify src
     fmap concat . forM (mkFields cfg rs) $ \(Field field _ fullLensName className lensName) -> do
         classHas <- classD
@@ -840,14 +847,12 @@ hasClassAndInstance cfg src = do
             [ PlainTV c, PlainTV e ]
             [ FunDep [c] [e] ]
             [ sigD lensName (conT ''Lens' `appsT` [varT c, varT e])]
-
         fieldType <- do
             VarI _ t _ _ <- reify field
             case t of
                 AppT    _    fieldType             -> return fieldType
                 ForallT tvs' [] (AppT _ fieldType) -> return fieldType
                 _                                  -> error "Cannot get fieldType"
-
         instanceHas <- instanceD
             (return [])
             (conT className `appsT` [conT src `appsT` map (varT.view name) vs, return fieldType])
@@ -857,7 +862,6 @@ hasClassAndInstance cfg src = do
 #endif
               funD lensName [ clause [] (normalB (global fullLensName)) [] ]
             ]
-
         classAlreadyExists <- isJust `fmap` lookupTypeName (show className)
         return (if classAlreadyExists then [instanceHas] else [classHas, instanceHas])