From 3bd7df955bdd9f066d5d19a90712b81305c61c87 Mon Sep 17 00:00:00 2001 From: "Joseph C. Sible" Date: Fri, 29 Dec 2023 14:18:42 -0500 Subject: [PATCH] Use a pattern match instead of null and head in checkCommand --- src/ShellCheck/Checks/Commands.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/src/ShellCheck/Checks/Commands.hs b/src/ShellCheck/Checks/Commands.hs index 314c1e909..429e78652 100644 --- a/src/ShellCheck/Checks/Commands.hs +++ b/src/ShellCheck/Checks/Commands.hs @@ -20,6 +20,7 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE PatternGuards #-} -- This module contains checks that examine specific commands by name. module ShellCheck.Checks.Commands (checker, optionalChecks, ShellCheck.Checks.Commands.runTests) where @@ -181,16 +182,15 @@ checkCommand :: M.Map CommandName (Token -> Analysis) -> Token -> Analysis checkCommand map t@(T_SimpleCommand id cmdPrefix (cmd:rest)) = sequence_ $ do name <- getLiteralString cmd return $ - if '/' `elem` name - then - M.findWithDefault nullCheck (Basename $ basename name) map t - else if name == "builtin" && not (null rest) then - let t' = T_SimpleCommand id cmdPrefix rest - selectedBuiltin = onlyLiteralString $ head rest - in M.findWithDefault nullCheck (Exactly selectedBuiltin) map t' - else do - M.findWithDefault nullCheck (Exactly name) map t - M.findWithDefault nullCheck (Basename name) map t + if | '/' `elem` name -> + M.findWithDefault nullCheck (Basename $ basename name) map t + | name == "builtin", (h:_) <- rest -> + let t' = T_SimpleCommand id cmdPrefix rest + selectedBuiltin = onlyLiteralString h + in M.findWithDefault nullCheck (Exactly selectedBuiltin) map t' + | otherwise -> do + M.findWithDefault nullCheck (Exactly name) map t + M.findWithDefault nullCheck (Basename name) map t where basename = reverse . takeWhile (/= '/') . reverse