- let alphaListTy = mkTyConApp m_tc [alphaTy]
- alphaListListTy = mkTyConApp m_tc [alphaListTy]
-
- groupByClause' <-
- case groupByClause of
- GroupByNothing usingExpr ->
- -- We must validate that usingExpr :: forall a. [a] -> [[a]]
- tcPolyExpr usingExpr (mkForAllTy alphaTyVar (alphaListTy `mkFunTy` alphaListListTy)) >>= (return . GroupByNothing)
- GroupBySomething eitherUsingExpr byExpr -> do
- -- We must infer a type such that byExpr :: t
- (byExpr', tTy) <- tcInferRhoNC byExpr
-
- -- If it exists, we then check that usingExpr :: forall a. (a -> t) -> [a] -> [[a]]
- let expectedUsingType = mkForAllTy alphaTyVar ((alphaTy `mkFunTy` tTy) `mkFunTy` (alphaListTy `mkFunTy` alphaListListTy))
- eitherUsingExpr' <-
- case eitherUsingExpr of
- Left usingExpr -> (tcPolyExpr usingExpr expectedUsingType) >>= (return . Left)
- Right usingExpr -> (tcPolyExpr (noLoc usingExpr) expectedUsingType) >>= (return . Right . unLoc)
- return $ GroupBySomething eitherUsingExpr' byExpr'
-
- -- Find the IDs and types of all old binders
- let (oldBinders, newBinders) = unzip bindersMap
- oldBinders' <- tcLookupLocalIds oldBinders
+ (by', using_ty) <- case by of
+ Nothing -> -- check that using :: forall a. [a] -> [[a]]
+ return (Nothing, mkForAllTy alphaTyVar $
+ alphaListTy `mkFunTy` alphaListListTy)
+
+ Just by_e -> -- check that using :: forall a. (a -> t) -> [a] -> [[a]]
+ -- where by :: t
+ do { (by_e', t_ty) <- tcInferRhoNC by_e
+ ; return (Just by_e', mkForAllTy alphaTyVar $
+ (alphaTy `mkFunTy` t_ty)
+ `mkFunTy` alphaListTy
+ `mkFunTy` alphaListListTy) }
+ -- Find the Ids (and hence types) of all old binders
+ bndr_ids <- tcLookupLocalIds bndr_names