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

{-|
Module      : Stack.Config.ConfigureScript
License     : BSD-3-Clause
-}

module Stack.Config.ConfigureScript
  ( ensureConfigureScript
  ) where

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

-- | For the given directory, yields an action that trys to generate a

-- @configure@ script with @autoreconf@, if one does not exist in the directory.

ensureConfigureScript ::
     HasConfig env
  => Path b Dir
  -> RIO env ()
ensureConfigureScript :: forall env b. HasConfig 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
  exists <- Path b File -> RIO env Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path b File
fp
  unless exists $ do
    prettyInfoL
      [ flow "Trying to generate"
      , style Shell "configure"
      , "with"
      , style Shell "autoreconf"
      , "in"
      , pretty dir <> "."
      ]
    let 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 = 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)
    withWorkingDir (toFilePath dir) $ autoreconf `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
        config <- Getting Config env Config -> RIO env Config
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Config env Config
forall env. HasConfig env => Lens' env Config
Lens' env Config
configL
        prettyInfo $
             fillSep
               [ flow "Check that executable"
               , style File "perl"
               , flow "is on the path in Stack's MSYS2"
               , style Dir "\\usr\\bin"
               , flow "folder, and working, and that script files"
               , style File "autoreconf"
               , "and"
               , style File "aclocal"
               , flow "are on the path in that location. To check that"
               , style File "perl" <> ","
               , style File "autoreconf"
               , "or"
               , style File "aclocal"
               , flow "are on the path in the required location, run commands:"
               ]
          <> blankLine
          <> indent 4 (style Shell $ flow "stack exec where.exe -- perl")
          <> line
          <> indent 4 (style Shell $ flow "stack exec where.exe -- autoreconf")
          <> line
          <> indent 4 (style Shell $ flow "stack exec where.exe -- aclocal")
          <> blankLine
          <> maybe mempty advice config.msysEnvironment
          <> fillSep
               [ flow "Some versions of"
               , style File "perl"
               , flow "from MSYS2 are broken. See"
               , style Url "https://github.com/msys2/MSYS2-packages/issues/1611"
               , "and"
               , style Url "https://github.com/commercialhaskell/stack/pull/4781" <> "."
               , "To test if"
               , style File "perl"
               , flow "in the required location is working, try command:"
               ]
          <> blankLine
          <> indent 4 (style Shell "stack exec perl -- --version")
          <> blankLine
    fixupOnWindows
 where
  advice :: MsysEnvironment -> StyleDoc
  advice :: MsysEnvironment -> StyleDoc
advice MsysEnvironment
CLANG32 = StyleDoc
forall a. Monoid a => a
mempty
  advice MsysEnvironment
MINGW32 = StyleDoc
forall a. Monoid a => a
mempty
  advice MsysEnvironment
CLANG64 = StyleDoc -> StyleDoc
adviceWith StyleDoc
"mingw-w64-clang-x86_64-autotools"
  advice MsysEnvironment
CLANGARM64 = StyleDoc -> StyleDoc
adviceWith StyleDoc
"mingw-w64-clang-aarch64-autotools"
  advice MsysEnvironment
MINGW64 = StyleDoc -> StyleDoc
adviceWith StyleDoc
"mingw-w64-x86_64-autotools"
  advice MsysEnvironment
UCRT64 = StyleDoc -> StyleDoc
adviceWith StyleDoc
"mingw-w64-ucrt-x86_64-autotools"

  adviceWith :: StyleDoc -> StyleDoc
  adviceWith :: StyleDoc -> StyleDoc
adviceWith StyleDoc
msysPackage =
       [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
$ StyleDoc
"stack exec pacman -- --sync --refresh " StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
msysPackage)
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine