-- | Like @which(1)@ but portable. -- -- Modified from @shelly@. module HotelCalifornia.Which (which) where import Data.Text qualified as Text import System.FilePath (splitDirectories, (), isAbsolute, searchPathSeparator) import System.Directory (doesFileExist, getPermissions, getPermissions, executable) import System.Environment (getEnv) import Control.Exception (catch) import Data.Maybe (isJust) -- | Get a full path to an executable by looking at the @PATH@ environement -- variable. Windows normally looks in additional places besides the -- @PATH@: this does not duplicate that behavior. which :: FilePath -> IO (Maybe FilePath) which path = if isAbsolute path || startsWithDot splitOnDirs then checkFile else lookupPath where splitOnDirs = splitDirectories path -- 'startsWithDot' receives as input the result of 'splitDirectories', -- which will include the dot (\".\") as its first element only if this -- is a path of the form \"./foo/bar/baz.sh\". Check for example: -- -- > import System.FilePath as FP -- > FP.splitDirectories "./test/data/hello.sh" -- [".","test","data","hello.sh"] -- > FP.splitDirectories ".hello.sh" -- [".hello.sh"] -- > FP.splitDirectories ".test/hello.sh" -- [".test","hello.sh"] -- > FP.splitDirectories ".foo" -- [".foo"] -- -- Note that earlier versions of Shelly used -- \"system-filepath\" which also has a 'splitDirectories' -- function, but it returns \"./\" as its first argument, -- so we pattern match on both for backward-compatibility. startsWithDot (".":_) = True startsWithDot _ = False checkFile :: IO (Maybe FilePath) checkFile = do exists <- doesFileExist path pure $ if exists then Just path else Nothing lookupPath :: IO (Maybe FilePath) lookupPath = (pathDirs >>=) $ findMapM $ \dir -> do let fullPath = dir path isExecutable' <- isExecutable fullPath pure $ if isExecutable' then Just fullPath else Nothing pathDirs = (map Text.unpack . filter (not . Text.null) . Text.split (== searchPathSeparator) . Text.pack) `fmap` getEnv "PATH" isExecutable :: FilePath -> IO Bool isExecutable f = (executable `fmap` getPermissions f) `catch` (\(_ :: IOError) -> return False) -- | A monadic @findMap@, taken from the @MissingM@ package findMapM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b) findMapM _ [] = return Nothing findMapM f (x:xs) = do mb <- f x if (isJust mb) then return mb else findMapM f xs