{-# LANGUAGE CPP               #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ViewPatterns      #-}

module GHCup.OptParse.Common where


import           GHCup
import           GHCup.CabalConfig
import           GHCup.Download
import           GHCup.Platform
import           GHCup.Types
import           GHCup.Types.Optics
import           GHCup.Utils
import qualified GHCup.Utils.Parsers as Parsers
import           GHCup.Prelude
import           GHCup.Prelude.Process
import           GHCup.Prelude.Logger

import           Control.Monad (forM, join)
import           Control.DeepSeq
import           Control.Concurrent
import           Control.Concurrent.Async
import           Control.Exception.Safe
#if !MIN_VERSION_base(4,13,0)
import           Control.Monad.Fail             ( MonadFail )
#endif
import           Control.Monad.Reader
import           Data.Aeson
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key    as KM
import qualified Data.Aeson.KeyMap as KM
#else
import qualified Data.HashMap.Strict as KM
#endif
import           Data.ByteString.Lazy           ( ByteString )
import           Data.Bifunctor
import           Data.Char
import           Data.Either
import           Data.Functor
import           Data.List                      ( nub, isPrefixOf, stripPrefix )
import           Data.Maybe
import           Data.Versions
import qualified Data.Vector      as V
import           GHC.IO.Exception
import           Data.Variant.Excepts
import           Options.Applicative     hiding ( style )
import           Prelude                 hiding ( appendFile )
import           Safe (lastMay)
import           System.Process                  ( readProcess )
import           System.FilePath
import           Text.HTML.TagSoup       hiding ( Tag )

import qualified Data.Map.Strict               as M
import qualified Data.Text                     as T
import qualified System.FilePath.Posix         as FP
import GHCup.Version
import Control.Exception (evaluate)

    --------------
    --[ Parser ]--
    --------------


toolVersionTagArgument :: [ListCriteria] -> Maybe Tool -> Parser ToolVersion
toolVersionTagArgument :: [ListCriteria] -> Maybe Tool -> Parser ToolVersion
toolVersionTagArgument [ListCriteria]
criteria Maybe Tool
tool =
  ReadM ToolVersion
-> Mod ArgumentFields ToolVersion -> Parser ToolVersion
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ((String -> Either String ToolVersion) -> ReadM ToolVersion
forall a. (String -> Either String a) -> ReadM a
eitherReader (Maybe Tool -> String -> Either String ToolVersion
parser Maybe Tool
tool))
    (String -> Mod ArgumentFields ToolVersion
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar (Maybe Tool -> String
forall {a}. IsString a => Maybe Tool -> a
mv Maybe Tool
tool)
    Mod ArgumentFields ToolVersion
-> Mod ArgumentFields ToolVersion -> Mod ArgumentFields ToolVersion
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod ArgumentFields ToolVersion
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (Tool -> [String] -> Completer
tagCompleter (Tool -> Maybe Tool -> Tool
forall a. a -> Maybe a -> a
fromMaybe Tool
GHC Maybe Tool
tool) [])
    Mod ArgumentFields ToolVersion
-> Mod ArgumentFields ToolVersion -> Mod ArgumentFields ToolVersion
forall a. Semigroup a => a -> a -> a
<> (Tool -> Mod ArgumentFields ToolVersion)
-> Maybe Tool -> Mod ArgumentFields ToolVersion
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Completer -> Mod ArgumentFields ToolVersion
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (Completer -> Mod ArgumentFields ToolVersion)
-> (Tool -> Completer) -> Tool -> Mod ArgumentFields ToolVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ListCriteria] -> Tool -> Completer
versionCompleter [ListCriteria]
criteria) Maybe Tool
tool)
 where
  mv :: Maybe Tool -> a
mv (Just Tool
GHC) = a
"GHC_VERSION|TAG|RELEASE_DATE"
  mv (Just Tool
HLS) = a
"HLS_VERSION|TAG|RELEASE_DATE"
  mv Maybe Tool
_          = a
"VERSION|TAG|RELEASE_DATE"

  parser :: Maybe Tool -> String -> Either String ToolVersion
parser (Just Tool
GHC) = String -> Either String ToolVersion
Parsers.ghcVersionTagEither
  parser Maybe Tool
Nothing    = String -> Either String ToolVersion
Parsers.ghcVersionTagEither
  parser Maybe Tool
_          = String -> Either String ToolVersion
Parsers.toolVersionTagEither


versionParser' :: [ListCriteria] -> Maybe Tool -> Parser Version
versionParser' :: [ListCriteria] -> Maybe Tool -> Parser Version
versionParser' [ListCriteria]
criteria Maybe Tool
tool = ReadM Version -> Mod ArgumentFields Version -> Parser Version
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument
  ((String -> Either String Version) -> ReadM Version
forall a. (String -> Either String a) -> ReadM a
eitherReader ((ParsingError -> String)
-> Either ParsingError Version -> Either String Version
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ParsingError -> String
forall a. Show a => a -> String
show (Either ParsingError Version -> Either String Version)
-> (String -> Either ParsingError Version)
-> String
-> Either String Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Version
version (Text -> Either ParsingError Version)
-> (String -> Text) -> String -> Either ParsingError Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack))
  (String -> Mod ArgumentFields Version
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"VERSION"  Mod ArgumentFields Version
-> Mod ArgumentFields Version -> Mod ArgumentFields Version
forall a. Semigroup a => a -> a -> a
<> (Tool -> Mod ArgumentFields Version)
-> Maybe Tool -> Mod ArgumentFields Version
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Completer -> Mod ArgumentFields Version
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (Completer -> Mod ArgumentFields Version)
-> (Tool -> Completer) -> Tool -> Mod ArgumentFields Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ListCriteria] -> Tool -> Completer
versionCompleter [ListCriteria]
criteria) Maybe Tool
tool)

ghcVersionArgument :: [ListCriteria] -> Maybe Tool -> Parser GHCTargetVersion
ghcVersionArgument :: [ListCriteria] -> Maybe Tool -> Parser GHCTargetVersion
ghcVersionArgument [ListCriteria]
criteria Maybe Tool
tool = ReadM GHCTargetVersion
-> Mod ArgumentFields GHCTargetVersion -> Parser GHCTargetVersion
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ((String -> Either String GHCTargetVersion)
-> ReadM GHCTargetVersion
forall a. (String -> Either String a) -> ReadM a
eitherReader String -> Either String GHCTargetVersion
Parsers.ghcVersionEither)
                                            (String -> Mod ArgumentFields GHCTargetVersion
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"VERSION" Mod ArgumentFields GHCTargetVersion
-> Mod ArgumentFields GHCTargetVersion
-> Mod ArgumentFields GHCTargetVersion
forall a. Semigroup a => a -> a -> a
<> (Tool -> Mod ArgumentFields GHCTargetVersion)
-> Maybe Tool -> Mod ArgumentFields GHCTargetVersion
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Completer -> Mod ArgumentFields GHCTargetVersion
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (Completer -> Mod ArgumentFields GHCTargetVersion)
-> (Tool -> Completer)
-> Tool
-> Mod ArgumentFields GHCTargetVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ListCriteria] -> Tool -> Completer
versionCompleter [ListCriteria]
criteria) Maybe Tool
tool)


-- https://github.com/pcapriotti/optparse-applicative/issues/148

-- | A switch that can be enabled using --foo and disabled using --no-foo.
--
-- The option modifier is applied to only the option that is *not* enabled
-- by default. For example:
--
-- > invertableSwitch "recursive" True (help "do not recurse into directories")
--
-- This example makes --recursive enabled by default, so
-- the help is shown only for --no-recursive.
invertableSwitch
    :: String              -- ^ long option
    -> Maybe Char          -- ^ short option for the non-default option
    -> Bool                -- ^ is switch enabled by default?
    -> Mod FlagFields Bool -- ^ option modifier
    -> Parser (Maybe Bool)
invertableSwitch :: String
-> Maybe Char -> Bool -> Mod FlagFields Bool -> Parser (Maybe Bool)
invertableSwitch String
longopt Maybe Char
shortopt Bool
defv Mod FlagFields Bool
optmod = String
-> Maybe Char
-> Bool
-> Mod FlagFields Bool
-> Mod FlagFields Bool
-> Parser (Maybe Bool)
invertableSwitch' String
longopt Maybe Char
shortopt Bool
defv
    (if Bool
defv then Mod FlagFields Bool
forall a. Monoid a => a
mempty else Mod FlagFields Bool
optmod)
    (if Bool
defv then Mod FlagFields Bool
optmod else Mod FlagFields Bool
forall a. Monoid a => a
mempty)

-- | Allows providing option modifiers for both --foo and --no-foo.
invertableSwitch'
    :: String              -- ^ long option (eg "foo")
    -> Maybe Char          -- ^ short option for the non-default option
    -> Bool                -- ^ is switch enabled by default?
    -> Mod FlagFields Bool -- ^ option modifier for --foo
    -> Mod FlagFields Bool -- ^ option modifier for --no-foo
    -> Parser (Maybe Bool)
invertableSwitch' :: String
-> Maybe Char
-> Bool
-> Mod FlagFields Bool
-> Mod FlagFields Bool
-> Parser (Maybe Bool)
invertableSwitch' String
longopt Maybe Char
shortopt Bool
defv Mod FlagFields Bool
enmod Mod FlagFields Bool
dismod = Parser Bool -> Parser (Maybe Bool)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
    ( Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
True ( Mod FlagFields Bool
enmod Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
longopt Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> if Bool
defv then Mod FlagFields Bool
forall a. Monoid a => a
mempty else Mod FlagFields Bool
-> (Char -> Mod FlagFields Bool)
-> Maybe Char
-> Mod FlagFields Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mod FlagFields Bool
forall a. Monoid a => a
mempty Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Maybe Char
shortopt)
    Parser Bool -> Parser Bool -> Parser Bool
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
False (Mod FlagFields Bool
dismod Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
nolongopt Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> if Bool
defv then Mod FlagFields Bool
-> (Char -> Mod FlagFields Bool)
-> Maybe Char
-> Mod FlagFields Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mod FlagFields Bool
forall a. Monoid a => a
mempty Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Maybe Char
shortopt else Mod FlagFields Bool
forall a. Monoid a => a
mempty)
    )
  where
    nolongopt :: String
nolongopt = String
"no-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
longopt



    ------------------
    --[ Completers ]--
    ------------------


toolCompleter :: Completer
toolCompleter :: Completer
toolCompleter = [String] -> Completer
listCompleter [String
"ghc", String
"cabal", String
"hls", String
"stack"]

gitFileUri :: [String] -> Completer
gitFileUri :: [String] -> Completer
gitFileUri [String]
add = (String -> IO [String]) -> Completer
mkCompleter ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO [String]
fileUri' ([String
"git://"] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
add)

urlSourceCompleter :: Completer
urlSourceCompleter :: Completer
urlSourceCompleter = (String -> IO [String]) -> Completer
mkCompleter ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO [String]
urlSourceCompleter' []

urlSourceCompleter' :: [String] -> String -> IO [String]
urlSourceCompleter' :: [String] -> String -> IO [String]
urlSourceCompleter' [String]
add String
str' = do
  let static :: [String]
static = [String
"GHCupURL", String
"StackSetupURL", String
"cross", String
"prereleases", String
"vanilla"]
  [String]
file <- [String] -> String -> IO [String]
fileUri' [String]
add String
str'
  [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String]
static [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
file

fileUri :: Completer
fileUri :: Completer
fileUri = (String -> IO [String]) -> Completer
mkCompleter ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ [String] -> String -> IO [String]
fileUri' []

fileUri' :: [String] -> String -> IO [String]
fileUri' :: [String] -> String -> IO [String]
fileUri' [String]
add = \case
  String
"" -> do
    String
pwd <- IO String
getCurrentDirectory
    [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String
"https://", String
"http://", String
"file:///", String
"file://" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pwd String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/"] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
add
  String
xs
   | String
"file:///" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs -> (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
"file://" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"file://" String
xs of
        Maybe String
Nothing -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Just String
r ->  do
          String
pwd <- IO String
getCurrentDirectory
          [String]
dirs  <- String -> String -> [String] -> IO [String]
compgen String
"directory" String
r [String
"-S", String
"/"]
          [String]
files <- (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (\String
f -> (String
f String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/") String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
dirs) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> [String] -> IO [String]
compgen String
"file" String
r []
          [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String]
dirs [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
files [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> if String
r String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
pwd then [String
pwd String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/"] else [])
   | String
xs String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"file:///" -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"file:///"]
   | String
xs String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"https://" -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"https://"]
   | String
xs String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"http://"  -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"http://"]
   | Bool
otherwise -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
 where
  compgen :: String -> String -> [String] -> IO [String]
  compgen :: String -> String -> [String] -> IO [String]
compgen String
action' String
r [String]
opts = do
    let cmd :: String
cmd = [String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String
"compgen", String
"-A", String
action'] [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
opts [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"--", String -> String
requote String
r]
    Either IOException String
result <- IO String -> IO (Either IOException String)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
m a -> m (Either IOException a)
tryIO (IO String -> IO (Either IOException String))
-> IO String -> IO (Either IOException String)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String -> IO String
readProcess String
"bash" [String
"-c", String
cmd] String
""
    [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String])
-> (Either IOException String -> [String])
-> Either IOException String
-> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> [String])
-> (Either IOException String -> String)
-> Either IOException String
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOException -> String)
-> (String -> String) -> Either IOException String -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> IOException -> String
forall a b. a -> b -> a
const []) String -> String
forall a. a -> a
id (Either IOException String -> IO [String])
-> Either IOException String -> IO [String]
forall a b. (a -> b) -> a -> b
$ Either IOException String
result

  -- | Strongly quote the string we pass to compgen.
  --
  -- We need to do this so bash doesn't expand out any ~ or other
  -- chars we want to complete on, or emit an end of line error
  -- when seeking the close to the quote.
  --
  -- NOTE: copied from https://hackage.haskell.org/package/optparse-applicative-0.17.0.0/docs/src/Options.Applicative.Builder.Completer.html#requote
  requote :: String -> String
  requote :: String -> String
requote String
s =
    let
      -- Bash doesn't appear to allow "mixed" escaping
      -- in bash completions. So we don't have to really
      -- worry about people swapping between strong and
      -- weak quotes.
      unescaped :: String
unescaped =
        case String
s of
          -- It's already strongly quoted, so we
          -- can use it mostly as is, but we must
          -- ensure it's closed off at the end and
          -- there's no single quotes in the
          -- middle which might confuse bash.
          (Char
'\'': String
rs) -> String -> String
unescapeN String
rs

          -- We're weakly quoted.
          (Char
'"': String
rs)  -> String -> String
unescapeD String
rs

          -- We're not quoted at all.
          -- We need to unescape some characters like
          -- spaces and quotation marks.
          String
elsewise   -> String -> String
unescapeU String
elsewise
    in
      String -> String
forall {t :: * -> *}. Foldable t => t Char -> String
strong String
unescaped

    where
      strong :: t Char -> String
strong t Char
ss = Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> String -> String) -> String -> t Char -> String
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> String -> String
go String
"'" t Char
ss
        where
          -- If there's a single quote inside the
          -- command: exit from the strong quote and
          -- emit it the quote escaped, then resume.
          go :: Char -> String -> String
go Char
'\'' String
t = String
"'\\''" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
t
          go Char
h String
t    = Char
h Char -> String -> String
forall a. a -> [a] -> [a]
: String
t

      -- Unescape a strongly quoted string
      -- We have two recursive functions, as we
      -- can enter and exit the strong escaping.
      unescapeN :: String -> String
unescapeN = String -> String
goX
        where
          goX :: String -> String
goX (Char
'\'' : String
xs) = String -> String
goN String
xs
          goX (Char
x : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
          goX [] = []

          goN :: String -> String
goN (Char
'\\' : Char
'\'' : String
xs) = Char
'\'' Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goN String
xs
          goN (Char
'\'' : String
xs) = String -> String
goX String
xs
          goN (Char
x : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goN String
xs
          goN [] = []

      -- Unescape an unquoted string
      unescapeU :: String -> String
unescapeU = String -> String
goX
        where
          goX :: String -> String
goX [] = []
          goX (Char
'\\' : Char
x : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
          goX (Char
x : String
xs) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs

      -- Unescape a weakly quoted string
      unescapeD :: String -> String
unescapeD = String -> String
goX
        where
          -- Reached an escape character
          goX :: String -> String
goX (Char
'\\' : Char
x : String
xs)
            -- If it's true escapable, strip the
            -- slashes, as we're going to strong
            -- escape instead.
            | Char
x Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (String
"$`\"\\\n" :: String) = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
            | Bool
otherwise = Char
'\\' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
          -- We've ended quoted section, so we
          -- don't recurse on goX, it's done.
          goX (Char
'"' : String
xs)
            = String
xs
          -- Not done, but not a special character
          -- just continue the fold.
          goX (Char
x : String
xs)
            = Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
goX String
xs
          goX []
            = []


tagCompleter :: Tool -> [String] -> Completer
tagCompleter :: Tool -> [String] -> Completer
tagCompleter Tool
tool [String]
add = IO [String] -> Completer
listIOCompleter (IO [String] -> Completer) -> IO [String] -> Completer
forall a b. (a -> b) -> a -> b
$ do
  Dirs
dirs' <- IO Dirs -> IO Dirs
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Dirs
getAllDirs
  let loggerConfig :: LoggerConfig
loggerConfig = LoggerConfig
        { lcPrintDebug :: Bool
lcPrintDebug   = Bool
False
        , consoleOutter :: Text -> IO ()
consoleOutter  = Text -> IO ()
forall a. Monoid a => a
mempty
        , fileOutter :: Text -> IO ()
fileOutter     = Text -> IO ()
forall a. Monoid a => a
mempty
        , fancyColors :: Bool
fancyColors    = Bool
False
        }
  let appState :: LeanAppState
appState = Settings -> Dirs -> KeyBindings -> LoggerConfig -> LeanAppState
LeanAppState
        (Settings
defaultSettings { noNetwork = True })
        Dirs
dirs'
        KeyBindings
defaultKeyBindings
        LoggerConfig
loggerConfig

  VEither
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  PlatformRequest
mpFreq <- (ReaderT
   LeanAppState
   IO
   (VEither
      '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
      PlatformRequest)
 -> LeanAppState
 -> IO
      (VEither
         '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
         PlatformRequest))
-> LeanAppState
-> ReaderT
     LeanAppState
     IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
-> IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  LeanAppState
  IO
  (VEither
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     PlatformRequest)
-> LeanAppState
-> IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT LeanAppState
appState (ReaderT
   LeanAppState
   IO
   (VEither
      '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
      PlatformRequest)
 -> IO
      (VEither
         '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
         PlatformRequest))
-> (Excepts
      '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
      (ReaderT LeanAppState IO)
      PlatformRequest
    -> ReaderT
         LeanAppState
         IO
         (VEither
            '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
            PlatformRequest))
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     (ReaderT LeanAppState IO)
     PlatformRequest
-> IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Excepts
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  (ReaderT LeanAppState IO)
  PlatformRequest
-> ReaderT
     LeanAppState
     IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts
   '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
   (ReaderT LeanAppState IO)
   PlatformRequest
 -> IO
      (VEither
         '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
         PlatformRequest))
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     (ReaderT LeanAppState IO)
     PlatformRequest
-> IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
forall a b. (a -> b) -> a -> b
$ Excepts
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  (ReaderT LeanAppState IO)
  PlatformRequest
forall env (m :: * -> *).
(MonadReader env m, Alternative m, MonadFail m, HasLog env,
 MonadCatch m, MonadIO m) =>
Excepts
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  m
  PlatformRequest
platformRequest
  VEither
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  PlatformRequest
-> (PlatformRequest -> IO [String]) -> IO [String]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Applicative m, Monoid b) =>
t a -> (a -> m b) -> m b
forFold VEither
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  PlatformRequest
mpFreq ((PlatformRequest -> IO [String]) -> IO [String])
-> (PlatformRequest -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \PlatformRequest
pfreq -> do
    VEither
  '[DigestError, ContentLengthError, GPGError, JSONError,
    DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
  GHCupInfo
mGhcUpInfo <- (ReaderT
   LeanAppState
   IO
   (VEither
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      GHCupInfo)
 -> LeanAppState
 -> IO
      (VEither
         '[DigestError, ContentLengthError, GPGError, JSONError,
           DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
         GHCupInfo))
-> LeanAppState
-> ReaderT
     LeanAppState
     IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
-> IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  LeanAppState
  IO
  (VEither
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     GHCupInfo)
-> LeanAppState
-> IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT LeanAppState
appState (ReaderT
   LeanAppState
   IO
   (VEither
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      GHCupInfo)
 -> IO
      (VEither
         '[DigestError, ContentLengthError, GPGError, JSONError,
           DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
         GHCupInfo))
-> (Excepts
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      (ReaderT LeanAppState IO)
      GHCupInfo
    -> ReaderT
         LeanAppState
         IO
         (VEither
            '[DigestError, ContentLengthError, GPGError, JSONError,
              DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
            GHCupInfo))
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     (ReaderT LeanAppState IO)
     GHCupInfo
-> IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Excepts
  '[DigestError, ContentLengthError, GPGError, JSONError,
    DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
  (ReaderT LeanAppState IO)
  GHCupInfo
-> ReaderT
     LeanAppState
     IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts
   '[DigestError, ContentLengthError, GPGError, JSONError,
     DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
   (ReaderT LeanAppState IO)
   GHCupInfo
 -> IO
      (VEither
         '[DigestError, ContentLengthError, GPGError, JSONError,
           DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
         GHCupInfo))
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     (ReaderT LeanAppState IO)
     GHCupInfo
-> IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
forall a b. (a -> b) -> a -> b
$ PlatformRequest
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     (ReaderT LeanAppState IO)
     GHCupInfo
forall env (m :: * -> *).
(FromJSONKey Tool, FromJSONKey Version, FromJSON VersionInfo,
 MonadReader env m, HasSettings env, HasDirs env, MonadIO m,
 MonadCatch m, HasLog env, MonadThrow m, MonadFail m,
 MonadMask m) =>
PlatformRequest
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     GHCupInfo
getDownloadsF PlatformRequest
pfreq
    case VEither
  '[DigestError, ContentLengthError, GPGError, JSONError,
    DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
  GHCupInfo
mGhcUpInfo of
      VRight GHCupInfo
ghcupInfo -> do
        let allTags :: [Tag]
allTags = (Tag -> Bool) -> [Tag] -> [Tag]
forall a. (a -> Bool) -> [a] -> [a]
filter (Tag -> Tag -> Bool
forall a. Eq a => a -> a -> Bool
/= Tag
Old)
              ([Tag] -> [Tag]) -> [Tag] -> [Tag]
forall a b. (a -> b) -> a -> b
$ VersionInfo -> [Tag]
_viTags (VersionInfo -> [Tag]) -> [VersionInfo] -> [Tag]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Map GHCTargetVersion VersionInfo -> [VersionInfo]
forall k a. Map k a -> [a]
M.elems (GHCupDownloads -> Tool -> Map GHCTargetVersion VersionInfo
availableToolVersions (GHCupInfo -> GHCupDownloads
_ghcupDownloads GHCupInfo
ghcupInfo) Tool
tool)
        [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ([String]
add [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Tag -> String) -> [Tag] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tag -> String
tagToString [Tag]
allTags
      VLeft V '[DigestError, ContentLengthError, GPGError, JSONError,
    DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
_ -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure  ([String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String
"recommended", String
"latest", String
"latest-prerelease"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
add)

versionCompleter :: [ListCriteria] -> Tool -> Completer
versionCompleter :: [ListCriteria] -> Tool -> Completer
versionCompleter [ListCriteria]
criteria Tool
tool = [ListCriteria] -> Tool -> (Version -> Bool) -> Completer
versionCompleter' [ListCriteria]
criteria Tool
tool (Bool -> Version -> Bool
forall a b. a -> b -> a
const Bool
True)

versionCompleter' :: [ListCriteria] -> Tool -> (Version -> Bool) -> Completer
versionCompleter' :: [ListCriteria] -> Tool -> (Version -> Bool) -> Completer
versionCompleter' [ListCriteria]
criteria Tool
tool Version -> Bool
filter' = IO [String] -> Completer
listIOCompleter (IO [String] -> Completer) -> IO [String] -> Completer
forall a b. (a -> b) -> a -> b
$ do
  Dirs
dirs' <- IO Dirs -> IO Dirs
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Dirs
getAllDirs
  let loggerConfig :: LoggerConfig
loggerConfig = LoggerConfig
        { lcPrintDebug :: Bool
lcPrintDebug   = Bool
False
        , consoleOutter :: Text -> IO ()
consoleOutter  = Text -> IO ()
forall a. Monoid a => a
mempty
        , fileOutter :: Text -> IO ()
fileOutter     = Text -> IO ()
forall a. Monoid a => a
mempty
        , fancyColors :: Bool
fancyColors    = Bool
False
        }
  let settings :: Settings
settings = Settings
defaultSettings { noNetwork = True }
  let leanAppState :: LeanAppState
leanAppState = Settings -> Dirs -> KeyBindings -> LoggerConfig -> LeanAppState
LeanAppState
                   Settings
settings
                   Dirs
dirs'
                   KeyBindings
defaultKeyBindings
                   LoggerConfig
loggerConfig
  VEither
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  PlatformRequest
mpFreq <- (ReaderT
   LeanAppState
   IO
   (VEither
      '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
      PlatformRequest)
 -> LeanAppState
 -> IO
      (VEither
         '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
         PlatformRequest))
-> LeanAppState
-> ReaderT
     LeanAppState
     IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
-> IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  LeanAppState
  IO
  (VEither
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     PlatformRequest)
-> LeanAppState
-> IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT LeanAppState
leanAppState (ReaderT
   LeanAppState
   IO
   (VEither
      '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
      PlatformRequest)
 -> IO
      (VEither
         '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
         PlatformRequest))
-> (Excepts
      '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
      (ReaderT LeanAppState IO)
      PlatformRequest
    -> ReaderT
         LeanAppState
         IO
         (VEither
            '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
            PlatformRequest))
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     (ReaderT LeanAppState IO)
     PlatformRequest
-> IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Excepts
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  (ReaderT LeanAppState IO)
  PlatformRequest
-> ReaderT
     LeanAppState
     IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts
   '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
   (ReaderT LeanAppState IO)
   PlatformRequest
 -> IO
      (VEither
         '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
         PlatformRequest))
-> Excepts
     '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
     (ReaderT LeanAppState IO)
     PlatformRequest
-> IO
     (VEither
        '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
        PlatformRequest)
forall a b. (a -> b) -> a -> b
$ Excepts
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  (ReaderT LeanAppState IO)
  PlatformRequest
forall env (m :: * -> *).
(MonadReader env m, Alternative m, MonadFail m, HasLog env,
 MonadCatch m, MonadIO m) =>
Excepts
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  m
  PlatformRequest
platformRequest
  VEither
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  PlatformRequest
-> (PlatformRequest -> IO [String]) -> IO [String]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Applicative m, Monoid b) =>
t a -> (a -> m b) -> m b
forFold VEither
  '[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
  PlatformRequest
mpFreq ((PlatformRequest -> IO [String]) -> IO [String])
-> (PlatformRequest -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \PlatformRequest
pfreq -> do
    VEither
  '[DigestError, ContentLengthError, GPGError, JSONError,
    DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
  GHCupInfo
mGhcUpInfo <- (ReaderT
   LeanAppState
   IO
   (VEither
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      GHCupInfo)
 -> LeanAppState
 -> IO
      (VEither
         '[DigestError, ContentLengthError, GPGError, JSONError,
           DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
         GHCupInfo))
-> LeanAppState
-> ReaderT
     LeanAppState
     IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
-> IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  LeanAppState
  IO
  (VEither
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     GHCupInfo)
-> LeanAppState
-> IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT LeanAppState
leanAppState (ReaderT
   LeanAppState
   IO
   (VEither
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      GHCupInfo)
 -> IO
      (VEither
         '[DigestError, ContentLengthError, GPGError, JSONError,
           DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
         GHCupInfo))
-> (Excepts
      '[DigestError, ContentLengthError, GPGError, JSONError,
        DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
      (ReaderT LeanAppState IO)
      GHCupInfo
    -> ReaderT
         LeanAppState
         IO
         (VEither
            '[DigestError, ContentLengthError, GPGError, JSONError,
              DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
            GHCupInfo))
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     (ReaderT LeanAppState IO)
     GHCupInfo
-> IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Excepts
  '[DigestError, ContentLengthError, GPGError, JSONError,
    DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
  (ReaderT LeanAppState IO)
  GHCupInfo
-> ReaderT
     LeanAppState
     IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE (Excepts
   '[DigestError, ContentLengthError, GPGError, JSONError,
     DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
   (ReaderT LeanAppState IO)
   GHCupInfo
 -> IO
      (VEither
         '[DigestError, ContentLengthError, GPGError, JSONError,
           DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
         GHCupInfo))
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     (ReaderT LeanAppState IO)
     GHCupInfo
-> IO
     (VEither
        '[DigestError, ContentLengthError, GPGError, JSONError,
          DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
        GHCupInfo)
forall a b. (a -> b) -> a -> b
$ PlatformRequest
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     (ReaderT LeanAppState IO)
     GHCupInfo
forall env (m :: * -> *).
(FromJSONKey Tool, FromJSONKey Version, FromJSON VersionInfo,
 MonadReader env m, HasSettings env, HasDirs env, MonadIO m,
 MonadCatch m, HasLog env, MonadThrow m, MonadFail m,
 MonadMask m) =>
PlatformRequest
-> Excepts
     '[DigestError, ContentLengthError, GPGError, JSONError,
       DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
     m
     GHCupInfo
getDownloadsF PlatformRequest
pfreq
    VEither
  '[DigestError, ContentLengthError, GPGError, JSONError,
    DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
  GHCupInfo
-> (GHCupInfo -> IO [String]) -> IO [String]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Applicative m, Monoid b) =>
t a -> (a -> m b) -> m b
forFold VEither
  '[DigestError, ContentLengthError, GPGError, JSONError,
    DownloadFailed, FileDoesNotExistError, StackPlatformDetectError]
  GHCupInfo
mGhcUpInfo ((GHCupInfo -> IO [String]) -> IO [String])
-> (GHCupInfo -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \GHCupInfo
ghcupInfo -> do
      let appState :: AppState
appState = Settings
-> Dirs
-> KeyBindings
-> GHCupInfo
-> PlatformRequest
-> LoggerConfig
-> AppState
AppState
            Settings
settings
            Dirs
dirs'
            KeyBindings
defaultKeyBindings
            GHCupInfo
ghcupInfo
            PlatformRequest
pfreq
            LoggerConfig
loggerConfig

          runEnv :: ReaderT AppState m a -> m a
runEnv = (ReaderT AppState m a -> AppState -> m a)
-> AppState -> ReaderT AppState m a -> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT AppState m a -> AppState -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT AppState
appState

      [ListResult]
installedVersions <- ReaderT AppState IO [ListResult] -> IO [ListResult]
forall {m :: * -> *} {a}. ReaderT AppState m a -> m a
runEnv (ReaderT AppState IO [ListResult] -> IO [ListResult])
-> ReaderT AppState IO [ListResult] -> IO [ListResult]
forall a b. (a -> b) -> a -> b
$ Maybe Tool
-> [ListCriteria]
-> Bool
-> Bool
-> (Maybe Day, Maybe Day)
-> ReaderT AppState IO [ListResult]
forall (m :: * -> *) env.
(MonadCatch m, HasLog env, MonadThrow m, HasLog env, MonadIO m,
 MonadReader env m, HasDirs env, HasPlatformReq env,
 HasGHCupInfo env) =>
Maybe Tool
-> [ListCriteria]
-> Bool
-> Bool
-> (Maybe Day, Maybe Day)
-> m [ListResult]
listVersions (Tool -> Maybe Tool
forall a. a -> Maybe a
Just Tool
tool) [ListCriteria]
criteria Bool
False Bool
False (Maybe Day
forall a. Maybe a
Nothing, Maybe Day
forall a. Maybe a
Nothing)
      [String] -> IO [String]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (Version -> String) -> [Version] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
T.unpack (Text -> String) -> (Version -> Text) -> Version -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> Text
prettyVer) ([Version] -> [String])
-> ([ListResult] -> [Version]) -> [ListResult] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Bool) -> [Version] -> [Version]
forall a. (a -> Bool) -> [a] -> [a]
filter Version -> Bool
filter' ([Version] -> [Version])
-> ([ListResult] -> [Version]) -> [ListResult] -> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListResult -> Version) -> [ListResult] -> [Version]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ListResult -> Version
lVer ([ListResult] -> [String]) -> [ListResult] -> [String]
forall a b. (a -> b) -> a -> b
$ [ListResult]
installedVersions


