local

Author: sailaja-b-juspay

sheriff/src/Sheriff/Plugin.hs

@@ -480,15 +480,12 @@ extractFunctionNameFromContext expr = case unLoc expr of
 isBadExpr :: (HasPluginOpts PluginOpts) => Rules -> LHsExpr GhcTc -> TcM [(LHsExpr GhcTc, Violation)]
 isBadExpr rules ap@(L _ (HsVar _ v)) = do
   let fnNames = extractFunctionName ap
-  liftIO $ putStrLn $ "Detected HsVar function name: " <> fromMaybe "Unknown_HsVar" fnNames
   isBadExprHelper rules ap (fromMaybe "Unknown_HsVar" fnNames)
 isBadExpr rules ap@(L _ (HsApp _ funl funr)) = do
   let fnNames = extractFunctionName funl
-  liftIO $ putStrLn $ "Detected HsApp function name: " <> fromMaybe "Unknown_HsApp" fnNames
   isBadExprHelper rules ap (fromMaybe "Unknown_HsApp" fnNames)
 isBadExpr rules ap@(L _ (PatExplicitList _ _)) = do
   let fnNames = extractFunctionNameFromContext ap
-  liftIO $ putStrLn $ "Detected PatExplicitList function name: " <> fromMaybe "Unknown_PatExplicitList" fnNames
   isBadExprHelper rules ap (fromMaybe "Unknown_PatExplicitList" fnNames)
 isBadExpr rules ap@(L loc (PatHsWrap _ expr)) = isBadExpr rules (L loc expr) >>= mapM (\(x, y) -> trfViolationErrorInfo y ap x >>= \z -> pure (x, z))
 isBadExpr rules ap@(L loc (OpApp _ lfun op rfun)) = do
@@ -1065,31 +1062,68 @@ getFnNameAndTypeableExprWithAllArgs _ = Nothing
 
 -- TODO: Verify the correctness of this function before moving it to utils
 -- Get function name with all it's arguments
+
 getFnNameWithAllArgs :: LHsExpr GhcTc -> Maybe (Located Var, [LHsExpr GhcTc])
-getFnNameWithAllArgs (L loc (HsVar _ v)) = Just (getLocated v loc, [])
-getFnNameWithAllArgs (L _ (HsConLikeOut _ cl)) = (\clId -> (noExprLoc clId, [])) <$> conLikeWrapId cl
-getFnNameWithAllArgs (L _ (HsAppType _ expr _)) = getFnNameWithAllArgs expr
-getFnNameWithAllArgs (L _ (HsApp _ (L loc (HsVar _ v)) funr)) = Just (getLocated v loc, [funr])
-getFnNameWithAllArgs (L _ (HsPar _ expr)) = getFnNameWithAllArgs expr
-getFnNameWithAllArgs (L _ (HsApp _ funl funr)) = do
-  let res = getFnNameWithAllArgs funl
-  case res of
-    Nothing -> Nothing
-    Just (fnName, ls) -> Just (fnName, ls ++ [funr])
-getFnNameWithAllArgs (L loc (OpApp _ funl op funr)) = do
-  case showS op of
-    "($)" -> getFnNameWithAllArgs $ (L loc (HsApp noExtFieldOrAnn funl funr))
-    _ -> Nothing
-getFnNameWithAllArgs (L loc ap@(PatHsWrap _ expr)) = getFnNameWithAllArgs (L loc expr)
+getFnNameWithAllArgs expr = case expr of
+  L loc (HsVar _ v) -> 
+    trace ("getFnNameWithAllArgs: Detected HsVar with name = " <> showS v) $
+    Just (getLocated v loc, [])
+
+  L _ (HsConLikeOut _ cl) -> 
+    trace "getFnNameWithAllArgs: Detected HsConLikeOut" $
+    (\clId -> (noExprLoc clId, [])) <$> conLikeWrapId cl
+
+  L _ (HsAppType _ expr _) -> 
+    trace "getFnNameWithAllArgs: Detected HsAppType" $
+    getFnNameWithAllArgs expr
+
+  L _ (HsApp _ (L loc (HsVar _ v)) funr) -> 
+    trace ("getFnNameWithAllArgs: Detected HsApp with HsVar function name = " <> showS v) $
+    Just (getLocated v loc, [funr])
+
+  L _ (HsPar _ expr) -> 
+    trace "getFnNameWithAllArgs: Detected HsPar" $
+    getFnNameWithAllArgs expr
+
+  L _ (HsApp _ funl funr) -> 
+    trace "getFnNameWithAllArgs: Detected HsApp with nested function application" $
+    case getFnNameWithAllArgs funl of
+      Nothing -> trace "getFnNameWithAllArgs: No function name found in nested HsApp" Nothing
+      Just (fnName, ls) -> 
+        trace ("getFnNameWithAllArgs: Found function name = " <> showS fnName <> " with arguments = " <> showS ls) $
+        Just (fnName, ls ++ [funr])
+
+  L loc (OpApp _ funl op funr) -> 
+    trace ("getFnNameWithAllArgs: Detected OpApp with operator = " <> showS op) $
+    case showS op of
+      "($)" -> 
+        trace "getFnNameWithAllArgs: Detected ($) operator, treating as HsApp" $
+        getFnNameWithAllArgs (L loc (HsApp noExtFieldOrAnn funl funr))
+      _ -> trace "getFnNameWithAllArgs: Unsupported operator, returning Nothing" Nothing
+
+  L loc ap@(PatHsWrap _ expr) -> 
+    trace "getFnNameWithAllArgs: Detected PatHsWrap" $
+    getFnNameWithAllArgs (L loc expr)
+
 #if __GLASGOW_HASKELL__ >= 900
-getFnNameWithAllArgs (L loc ap@(PatHsExpansion orig expanded)) = 
-  case (orig, expanded) of
-    ((OpApp _ _ op _), (HsApp _ (L _ (HsApp _ op' funl)) funr)) -> case showS op of
-      "($)" -> getFnNameWithAllArgs (L loc (HsApp noExtFieldOrAnn funl funr))
-      _ -> getFnNameWithAllArgs (L loc expanded)
-    _ -> getFnNameWithAllArgs (L loc expanded)
+  L loc ap@(PatHsExpansion orig expanded) -> 
+    trace "getFnNameWithAllArgs: Detected PatHsExpansion" $
+    case (orig, expanded) of
+      ((OpApp _ _ op _), (HsApp _ (L _ (HsApp _ op' funl)) funr)) -> 
+        case showS op of
+          "($)" -> 
+            trace "getFnNameWithAllArgs: Detected ($) operator in PatHsExpansion, treating as HsApp" $
+            getFnNameWithAllArgs (L loc (HsApp noExtFieldOrAnn funl funr))
+          _ -> 
+            trace "getFnNameWithAllArgs: Unsupported operator in PatHsExpansion, processing expanded expression" $
+            getFnNameWithAllArgs (L loc expanded)
+      _ -> 
+        trace "getFnNameWithAllArgs: Processing expanded expression in PatHsExpansion" $
+        getFnNameWithAllArgs (L loc expanded)
 #endif
-getFnNameWithAllArgs _ = Nothing
+
+  _ -> 
+    trace "getFnNameWithAllArgs: No matching case found, returning Nothing" Nothing
 
 --------------------------- Sheriff Plugin Utils ---------------------------
 -- Transform the FnBlockedInArg Violation with correct expression