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

-- | Function related to Stack's @uninstall@ command.

module Stack.Uninstall
  ( uninstallCmd
  ) where

import           Stack.Constants ( osIsWindows )
import           Stack.Prelude
import           Stack.Runners ( ShouldReexec (..), withConfig )
import           Stack.Types.Config
                   ( Config (..), configL, stackGlobalConfigL, stackRootL )
import           Stack.Types.Runner ( Runner )

-- | Function underlying the @stack uninstall@ command. Display help for the

-- command.

uninstallCmd :: () -> RIO Runner ()
uninstallCmd :: () -> RIO Runner ()
uninstallCmd () = ShouldReexec -> RIO Config () -> RIO Runner ()
forall a. ShouldReexec -> RIO Config a -> RIO Runner a
withConfig ShouldReexec
NoReexec (RIO Config () -> RIO Runner ()) -> RIO Config () -> RIO Runner ()
forall a b. (a -> b) -> a -> b
$ do
  Path Abs Dir
stackRoot <- Getting (Path Abs Dir) Config (Path Abs Dir)
-> RIO Config (Path Abs Dir)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs Dir) Config (Path Abs Dir)
forall s. HasConfig s => Lens' s (Path Abs Dir)
Lens' Config (Path Abs Dir)
stackRootL
  Path Abs File
globalConfig <- Getting (Path Abs File) Config (Path Abs File)
-> RIO Config (Path Abs File)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Path Abs File) Config (Path Abs File)
forall s. HasConfig s => Lens' s (Path Abs File)
Lens' Config (Path Abs File)
stackGlobalConfigL
  Path Abs Dir
programsDir <- Getting (Path Abs Dir) Config (Path Abs Dir)
-> RIO Config (Path Abs Dir)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Path Abs Dir) Config (Path Abs Dir)
 -> RIO Config (Path Abs Dir))
-> Getting (Path Abs Dir) Config (Path Abs Dir)
-> RIO Config (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ (Config -> Const (Path Abs Dir) Config)
-> Config -> Const (Path Abs Dir) Config
forall env. HasConfig env => Lens' env Config
Lens' Config Config
configL ((Config -> Const (Path Abs Dir) Config)
 -> Config -> Const (Path Abs Dir) Config)
-> Getting (Path Abs Dir) Config (Path Abs Dir)
-> Getting (Path Abs Dir) Config (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Path Abs Dir) -> SimpleGetter Config (Path Abs Dir)
forall s a. (s -> a) -> SimpleGetter s a
to (.localProgramsBase)
  Path Abs Dir
localBinDir <- Getting (Path Abs Dir) Config (Path Abs Dir)
-> RIO Config (Path Abs Dir)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Path Abs Dir) Config (Path Abs Dir)
 -> RIO Config (Path Abs Dir))
-> Getting (Path Abs Dir) Config (Path Abs Dir)
-> RIO Config (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$ (Config -> Const (Path Abs Dir) Config)
-> Config -> Const (Path Abs Dir) Config
forall env. HasConfig env => Lens' env Config
Lens' Config Config
configL ((Config -> Const (Path Abs Dir) Config)
 -> Config -> Const (Path Abs Dir) Config)
-> Getting (Path Abs Dir) Config (Path Abs Dir)
-> Getting (Path Abs Dir) Config (Path Abs Dir)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config -> Path Abs Dir) -> SimpleGetter Config (Path Abs Dir)
forall s a. (s -> a) -> SimpleGetter s a
to (.localBin)
  let toStyleDoc :: Path b t -> StyleDoc
toStyleDoc = Style -> StyleDoc -> StyleDoc
style Style
Dir (StyleDoc -> StyleDoc)
-> (Path b t -> StyleDoc) -> Path b t -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> StyleDoc
forall a. IsString a => String -> a
fromString (String -> StyleDoc)
-> (Path b t -> String) -> Path b t -> StyleDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path b t -> String
forall b t. Path b t -> String
toFilePath
      stackRoot' :: StyleDoc
stackRoot' = Path Abs Dir -> StyleDoc
forall {b} {t}. Path b t -> StyleDoc
toStyleDoc Path Abs Dir
stackRoot
      globalConfig' :: StyleDoc
globalConfig' = Path Abs File -> StyleDoc
forall {b} {t}. Path b t -> StyleDoc
toStyleDoc Path Abs File
globalConfig
      programsDir' :: StyleDoc
programsDir' = Path Abs Dir -> StyleDoc
forall {b} {t}. Path b t -> StyleDoc
toStyleDoc Path Abs Dir
programsDir
      localBinDir' :: StyleDoc
