{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Path.CheckInstall where

import           Control.Monad.Extra (anyM, (&&^))
import qualified Data.Text as T
import           Stack.Prelude
import           RIO.PrettyPrint
import           Stack.Types.Config
import qualified System.Directory as D
import qualified System.FilePath as FP

-- | Checks if the installed executable will be available on the user's
-- PATH. This doesn't use @envSearchPath menv@ because it includes paths
-- only visible when running in the stack environment.
warnInstallSearchPathIssues :: HasConfig env => FilePath -> [Text] -> RIO env ()
warnInstallSearchPathIssues :: FilePath -> [Text] -> RIO env ()
warnInstallSearchPathIssues FilePath
destDir [Text]
installed = do
    [FilePath]
searchPath <- IO [FilePath] -> RIO env [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
FP.getSearchPath
    Bool
destDirIsInPATH <- IO Bool -> RIO env Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> RIO env Bool) -> IO Bool -> RIO env Bool
forall a b. (a -> b) -> a -> b
$
        (FilePath -> IO Bool) -> [FilePath] -> IO Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM (\FilePath
dir -> FilePath -> IO Bool
D.doesDirectoryExist FilePath
dir IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
&&^ (FilePath -> Bool) -> IO FilePath -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> Bool
FP.equalFilePath FilePath
destDir) (FilePath -> IO FilePath
D.canonicalizePath FilePath
dir)) [FilePath]
searchPath
    if Bool
destDirIsInPATH
        then [Text] -> (Text -> RIO env ()) -> RIO env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Text]
installed ((Text -> RIO env ()) -> RIO env ())
-> (Text -> RIO env ()) -> RIO env ()
forall a b. (a -> b) -> a -> b
$ \Text
exe -> do
            Maybe FilePath
mexePath <- (IO (Maybe FilePath) -> RIO env (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe FilePath) -> RIO env (Maybe FilePath))
-> (Text -> IO (Maybe FilePath))
-> Text
-> RIO env (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe FilePath)
D.findExecutable (FilePath -> IO (Maybe FilePath))
-> (Text -> FilePath) -> Text -> IO (Maybe FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack) Text
exe
            case Maybe FilePath
mexePath of
                Just FilePath
exePath -> do
                    FilePath
exeDir <- (IO FilePath -> RIO env FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> RIO env FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> RIO env FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> FilePath
FP.takeDirectory (IO FilePath -> IO FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
D.canonicalizePath) FilePath
exePath
                    Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FilePath
exeDir FilePath -> FilePath -> Bool
`FP.equalFilePath` FilePath
destDir) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ do
                        [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
                          [ FilePath -> StyleDoc
flow FilePath
"The"
                          , Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> (Text -> StyleDoc) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> (Text -> FilePath) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text
exe
                          , FilePath -> StyleDoc
flow FilePath
"executable found on the PATH environment variable is"
                          , Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc)
-> (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath
exePath
                          , FilePath -> StyleDoc
flow FilePath
"and not the version that was just installed."
                          , FilePath -> StyleDoc
flow FilePath
"This means that"
                          , Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> (Text -> StyleDoc) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> (Text -> FilePath) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text
exe
                          , StyleDoc
"calls on the command line will not use this version."
                          ]
                Maybe FilePath
Nothing -> do
                    [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
                      [ FilePath -> StyleDoc
flow FilePath
"Installation path"
                      , Style -> StyleDoc -> StyleDoc
style Style
Dir (StyleDoc -> StyleDoc)
-> (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath
destDir
                      , FilePath -> StyleDoc
flow FilePath
"is on the PATH but the"
                      , Style -> StyleDoc -> StyleDoc
style Style
File (StyleDoc -> StyleDoc) -> (Text -> StyleDoc) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> (Text -> FilePath) -> Text -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> StyleDoc) -> Text -> StyleDoc
forall a b. (a -> b) -> a -> b
$ Text
exe
                      , FilePath -> StyleDoc
flow FilePath
"executable that was just installed could not be found on the PATH."
                      ]
        else do
            [StyleDoc] -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
[StyleDoc] -> m ()
prettyWarnL
              [ FilePath -> StyleDoc
flow FilePath
"Installation path "
              , Style -> StyleDoc -> StyleDoc
style Style
Dir (StyleDoc -> StyleDoc)
-> (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> StyleDoc
forall a. IsString a => FilePath -> a
fromString (FilePath -> StyleDoc) -> FilePath -> StyleDoc
forall a b. (a -> b) -> a -> b
$ FilePath
destDir
              , StyleDoc
"not found on the PATH environment variable."
              ]