toolDlCompleter :: Tool -> Completer
toolDlCompleter :: Tool -> Completer
toolDlCompleter Tool
tool = (String -> IO [String]) -> Completer
mkCompleter ((String -> IO [String]) -> Completer)
-> (String -> IO [String]) -> Completer
forall a b. (a -> b) -> a -> b
$ \case
  String
"" -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tool -> [String]
initUrl Tool
tool [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String
"https://", String
"http://", String
"file:///"])
  String
word
    | String
"file://" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
word -> [String] -> String -> IO [String]
fileUri' [] String
word
    -- downloads.haskell.org
    | String
"https://downloads.haskell.org/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
word ->
        (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
completePrefix String
word) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
prefixMatch (String -> String
FP.takeFileName String
word) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [String]
fromHRef String
word

    -- github releases
    | String
"https://github.com/haskell/haskell-language-server/releases/download/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
word
    , let xs :: [String]
xs = String -> [String]
splitPath String
word
    , ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
&& String -> Char
forall a. HasCallStack => [a] -> a
last String
word Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Bool -> Bool -> Bool
|| ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 Bool -> Bool -> Bool
&& String -> Char
forall a. HasCallStack => [a] -> a
last String
word Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') ->
        (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> String -> String -> String
completePrefix String
word String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/") ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
prefixMatch (String -> String
FP.takeFileName String
word) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO [String]
getGithubReleases String
"haskell" String
"haskell-language-server"
    | String
"https://github.com/commercialhaskell/stack/releases/download/" String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
word
    , let xs :: [String]
xs = String -> [String]
splitPath String
word
    , ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 Bool -> Bool -> Bool
&& String -> Char
forall a. HasCallStack => [a] -> a
last String
word Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Bool -> Bool -> Bool
|| ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 Bool -> Bool -> Bool
&& String -> Char
forall a. HasCallStack => [a] -> a
last String
word Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') ->
        (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\String
x -> String -> String -> String
completePrefix String
word String
x String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/") ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
prefixMatch (String -> String
FP.takeFileName String
word) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> IO [String]
getGithubReleases String
"commercialhaskell" String
"stack"

    -- github release assets
    | String
"https://github.com/haskell/haskell-language-server/releases/download/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
word
    , let xs :: [String]
xs = String -> [String]
splitPath String
word
    , ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 Bool -> Bool -> Bool
&& String -> Char
forall a. HasCallStack => [a] -> a
last String
word Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Bool -> Bool -> Bool
|| [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8
    , let rel :: String
rel = [String]
xs [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
6
    , String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
rel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> do
        (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
completePrefix String
word) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
prefixMatch (String -> String
FP.takeFileName String
word) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> String -> IO [String]
getGithubAssets String
"haskell" String
"haskell-language-server" (String -> String
forall a. HasCallStack => [a] -> [a]
init String
rel)
    | String
"https://github.com/commercialhaskell/stack/releases/download/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
word
    , let xs :: [String]
xs = String -> [String]
splitPath String
word
    , ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 Bool -> Bool -> Bool
&& String -> Char
forall a. HasCallStack => [a] -> a
last String
word Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') Bool -> Bool -> Bool
|| [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
8
    , let rel :: String
rel = [String]
xs [String] -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
6
    , String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
rel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 -> do
        (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
completePrefix String
word) ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
prefixMatch (String -> String
FP.takeFileName String
word) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> String -> IO [String]
getGithubAssets String
"commercialhaskell" String
"stack" (String -> String
forall a. HasCallStack => [a] -> [a]
init String
rel)

    -- github
    | String
"https://github.com/c" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
word -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"https://github.com/commercialhaskell/stack/releases/download/"]
    | String
"https://github.com/h" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
word -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"https://github.com/haskell/haskell-language-server/releases/download/"]
    | String
"https://g" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
word
    , Tool
tool Tool -> Tool -> Bool
forall a. Eq a => a -> a -> Bool
== Tool
Stack -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"https://github.com/commercialhaskell/stack/releases/download/"]
    | String
"https://g" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
word
    , Tool
tool Tool -> Tool -> Bool
forall a. Eq a => a -> a -> Bool
== Tool
HLS -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"https://github.com/haskell/haskell-language-server/releases/download/"]

    | String
"https://d" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
word -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"https://downloads.haskell.org/" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Tool -> [String]
initUrl Tool
tool

    | String
"h" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
word -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ Tool -> [String]
initUrl Tool
tool

    | String
word String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"file:///" -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"file:///"]
    | String
