-addTickStmt isGuard (GroupStmt (stmts, binderMap) groupByClause) = do
- liftM2 GroupStmt
- (addTickStmtAndBinders isGuard (stmts, binderMap))
- (case groupByClause of
- GroupByNothing usingExpr -> addTickLHsExprAlways usingExpr >>= (return . GroupByNothing)
- GroupBySomething eitherUsingExpr byExpr -> do
- eitherUsingExpr' <- mapEitherM addTickLHsExprAlways (addTickSyntaxExpr hpcSrcSpan) eitherUsingExpr
- byExpr' <- addTickLHsExprAlways byExpr
- return $ GroupBySomething eitherUsingExpr' byExpr')
- where
- mapEitherM f g x = do
- case x of
- Left a -> f a >>= (return . Left)
- Right b -> g b >>= (return . Right)
-addTickStmt isGuard (RecStmt stmts ids1 ids2 tys dictbinds) = do
- liftM5 RecStmt
- (addTickLStmts isGuard stmts)
- (return ids1)
- (return ids2)
- (return tys)
- (addTickDictBinds dictbinds)
+
+addTickStmt isGuard (GroupStmt stmts binderMap by using) = do
+ liftM4 GroupStmt
+ (addTickLStmts isGuard stmts)
+ (return binderMap)
+ (fmapMaybeM addTickLHsExprAlways by)
+ (fmapEitherM addTickLHsExprAlways (addTickSyntaxExpr hpcSrcSpan) using)
+
+addTickStmt isGuard stmt@(RecStmt {})
+ = do { stmts' <- addTickLStmts isGuard (recS_stmts stmt)
+ ; ret' <- addTickSyntaxExpr hpcSrcSpan (recS_ret_fn stmt)
+ ; mfix' <- addTickSyntaxExpr hpcSrcSpan (recS_mfix_fn stmt)
+ ; bind' <- addTickSyntaxExpr hpcSrcSpan (recS_bind_fn stmt)
+ ; dicts' <- addTickEvBinds (recS_dicts stmt)
+ ; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'
+ , recS_mfix_fn = mfix', recS_bind_fn = bind'
+ , recS_dicts = dicts' }) }