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

module Stack.Config.ConfigureScript
  ( ensureConfigureScript
  ) where

import           Path ( (</>) )
import           Path.IO ( doesFileExist )
import           Stack.Constants ( osIsWindows, relFileConfigure )
import           Stack.DefaultColorWhen ( defaultColorWhen )
import           Stack.Prelude
import           RIO.Process ( HasProcessContext, withWorkingDir )

ensureConfigureScript ::
     (HasProcessContext env, HasTerm env)
  => Path b Dir
  -> RIO env ()
ensureConfigureScript :: forall env b.
(HasProcessContext env, HasTerm env) =>
Path b Dir -> RIO env ()
ensureConfigureScript Path b Dir
dir = do
  let fp :: Path b File
fp = Path b Dir
dir Path b Dir -> Path Rel File -> Path b File
forall b t. Path b Dir -> Path Rel t -> Path b t
</> Path Rel File
relFileConfigure
  Bool
exists <- Path b File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path b File
fp
  Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (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 ()
prettyInfoL
      [ String -> StyleDoc
flow String
"Trying to generate"
      , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"configure"
      , StyleDoc
"with"
      , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"autoreconf"
      , StyleDoc
"in"
      , Path b Dir -> StyleDoc
forall a. Pretty a => a -> StyleDoc
pretty Path b Dir
dir StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
      ]
    let autoreconf :: RIO env ()
autoreconf = if Bool
osIsWindows
                       then String -> [String] -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
String -> [String] -> RIO env ()
readProcessNull String
"sh" [String
"autoreconf", String
"-i"]
                       else String -> [String] -> RIO env ()
forall env.
(HasProcessContext env, HasLogFunc env, HasCallStack) =>
String -> [String] -> RIO env ()
readProcessNull String
"autoreconf" [String
"-i"]
        -- On Windows 10, an upstream issue with the `sh autoreconf -i`

        -- command means that command clears, but does not then restore, the

        -- ENABLE_VIRTUAL_TERMINAL_PROCESSING flag for native terminals. The

        -- following hack re-enables the lost ANSI-capability.

        fixupOnWindows :: RIO env ()
fixupOnWindows = Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
osIsWindows (RIO env ColorWhen -> RIO env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO env ColorWhen -> RIO env ())
-> RIO env ColorWhen -> RIO env ()
forall a b. (a -> b) -> a -> b
$ IO ColorWhen -> RIO env ColorWhen
forall a. IO a -> RIO env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ColorWhen
defaultColorWhen)
    String -> RIO env () -> RIO env ()
forall env (m :: * -> *) a.
(HasProcessContext env, MonadReader env m, MonadIO m) =>
String -> m a -> m a
withWorkingDir (Path b Dir -> String
forall b t. Path b t -> String
toFilePath Path b Dir
dir) (RIO env () -> RIO env ()) -> RIO env () -> RIO env ()
forall a b. (a -> b) -> a -> b
$ RIO env ()
autoreconf RIO env () -> (SomeException -> RIO env ()) -> RIO env ()
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> (SomeException -> m a) -> m a
`catchAny` \SomeException
ex -> do
      RIO env ()
fixupOnWindows
      StyleDoc -> RIO env ()
forall env (m :: * -> *).
(HasCallStack, HasTerm env, MonadReader env m, MonadIO m) =>
StyleDoc -> m ()
prettyWarn (StyleDoc -> RIO env ()) -> StyleDoc -> RIO env ()
forall a b. (a -> b) -> a -> b
$
           [StyleDoc] -> StyleDoc
fillSep
             [ String -> StyleDoc
flow String
"Stack failed to run"
             , Style -> StyleDoc -> StyleDoc
style Style
Shell StyleDoc
"autoreconf" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
             ]
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
flow String
"Stack encountered the following error:"
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
        StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> String -> StyleDoc
string (SomeException -> String
forall e. Exception e => e -> String
displayException SomeException
ex)
      Bool -> RIO env () -> RIO env ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
osIsWindows (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 ()
prettyInfo (StyleDoc -> RIO env ()) -> StyleDoc -> RIO env ()
forall a b. (a -> b) -> a -> b
$
             [StyleDoc] -> StyleDoc
fillSep
               [ String -> StyleDoc
flow String
"Check that executable"
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"perl"
               , String -> StyleDoc
flow String
"is on the path in Stack's MSYS2"
               , Style -> StyleDoc -> StyleDoc
style Style
Dir StyleDoc
"\\usr\\bin"
               , String -> StyleDoc
flow String
"folder, and working, and that script files"
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"autoreconf"
               , StyleDoc
"and"
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"aclocal"
               , String -> StyleDoc
flow String
"are on the path in that location. To check that"
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"perl" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"autoreconf"
               , StyleDoc
"or"
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"aclocal"
               , String -> StyleDoc
flow String
"are on the path in the required location, run commands:"
               ]
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
indent Int
4 (Style -> StyleDoc -> StyleDoc
style Style
Shell (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ String -> StyleDoc
flow String
"stack exec where.exe -- perl")
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
indent Int
4 (Style -> StyleDoc -> StyleDoc
style Style
Shell (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ String -> StyleDoc
flow String
"stack exec where.exe -- autoreconf")
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
line
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
indent Int
4 (Style -> StyleDoc -> StyleDoc
style Style
Shell (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ String -> StyleDoc
flow String
"stack exec where.exe -- aclocal")
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
               [ StyleDoc
"If"
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"perl" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"autoreconf"
               , StyleDoc
"or"
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"aclocal"
               , String -> StyleDoc
flow String
"is not on the path in the required location, add them \
                      \with command (note that the relevant package name is"
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"autotools"
               , StyleDoc
"not"
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"autoreconf" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"):"
               ]
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
indent Int
4
               (Style -> StyleDoc -> StyleDoc
style Style
Shell (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ String -> StyleDoc
flow String
"stack exec pacman -- --sync --refresh mingw-w64-x86_64-autotools")
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
fillSep
               [ String -> StyleDoc
flow String
"Some versions of"
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"perl"
               , String -> StyleDoc
flow String
"from MSYS2 are broken. See"
               , Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/msys2/MSYS2-packages/issues/1611"
               , StyleDoc
"and"
               , Style -> StyleDoc -> StyleDoc
style Style
Url StyleDoc
"https://github.com/commercialhaskell/stack/pull/4781" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
               , StyleDoc
"To test if"
               , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"perl"
               , String -> StyleDoc
flow String
"in the required location is working, try command:"
               ]
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> Int -> StyleDoc -> StyleDoc
indent Int
4 (Style -> StyleDoc -> StyleDoc
style Style
Shell (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ String -> StyleDoc
flow String
"stack exec perl -- --version")
          StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    RIO env ()
fixupOnWindows