word String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"https://" -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"https://"]
    | String
word String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"http://"  -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"http://"]

    | Bool
otherwise -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
 where
  initUrl :: Tool -> [String]
  initUrl :: Tool -> [String]
initUrl Tool
GHC   = [ String
"https://downloads.haskell.org/~ghc/"
                  , String
"https://downloads.haskell.org/~ghcup/unofficial-bindists/ghc/"
                  ]
  initUrl Tool
Cabal = [ String
"https://downloads.haskell.org/~cabal/"
                  , String
"https://downloads.haskell.org/~ghcup/unofficial-bindists/cabal/"
                  ]
  initUrl Tool
GHCup = [ String
"https://downloads.haskell.org/~ghcup/" ]
  initUrl Tool
HLS   = [ String
"https://github.com/haskell/haskell-language-server/releases/download/"
                  , String
"https://downloads.haskell.org/~ghcup/unofficial-bindists/haskell-language-server/"
                  ]
  initUrl Tool
Stack = [ String
"https://github.com/commercialhaskell/stack/releases/download/"
                  , String
"https://downloads.haskell.org/~ghcup/unofficial-bindists/stack/"
                  ]

  completePrefix :: String -- ^ url, e.g.    'https://github.com/haskell/haskell-languag'
                 -> String -- ^ match, e.g.  'haskell-language-server'
                 -> String -- ^ result, e.g. 'https://github.com/haskell/haskell-language-server'
  completePrefix :: String -> String -> String
