+ liftM ParStmt
+ (mapM (addTickStmtAndBinders isGuard) pairs)
+addTickStmt isGuard (TransformStmt (stmts, ids) usingExpr maybeByExpr) = do
+ liftM3 TransformStmt
+ (addTickStmtAndBinders isGuard (stmts, ids))
+ (addTickLHsExprAlways usingExpr)
+ (addTickMaybeByLHsExpr maybeByExpr)
+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 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' <- addTickDictBinds (recS_dicts stmt)
+ ; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'
+ , recS_mfix_fn = mfix', recS_bind_fn = bind'
+ , recS_dicts = dicts' }) }
+
+addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr Id -> TM (LHsExpr Id)
+addTick isGuard e | Just fn <- isGuard = addBinTickLHsExpr fn e
+ | otherwise = addTickLHsExprAlways e
+
+addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ([LStmt Id], a)
+ -> TM ([LStmt Id], a)
+addTickStmtAndBinders isGuard (stmts, ids) =
+ liftM2 (,)
+ (addTickLStmts isGuard stmts)
+ (return ids)
+
+addTickMaybeByLHsExpr :: Maybe (LHsExpr Id) -> TM (Maybe (LHsExpr Id))
+addTickMaybeByLHsExpr maybeByExpr =
+ case maybeByExpr of
+ Nothing -> return Nothing
+ Just byExpr -> addTickLHsExprAlways byExpr >>= (return . Just)