+addTickStmt isGuard (ParStmt pairs mzipExpr bindExpr returnExpr) = do
+ liftM4 ParStmt
+ (mapM (addTickStmtAndBinders isGuard) pairs)
+ (addTickSyntaxExpr hpcSrcSpan mzipExpr)
+ (addTickSyntaxExpr hpcSrcSpan bindExpr)
+ (addTickSyntaxExpr hpcSrcSpan returnExpr)
+
+addTickStmt isGuard (TransformStmt stmts ids usingExpr maybeByExpr returnExpr bindExpr) = do
+ t_s <- (addTickLStmts isGuard stmts)
+ t_u <- (addTickLHsExprAlways usingExpr)
+ t_m <- (addTickMaybeByLHsExpr maybeByExpr)
+ t_r <- (addTickSyntaxExpr hpcSrcSpan returnExpr)
+ t_b <- (addTickSyntaxExpr hpcSrcSpan bindExpr)
+ return $ TransformStmt t_s ids t_u t_m t_r t_b
+
+addTickStmt isGuard (GroupStmt stmts binderMap by using returnExpr bindExpr liftMExpr) = do
+ t_s <- (addTickLStmts isGuard stmts)
+ t_y <- (fmapMaybeM addTickLHsExprAlways by)
+ t_u <- (fmapEitherM addTickLHsExprAlways (addTickSyntaxExpr hpcSrcSpan) using)
+ t_f <- (addTickSyntaxExpr hpcSrcSpan returnExpr)
+ t_b <- (addTickSyntaxExpr hpcSrcSpan bindExpr)
+ t_m <- (addTickSyntaxExpr hpcSrcSpan liftMExpr)
+ return $ GroupStmt t_s binderMap t_y t_u t_b t_f t_m
+
+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)
+ ; return (stmt { recS_stmts = stmts', recS_ret_fn = ret'
+ , recS_mfix_fn = mfix', recS_bind_fn = bind' }) }
+
+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)