completePrefix String
url String
match =
    let base :: String
base = String -> String
FP.takeDirectory String
url
        fn :: String
fn   = String -> String
FP.takeFileName String
url
    in if String
fn String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
match then String
base String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
match else String
url

  prefixMatch :: String -> [String] -> [String]
  prefixMatch :: String -> [String] -> [String]
prefixMatch String
pref = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
pref String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)

  fromHRef :: String -> IO [String]
  fromHRef :: String -> IO [String]
fromHRef String
url = String -> Int -> (ByteString -> IO [String]) -> IO [String]
withCurl (String -> String
FP.takeDirectory String
url) Int
2_000_000 ((ByteString -> IO [String]) -> IO [String])
-> (ByteString -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \ByteString
stdout ->
      [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ([String] -> IO [String])
-> (ByteString -> [String]) -> ByteString -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag ByteString -> String) -> [Tag ByteString] -> [String]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> String
T.unpack (Text -> String)
-> (Tag ByteString -> Text) -> Tag ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe' (ByteString -> Text)
-> (Tag ByteString -> ByteString) -> Tag ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Tag ByteString -> ByteString
forall str.
(Show str, Eq str, StringLike str) =>
str -> Tag str -> str
fromAttrib ByteString
"href")
        ([Tag ByteString] -> [String])
