-- | 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 :: FilePath -> IO (Maybe FilePath)
which FilePath
path =
  if FilePath -> Bool
isAbsolute FilePath
path Bool -> Bool -> Bool
|| [FilePath] -> Bool
forall {a}. (Eq a, IsString a) => [a] -> Bool
startsWithDot [FilePath]
splitOnDirs
  then IO (Maybe FilePath)
checkFile
  else IO (Maybe FilePath)
lookupPath
  where
    splitOnDirs :: [FilePath]
splitOnDirs = FilePath -> [FilePath]
splitDirectories FilePath
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 :: [a] -> Bool
startsWithDot (a
".":[a]
_)  = Bool
True
    startsWithDot [a]
_ = Bool
False

    checkFile :: IO (Maybe FilePath)
    checkFile :: IO (Maybe FilePath)
checkFile = do
        Bool
exists <- FilePath -> IO Bool
doesFileExist FilePath
path
        pure $
            if Bool
exists
            then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path
            else Maybe FilePath
forall a. Maybe a
Nothing

    lookupPath :: IO (Maybe FilePath)
    lookupPath :: IO (Maybe FilePath)
lookupPath = (IO [FilePath]
pathDirs IO [FilePath]
-> ([FilePath] -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) (([FilePath] -> IO (Maybe FilePath)) -> IO (Maybe FilePath))
-> ([FilePath] -> IO (Maybe FilePath)) -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO (Maybe FilePath))
-> [FilePath] -> IO (Maybe FilePath)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM ((FilePath -> IO (Maybe FilePath))
 -> [FilePath] -> IO (Maybe FilePath))
-> (FilePath -> IO (Maybe FilePath))
-> [FilePath]
-> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ \FilePath
dir -> do
        let fullPath :: FilePath
fullPath = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
path
        Bool
isExecutable' <- FilePath -> IO Bool
isExecutable FilePath
fullPath
        pure $
            if Bool
isExecutable'
            then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
fullPath
            else Maybe FilePath
forall a. Maybe a
Nothing

    pathDirs :: IO [FilePath]
pathDirs =
        ((Text -> FilePath) -> [Text] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Text -> FilePath
Text.unpack
          ([Text] -> [FilePath])
-> (FilePath -> [Text]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null)
          ([Text] -> [Text]) -> (FilePath -> [Text]) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> [Text]
Text.split (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
searchPathSeparator)
          (Text -> [Text]) -> (FilePath -> Text) -> FilePath -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
Text.pack)
         (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO FilePath
getEnv FilePath
"PATH"


isExecutable :: FilePath -> IO Bool
isExecutable :: FilePath -> IO Bool
isExecutable FilePath
f = (Permissions -> Bool
executable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` FilePath -> IO Permissions
getPermissions FilePath
f) IO Bool -> (IOError -> IO Bool) -> IO Bool
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (\(IOError
_ :: IOError) -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)


-- | A monadic @findMap@, taken from the @MissingM@ package
findMapM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM a -> m (Maybe b)
_ [] = Maybe b -> m (Maybe b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
findMapM a -> m (Maybe b)
f (a
x:[a]
xs) = do
    Maybe b
mb <- a -> m (Maybe b)
f a
x
    if (Maybe b -> Bool
forall a. Maybe a -> Bool
isJust Maybe b
mb)
      then Maybe b -> m (Maybe b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
mb
      else (a -> m (Maybe b)) -> [a] -> m (Maybe b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
findMapM a -> m (Maybe b)
f [a]
xs