localBinDir' = Path Abs Dir -> StyleDoc
forall {b} {t}. Path b t -> StyleDoc
toStyleDoc Path Abs Dir
localBinDir
  Utf8Builder -> RIO Config ()
forall (m :: * -> *). MonadIO m => Utf8Builder -> m ()
putUtf8Builder (Utf8Builder -> RIO Config ())
-> RIO Config Utf8Builder -> RIO Config ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StyleDoc -> RIO Config Utf8Builder
forall env a (m :: * -> *).
(HasTerm env, Pretty a, MonadReader env m, HasCallStack) =>
a -> m Utf8Builder
displayWithColor
    (  [StyleDoc] -> StyleDoc
vsep
         [ String -> StyleDoc
flow String
"To uninstall Stack, it should be sufficient to delete:"
         , Int -> StyleDoc -> StyleDoc
hang Int
4 (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ [StyleDoc] -> StyleDoc
fillSep
             [ String -> StyleDoc
flow String
"(1) the directory containing Stack's tools"
             , StyleDoc
"(" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
softbreak StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
programsDir' StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
softbreak StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
");"
             ]
         , Int -> StyleDoc -> StyleDoc
hang Int
4 (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ [StyleDoc] -> StyleDoc
fillSep
             [ String -> StyleDoc
flow String
"(2) the Stack root directory"
             , StyleDoc
"(" StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
softbreak StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
stackRoot' StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
softbreak StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
");"
             ]
         , Int -> StyleDoc -> StyleDoc
hang Int
4 (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ [StyleDoc] -> StyleDoc
fillSep
             [ String -> StyleDoc
flow String
"(3) if different, the directory containing "
             , String -> StyleDoc
flow String
"Stack's global YAML configuration file"
             , StyleDoc -> StyleDoc
parens StyleDoc
globalConfig' StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
";"
             , StyleDoc
"and"
             ]
         , Int -> StyleDoc -> StyleDoc
hang Int
4 (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ [StyleDoc] -> StyleDoc
fillSep
             [ String -> StyleDoc
flow String
"(4) the 'stack' executable file (see the output"
             , String -> StyleDoc
flow String
"of command"
             , StyleDoc
howToFindStack StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
","
             , String -> StyleDoc
flow String
"if Stack is on the PATH;"
             , String -> StyleDoc
flow String
"Stack is often installed in"
             , StyleDoc
localBinDir' StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
softbreak StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
")."
             ]
         , [StyleDoc] -> StyleDoc
fillSep
             [String -> StyleDoc
flow String
"You may also want to delete"
             , Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
".stack-work"
             , String -> StyleDoc
flow String
"directories in any Haskell projects that you have built."
             ]
         ]
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
blankLine
    StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> [StyleDoc] -> StyleDoc
vsep
         [ [StyleDoc] -> StyleDoc
fillSep
             [ String -> StyleDoc
flow String
"To uninstall completely a Stack-supplied tool (such as \
                    \GHC or, on Windows, MSYS2), delete from Stack's tools \
                    \directory"
             , StyleDoc -> StyleDoc
parens StyleDoc
programsDir' StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
":"
             ]
         , Int -> StyleDoc -> StyleDoc
hang Int
4 (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ [StyleDoc] -> StyleDoc
fillSep
             [ String -> StyleDoc
flow String
"(1) the tool's subdirectory;"
             ]
         , Int -> StyleDoc -> StyleDoc
hang Int
4 (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ [StyleDoc] -> StyleDoc
fillSep
             [ String -> StyleDoc
flow String
"(2) the tool's archive file"
             , StyleDoc -> StyleDoc
parens (Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"<tool>.tar.xz") StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"; and"
             ]
         , Int -> StyleDoc -> StyleDoc
hang Int
4 (StyleDoc -> StyleDoc) -> StyleDoc -> StyleDoc
forall a b. (a -> b) -> a -> b
$ [StyleDoc] -> StyleDoc
fillSep
             [ String -> StyleDoc
flow String
"(3) the file marking that the tool is installed"
             , StyleDoc -> StyleDoc
parens (Style -> StyleDoc -> StyleDoc
style Style
File StyleDoc
"<tool>.installed") StyleDoc -> StyleDoc -> StyleDoc
forall a. Semigroup a => a -> a -> a
<> StyleDoc
"."
             ]
         ]
    )
 where
  styleShell :: StyleDoc -> StyleDoc
styleShell = Style -> StyleDoc -> StyleDoc
style Style
Shell
  howToFindStack :: StyleDoc
howToFindStack
    | Bool
osIsWindows = StyleDoc -> StyleDoc
styleShell StyleDoc
"where.exe stack"
    | Bool
otherwise   = StyleDoc -> StyleDoc
styleShell StyleDoc
"which stack"