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)
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 :: [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)
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