-> (ByteString -> [Tag ByteString]) -> ByteString -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag ByteString -> Bool) -> [Tag ByteString] -> [Tag ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter Tag ByteString -> Bool
forall str. Tag str -> Bool
isTagOpen
        ([Tag ByteString] -> [Tag ByteString])
-> (ByteString -> [Tag ByteString])
-> ByteString
-> [Tag ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Tag ByteString -> Bool) -> [Tag ByteString] -> [Tag ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Tag ByteString -> String -> Bool
forall str t. (StringLike str, TagRep t) => Tag str -> t -> Bool
~== (String
"<a href>" :: String))
        ([Tag ByteString] -> [Tag ByteString])
-> (ByteString -> [Tag ByteString])
-> ByteString
-> [Tag ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Tag ByteString]
forall str. StringLike str => str -> [Tag str]
parseTags
        (ByteString -> IO [String]) -> ByteString -> IO [String]
forall a b. (a -> b) -> a -> b
$ ByteString
stdout

  withCurl :: String                      -- ^ url
           -> Int                         -- ^ delay
           -> (ByteString -> IO [String]) -- ^ callback
           -> IO [String]
  withCurl :: String -> Int -> (ByteString -> IO [String]) -> IO [String]
withCurl String
url Int
delay ByteString -> IO [String]
cb = do
    let limit :: IO ()
limit = Int -> IO ()
threadDelay Int
delay
    IO () -> IO CapturedProcess -> IO (Either () CapturedProcess)
forall a b. IO a -> IO b -> IO (Either a b)
race IO ()
limit (String -> [String] -> Maybe String -> IO CapturedProcess
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> Maybe String -> m CapturedProcess
executeOut String
"curl" [String
"-fL", String
url] Maybe String
forall a. Maybe a
Nothing) IO (Either () CapturedProcess)
-> (Either () CapturedProcess -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Right (CapturedProcess {ExitCode
_exitCode :: ExitCode
_exitCode :: CapturedProcess -> ExitCode
_exitCode, ByteString
_stdOut :: ByteString
_stdOut :: CapturedProcess -> ByteString
_stdOut}) -> do
        case ExitCode
_exitCode of
          ExitCode
ExitSuccess ->
            (forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try @_ @SomeException (IO [String] -> IO (Either SomeException [String]))
-> (ByteString -> IO [String])
-> ByteString
-> IO (Either SomeException [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO [String]
cb (ByteString -> IO (Either SomeException [String]))
-> ByteString -> IO (Either SomeException [String])
forall a b. (a -> b) -> a -> b
$ ByteString
_stdOut) IO (Either SomeException [String])
-> (Either SomeException [String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Left SomeException
_ ->  [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
              Right [String]
r' -> do
                Either SomeException [String]
r <- forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
m a -> m (Either e a)
try @_ @SomeException
                  (IO [String] -> IO (Either SomeException [String]))
-> ([String] -> IO [String])
-> [String]
-> IO (Either SomeException [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> IO [String]
forall a. a -> IO a
evaluate
                  ([String] -> IO [String])
-> ([String] -> [String]) -> [String] -> IO [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. NFData a => a -> a
force
                  ([String] -> IO (Either SomeException [String]))
-> [String] -> IO (Either SomeException [String])
forall a b. (a -> b) -> a -> b
$ [String]
r'
                (SomeException -> IO [String])
-> ([String] -> IO [String])
-> Either SomeException [String]
-> IO [String]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\SomeException
_ -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either SomeException [String]
r
          ExitFailure Int
_ -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Left ()
_ -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

  getGithubReleases :: String
                    -> String
                    -> IO [String]
  getGithubReleases :: String -> String -> IO [String]
getGithubReleases String
owner String
repo = String -> Int -> (ByteString -> IO [String]) -> IO [String]
withCurl String
url Int
3_000_000 ((ByteString -> IO [String]) -> IO [String])
-> (ByteString -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \ByteString
stdout -> do
    Just Array
xs <- Maybe Array -> IO (Maybe Array)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Array -> IO (Maybe Array))
-> Maybe Array -> IO (Maybe Array)
forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Maybe a
decode' @Array ByteString
stdout
    (Vector String -> [String]) -> IO (Vector String) -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector String -> [String]
forall a. Vector a -> [a]
V.toList (IO (Vector String) -> IO [String])
-> IO (Vector String) -> IO [String]
forall a b. (a -> b) -> a -> b
$ Array -> (Value -> IO String) -> IO (Vector String)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Array
xs ((Value -> IO String) -> IO (Vector String))
-> (Value -> IO String) -> IO (Vector String)
forall a b. (a -> b) -> a -> b
$ \Value
x -> do
      (Object Object
r) <- Value -> IO Value
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
x
      Just (String Text
name) <- Maybe Value -> IO (Maybe Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> IO (Maybe Value))
-> Maybe Value -> IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (String -> Key
mkval String
"tag_name") Object
r
      String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
name
   where
    url :: String
url = String
"https://api.github.com/repos/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
owner String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
repo String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/releases"

  getGithubAssets :: String
                  -> String
                  -> String
                  -> IO [String]
  getGithubAssets :: String -> String -> String -> IO [String]
getGithubAssets String
owner String
repo String
tag = String -> Int -> (ByteString -> IO [String]) -> IO [String]
withCurl String
url Int
3_000_000 ((ByteString -> IO [String]) -> IO [String])
-> (ByteString -> IO [String]) -> IO [String]
forall a b. (a -> b) -> a -> b
$ \ByteString
stdout -> do
    Just Object
xs <- Maybe Object -> IO (Maybe Object)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Object -> IO (Maybe Object))
-> Maybe Object -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Maybe a
decode' @Object ByteString
stdout
    Just (Array Array
assets) <- Maybe Value -> IO (Maybe Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> IO (Maybe Value))
-> Maybe Value -> IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (String -> Key
mkval String
"assets") Object
xs
    [String]
as <- (Vector String -> [String]) -> IO (Vector String) -> IO [String]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Vector String -> [String]
forall a. Vector a -> [a]
V.toList (IO (Vector String) -> IO [String])
-> IO (Vector String) -> IO [String]
forall a b. (a -> b) -> a -> b
$ Array -> (Value -> IO String) -> IO (Vector String)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Array
assets ((Value -> IO String) -> IO (Vector String))
-> (Value -> IO String) -> IO (Vector String)
forall a b. (a -> b) -> a -> b
$ \Value
val -> do
      (Object Object
asset) <- Value -> IO Value
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
val
      Just (String Text
name) <- Maybe Value -> IO (Maybe Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Value -> IO (Maybe Value))
-> Maybe Value -> IO (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KM.lookup (String -> Key
mkval String
"name") Object
asset
      String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
name
    [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
as
   where
    url :: String
url = String
"https://api.github.com/repos/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
owner String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
repo String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/releases/tags/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tag


#if MIN_VERSION_aeson(2,0,0)
  mkval :: String -> Key
mkval = String -> Key
KM.fromString
#else
  mkval = id
#endif


checkForUpdates :: ( MonadReader env m
                   , HasGHCupInfo env
                   , HasDirs env
                   , HasPlatformReq env
                   , MonadCatch m
                   , HasLog env
                   , MonadThrow m
                   , MonadIO m
                   , MonadFail m
                   )
                => m [(Tool, GHCTargetVersion)]
checkForUpdates :: forall env (m :: * -> *).
(MonadReader env m, HasGHCupInfo env, HasDirs env,
 HasPlatformReq env, MonadCatch m, HasLog env, MonadThrow m,
 MonadIO m, MonadFail m) =>
m [(Tool, GHCTargetVersion)]
checkForUpdates = do
  GHCupInfo { _ghcupDownloads :: GHCupInfo -> GHCupDownloads
_ghcupDownloads = GHCupDownloads
dls } <- m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
  [ListResult]
lInstalled <- Maybe Tool
-> [ListCriteria]
-> Bool
-> Bool
-> (Maybe Day, Maybe Day)
-> m [ListResult]
forall (m :: * -> *) env.
(MonadCatch m, HasLog env, MonadThrow m, HasLog env, MonadIO m,
 MonadReader env m, HasDirs env, HasPlatformReq env,
 HasGHCupInfo env) =>
Maybe Tool
-> [ListCriteria]
-> Bool
-> Bool
-> (Maybe Day, Maybe Day)
-> m [ListResult]
listVersions Maybe Tool
forall a. Maybe a
Nothing [Bool -> ListCriteria
ListInstalled Bool
True] Bool
False Bool
False (Maybe Day
forall a. Maybe a
Nothing, Maybe Day
forall a. Maybe a
Nothing)
  let latestInstalled :: Tool -> Maybe GHCTargetVersion
latestInstalled Tool
tool = ((ListResult -> GHCTargetVersion)
-> Maybe ListResult -> Maybe GHCTargetVersion
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\ListResult
lr -> Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion (ListResult -> Maybe Text
lCross ListResult
lr) (ListResult -> Version
lVer ListResult
lr)) (Maybe ListResult -> Maybe GHCTargetVersion)
-> ([ListResult] -> Maybe ListResult)
-> [ListResult]
-> Maybe GHCTargetVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ListResult] -> Maybe ListResult
forall a. [a] -> Maybe a
lastMay ([ListResult] -> Maybe ListResult)
-> ([ListResult] -> [ListResult])
-> [ListResult]
-> Maybe ListResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListResult -> Bool) -> [ListResult] -> [ListResult]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ListResult
lr -> ListResult -> Tool
lTool ListResult
lr Tool -> Tool -> Bool
forall a. Eq a => a -> a -> Bool
== Tool
tool)) [ListResult]
lInstalled

  Maybe (Tool, GHCTargetVersion)
ghcup <- Maybe (GHCTargetVersion, VersionInfo)
-> ((GHCTargetVersion, VersionInfo)
    -> m (Maybe (Tool, GHCTargetVersion)))
-> m (Maybe (Tool, GHCTargetVersion))
forall {m :: * -> *} {f :: * -> *} {a} {a}.
(Traversable m, Monad m, Monad f) =>
m a -> (a -> f (m a)) -> f (m a)
forMM (GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatest GHCupDownloads
dls Tool
GHCup) (((GHCTargetVersion, VersionInfo)
  -> m (Maybe (Tool, GHCTargetVersion)))
 -> m (Maybe (Tool, GHCTargetVersion)))
-> ((GHCTargetVersion, VersionInfo)
    -> m (Maybe (Tool, GHCTargetVersion)))
-> m (Maybe (Tool, GHCTargetVersion))
forall a b. (a -> b) -> a -> b
$ \(GHCTargetVersion Maybe Text
_ Version
l, VersionInfo
_) -> do
    (Right Version
ghcup_ver) <- Either ParsingError Version -> m (Either ParsingError Version)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ParsingError Version -> m (Either ParsingError Version))
-> Either ParsingError Version -> m (Either ParsingError Version)
forall a b. (a -> b) -> a -> b
$ Text -> Either ParsingError Version
version (Text -> Either ParsingError Version)
-> Text -> Either ParsingError Version
forall a b. (a -> b) -> a -> b
$ PVP -> Text
prettyPVP PVP
ghcUpVer
    if (Version
l Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
> Version
ghcup_ver) then Maybe (Tool, GHCTargetVersion)
-> m (Maybe (Tool, GHCTargetVersion))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Tool, GHCTargetVersion)
 -> m (Maybe (Tool, GHCTargetVersion)))
-> Maybe (Tool, GHCTargetVersion)
-> m (Maybe (Tool, GHCTargetVersion))
forall a b. (a -> b) -> a -> b
$ (Tool, GHCTargetVersion) -> Maybe (Tool, GHCTargetVersion)
forall a. a -> Maybe a
Just (Tool
GHCup, Version -> GHCTargetVersion
mkTVer Version
l) else Maybe (Tool, GHCTargetVersion)
-> m (Maybe (Tool, GHCTargetVersion))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Tool, GHCTargetVersion)
forall a. Maybe a
Nothing

  [Maybe (Tool, GHCTargetVersion)]
otherTools <- [Tool]
-> (Tool -> m (Maybe (Tool, GHCTargetVersion)))
-> m [Maybe (Tool, GHCTargetVersion)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Tool
GHC, Tool
Cabal, Tool
HLS, Tool
Stack] ((Tool -> m (Maybe (Tool, GHCTargetVersion)))
 -> m [Maybe (Tool, GHCTargetVersion)])
-> (Tool -> m (Maybe (Tool, GHCTargetVersion)))
-> m [Maybe (Tool, GHCTargetVersion)]
forall a b. (a -> b) -> a -> b
$ \Tool
t ->
    Maybe (GHCTargetVersion, VersionInfo)
-> ((GHCTargetVersion, VersionInfo)
    -> m (Maybe (Tool, GHCTargetVersion)))
-> m (Maybe (Tool, GHCTargetVersion))
forall {m :: * -> *} {f :: * -> *} {a} {a}.
(Traversable m, Monad m, Monad f) =>
m a -> (a -> f (m a)) -> f (m a)
forMM (GHCupDownloads -> Tool -> Maybe (GHCTargetVersion, VersionInfo)
getLatest GHCupDownloads
dls Tool
t) (((GHCTargetVersion, VersionInfo)
  -> m (Maybe (Tool, GHCTargetVersion)))
 -> m (Maybe (Tool, GHCTargetVersion)))
-> ((GHCTargetVersion, VersionInfo)
    -> m (Maybe (Tool, GHCTargetVersion)))
-> m (Maybe (Tool, GHCTargetVersion))
forall a b. (a -> b) -> a -> b
$ \(GHCTargetVersion
l, VersionInfo
_) -> do
      let mver :: Maybe GHCTargetVersion
mver = Tool -> Maybe GHCTargetVersion
latestInstalled Tool
t
      Maybe GHCTargetVersion
-> (GHCTargetVersion -> m (Maybe (Tool, GHCTargetVersion)))
-> m (Maybe (Tool, GHCTargetVersion))
forall {m :: * -> *} {f :: * -> *} {a} {a}.
(Traversable m, Monad m, Monad f) =>
m a -> (a -> f (m a)) -> f (m a)
forMM Maybe GHCTargetVersion
mver ((GHCTargetVersion -> m (Maybe (Tool, GHCTargetVersion)))
 -> m (Maybe (Tool, GHCTargetVersion)))
-> (GHCTargetVersion -> m (Maybe (Tool, GHCTargetVersion)))
-> m (Maybe (Tool, GHCTargetVersion))
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
ver ->
        if (GHCTargetVersion
l GHCTargetVersion -> GHCTargetVersion -> Bool
forall a. Ord a => a -> a -> Bool
> GHCTargetVersion
ver) then Maybe (Tool, GHCTargetVersion)
-> m (Maybe (Tool, GHCTargetVersion))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Tool, GHCTargetVersion)
 -> m (Maybe (Tool, GHCTargetVersion)))
-> Maybe (Tool, GHCTargetVersion)
-> m (Maybe (Tool, GHCTargetVersion))
forall a b. (a -> b) -> a -> b
$ (Tool, GHCTargetVersion) -> Maybe (Tool, GHCTargetVersion)
forall a. a -> Maybe a
Just (Tool
t, GHCTargetVersion
l) else Maybe (Tool, GHCTargetVersion)
-> m (Maybe (Tool, GHCTargetVersion))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Tool, GHCTargetVersion)
forall a. Maybe a
Nothing

  [(Tool, GHCTargetVersion)] -> m [(Tool, GHCTargetVersion)]
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Tool, GHCTargetVersion)] -> m [(Tool, GHCTargetVersion)])
-> [(Tool, GHCTargetVersion)] -> m [(Tool, GHCTargetVersion)]
forall a b. (a -> b) -> a -> b
$ [Maybe (Tool, GHCTargetVersion)] -> [(Tool, GHCTargetVersion)]
forall a. [Maybe a] -> [a]
catMaybes (Maybe (Tool, GHCTargetVersion)
ghcupMaybe (Tool, GHCTargetVersion)
-> [Maybe (Tool, GHCTargetVersion)]
-> [Maybe (Tool, GHCTargetVersion)]
forall a. a -> [a] -> [a]
:[Maybe (Tool, GHCTargetVersion)]
otherTools)
 where
  forMM :: m a -> (a -> f (m a)) -> f (m a)
forMM m a
a a -> f (m a)
f = (m (m a) -> m a) -> f (m (m a)) -> f (m a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (f (m (m a)) -> f (m a)) -> f (m (m a)) -> f (m a)
forall a b. (a -> b) -> a -> b
$ m a -> (a -> f (m a)) -> f (m (m a))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM m a
a a -> f (m a)
f

logGHCPostRm :: (MonadReader env m, HasLog env, MonadIO m) => GHCTargetVersion -> m ()
logGHCPostRm :: forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
GHCTargetVersion -> m ()
logGHCPostRm GHCTargetVersion
ghcVer = do
  String
cabalStore <- IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ (IOException -> IO String) -> IO String -> IO String
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> if Bool
isWindows then String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"C:\\cabal\\store" else String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"~/.cabal/store or ~/.local/state/cabal/store")
    IO String
getStoreDir
  let storeGhcDir :: String
storeGhcDir = String
cabalStore String -> String -> String
</> (String
"ghc-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (Version -> Text
prettyVer (Version -> Text) -> Version -> Text
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
ghcVer))
  Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
 LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"After removing GHC you might also want to clean up your cabal store at: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
storeGhcDir