Permalink
Browse files

more helpful errors

  • Loading branch information...
1 parent 926f26a commit e6bbbd4c917b2dcb58b1653bce410f0b3ab8c181 @mikeplus64 mikeplus64 committed Jan 23, 2013
Showing with 7 additions and 3 deletions.
  1. +7 −3 src/Control/Lens/TH.hs
View
10 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])

0 comments on commit e6bbbd4

Please sign in to comment.