{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.Utils
( module GHCup.Utils.Dirs
, module GHCup.Utils
#if defined(IS_WINDOWS)
, module GHCup.Utils.Windows
#else
, module GHCup.Utils.Posix
#endif
)
where
#if defined(IS_WINDOWS)
import GHCup.Utils.Windows
#else
import GHCup.Utils.Posix
#endif
import GHCup.Download
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs
import GHCup.Utils.File
import GHCup.Utils.Logger
import GHCup.Utils.MegaParsec
import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
import Codec.Archive hiding ( Directory )
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Monad.Reader
import Control.Monad.Trans.Resource
hiding ( throwM )
import Control.Monad.IO.Unlift ( MonadUnliftIO( withRunInIO ) )
import Data.Bifunctor ( first )
import Data.ByteString ( ByteString )
import Data.Either
import Data.Foldable
import Data.List
import Data.List.NonEmpty ( NonEmpty( (:|) ))
import Data.Maybe
import Data.Text ( Text )
import Data.Versions hiding ( patch )
import GHC.IO.Exception
import Haskus.Utils.Variant.Excepts
import Optics
import Safe
import System.Directory hiding ( findFiles )
import System.FilePath
import System.IO.Error
import Text.Regex.Posix
import URI.ByteString
import qualified Codec.Compression.BZip as BZip
import qualified Codec.Compression.GZip as GZip
import qualified Codec.Compression.Lzma as Lzma
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP
import qualified Data.List.NonEmpty as NE
binarySymLinkDestination :: ( MonadThrow m
, MonadIO m
)
=> FilePath
-> FilePath
-> m FilePath
binarySymLinkDestination :: FilePath -> FilePath -> m FilePath
binarySymLinkDestination FilePath
binDir FilePath
toolPath = do
FilePath
toolPath' <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
toolPath
FilePath
binDir' <- IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> m FilePath) -> IO FilePath -> m FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
canonicalizePath FilePath
binDir
FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> FilePath -> FilePath
relativeSymlink FilePath
binDir' FilePath
toolPath')
rmMinorGHCSymlinks :: ( MonadReader env m
, HasDirs env
, MonadIO m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadMask m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMinorGHCSymlinks :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorGHCSymlinks tv :: GHCTargetVersion
tv@GHCTargetVersion{Maybe Text
Version
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
_tvVersion :: Version
_tvTarget :: Maybe Text
..} = do
Dirs {FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
..} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
[FilePath]
files <- Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath])
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadFail m,
MonadIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles GHCTargetVersion
tv
[FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files ((FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
let f_xyz :: FilePath
f_xyz = FilePath
f FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
_tvVersion) FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
let fullF :: FilePath
fullF = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
f_xyz
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullF)
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
fullF
rmPlainGHC :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadMask m
)
=> Maybe Text
-> Excepts '[NotInstalled] m ()
rmPlainGHC :: Maybe Text -> Excepts '[NotInstalled] m ()
rmPlainGHC Maybe Text
target = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
Maybe GHCTargetVersion
mtv <- m (Maybe GHCTargetVersion)
-> Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe GHCTargetVersion)
-> Excepts '[NotInstalled] m (Maybe GHCTargetVersion))
-> m (Maybe GHCTargetVersion)
-> Excepts '[NotInstalled] m (Maybe GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> m (Maybe GHCTargetVersion)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) =>
Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
target
Maybe GHCTargetVersion
-> (GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe GHCTargetVersion
mtv ((GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (GHCTargetVersion -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion
tv -> do
[FilePath]
files <- Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath])
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadFail m,
MonadIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles GHCTargetVersion
tv
[FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files ((FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
let fullF :: FilePath
fullF = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
f FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullF)
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
fullF
let hdc_file :: FilePath
hdc_file = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"haddock-ghc" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
hdc_file)
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
hdc_file
rmMajorGHCSymlinks :: ( MonadReader env m
, HasDirs env
, MonadIO m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadMask m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMajorGHCSymlinks :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorGHCSymlinks tv :: GHCTargetVersion
tv@GHCTargetVersion{Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
..} = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
(Int
mj, Int
mi) <- Version -> Excepts '[NotInstalled] m (Int, Int)
forall (m :: * -> *). MonadThrow m => Version -> m (Int, Int)
getMajorMinorV Version
_tvVersion
let v' :: Text
v' = Int -> Text
forall a. Integral a => a -> Text
intToText Int
mj Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Integral a => a -> Text
intToText Int
mi
[FilePath]
files <- Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath])
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadFail m,
MonadIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles GHCTargetVersion
tv
[FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
files ((FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
let f_xy :: FilePath
f_xy = FilePath
f FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack Text
v' FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
let fullF :: FilePath
fullF = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
f_xy
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullF)
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
fullF
rmMinorHLSSymlinks :: ( MonadReader env m
, HasDirs env
, MonadIO m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadMask m
)
=> Version
-> Excepts '[NotInstalled] m ()
rmMinorHLSSymlinks :: Version -> Excepts '[NotInstalled] m ()
rmMinorHLSSymlinks Version
ver = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
[FilePath]
hlsBins <- Version -> Excepts '[NotInstalled] m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) =>
Version -> m [FilePath]
hlsAllBinaries Version
ver
[FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
hlsBins ((FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
let fullF :: FilePath
fullF = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
f
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullF)
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
fullF
rmPlainHLS :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadMask m
)
=> Excepts '[NotInstalled] m ()
rmPlainHLS :: Excepts '[NotInstalled] m ()
rmPlainHLS = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs -> Excepts '[NotInstalled] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
[FilePath]
hlsBins <- ([FilePath] -> [FilePath])
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
f -> Bool -> Bool
not (FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
f) Bool -> Bool -> Bool
&& (Char
'~' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` FilePath
f)))
(Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath])
-> Excepts '[NotInstalled] m [FilePath]
-> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ IO [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Excepts '[NotInstalled] m [FilePath])
-> IO [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
FilePath
binDir
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended ExecOption
execBlank ([s|^haskell-language-server-.*$|] :: ByteString))
[FilePath]
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
hlsBins ((FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (FilePath -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> do
let fullF :: FilePath
fullF = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
f
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullF)
if Bool
isWindows
then m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
fullF
else m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
fullF
let hlswrapper :: FilePath
hlswrapper = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
hlswrapper)
if Bool
isWindows
then m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
hlswrapper
else m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmFile FilePath
hlswrapper
ghcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled :: GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver = do
FilePath
ghcdir <- GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ver
IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
ghcdir
ghcSrcInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) => GHCTargetVersion -> m Bool
ghcSrcInstalled :: GHCTargetVersion -> m Bool
ghcSrcInstalled GHCTargetVersion
ver = do
FilePath
ghcdir <- GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ver
IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesFileExist (FilePath
ghcdir FilePath -> FilePath -> FilePath
</> FilePath
ghcUpSrcBuiltFile)
ghcSet :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> Maybe Text
-> m (Maybe GHCTargetVersion)
ghcSet :: Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
mtarget = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let ghc :: FilePath
ghc = FilePath -> (Text -> FilePath) -> Maybe Text -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"ghc" (\Text
t -> Text -> FilePath
T.unpack Text
t FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"-ghc") Maybe Text
mtarget
let ghcBin :: FilePath
ghcBin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
ghc FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
IO (Maybe GHCTargetVersion) -> m (Maybe GHCTargetVersion)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GHCTargetVersion) -> m (Maybe GHCTargetVersion))
-> IO (Maybe GHCTargetVersion) -> m (Maybe GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ IOErrorType
-> (IOException -> IO (Maybe GHCTargetVersion))
-> IO (Maybe GHCTargetVersion)
-> IO (Maybe GHCTargetVersion)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
NoSuchThing (\IOException
_ -> Maybe GHCTargetVersion -> IO (Maybe GHCTargetVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe GHCTargetVersion
forall a. Maybe a
Nothing) (IO (Maybe GHCTargetVersion) -> IO (Maybe GHCTargetVersion))
-> IO (Maybe GHCTargetVersion) -> IO (Maybe GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ do
FilePath
link <- IO FilePath -> IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
getLinkTarget FilePath
ghcBin
GHCTargetVersion -> Maybe GHCTargetVersion
forall a. a -> Maybe a
Just (GHCTargetVersion -> Maybe GHCTargetVersion)
-> IO GHCTargetVersion -> IO (Maybe GHCTargetVersion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO GHCTargetVersion
forall (m :: * -> *).
MonadThrow m =>
FilePath -> m GHCTargetVersion
ghcLinkVersion FilePath
link
where
ghcLinkVersion :: MonadThrow m => FilePath -> m GHCTargetVersion
ghcLinkVersion :: FilePath -> m GHCTargetVersion
ghcLinkVersion (FilePath -> Text
T.pack (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix FilePath
exeExt -> Text
t) = Either (ParseErrorBundle Text Void) GHCTargetVersion
-> m GHCTargetVersion
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either (ParseErrorBundle Text Void) GHCTargetVersion
-> m GHCTargetVersion)
-> Either (ParseErrorBundle Text Void) GHCTargetVersion
-> m GHCTargetVersion
forall a b. (a -> b) -> a -> b
$ Parsec Void Text GHCTargetVersion
-> FilePath
-> Text
-> Either (ParseErrorBundle Text Void) GHCTargetVersion
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text GHCTargetVersion
parser FilePath
"ghcLinkVersion" Text
t
where
parser :: Parsec Void Text GHCTargetVersion
parser =
(do
Text
_ <- Parsec Void Text FilePath -> Parsec Void Text Text
forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 Parsec Void Text FilePath
ghcSubPath
FilePath
_ <- Parsec Void Text FilePath
ghcSubPath
Text
r <- Parsec Void Text Char -> Parsec Void Text Text
forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 Parsec Void Text Char
pathSep
Text
rest <- Parsec Void Text Text
forall e s (m :: * -> *). MonadParsec e s m => m s
MP.getInput
Text -> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
MP.setInput Text
r
GHCTargetVersion
x <- Parsec Void Text GHCTargetVersion
ghcTargetVerP
Text -> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => s -> m ()
MP.setInput Text
rest
GHCTargetVersion -> Parsec Void Text GHCTargetVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure GHCTargetVersion
x
)
Parsec Void Text GHCTargetVersion
-> Parsec Void Text FilePath -> Parsec Void Text GHCTargetVersion
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text Char -> Parsec Void Text FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some Parsec Void Text Char
pathSep
Parsec Void Text GHCTargetVersion
-> Parsec Void Text Text -> Parsec Void Text GHCTargetVersion
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parsec Void Text Text
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
MP.takeRest
Parsec Void Text GHCTargetVersion
-> ParsecT Void Text Identity ()
-> Parsec Void Text GHCTargetVersion
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
MP.eof
ghcSubPath :: Parsec Void Text FilePath
ghcSubPath = Parsec Void Text Char -> Parsec Void Text FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some Parsec Void Text Char
pathSep Parsec Void Text FilePath
-> Parsec Void Text Text -> Parsec Void Text FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"ghc" Parsec Void Text FilePath
-> Parsec Void Text FilePath -> Parsec Void Text FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Char -> Parsec Void Text FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some Parsec Void Text Char
pathSep
getInstalledGHCs :: (MonadReader env m, HasDirs env, MonadIO m) => m [Either FilePath GHCTargetVersion]
getInstalledGHCs :: m [Either FilePath GHCTargetVersion]
getInstalledGHCs = do
FilePath
ghcdir <- m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
m FilePath
ghcupGHCBaseDir
[FilePath]
fs <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ [IOErrorType] -> [FilePath] -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
NoSuchThing] [] (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory FilePath
ghcdir
[FilePath]
-> (FilePath -> m (Either FilePath GHCTargetVersion))
-> m [Either FilePath GHCTargetVersion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
fs ((FilePath -> m (Either FilePath GHCTargetVersion))
-> m [Either FilePath GHCTargetVersion])
-> (FilePath -> m (Either FilePath GHCTargetVersion))
-> m [Either FilePath GHCTargetVersion]
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> case FilePath -> Either SomeException GHCTargetVersion
forall (m :: * -> *).
MonadThrow m =>
FilePath -> m GHCTargetVersion
parseGHCupGHCDir FilePath
f of
Right GHCTargetVersion
r -> Either FilePath GHCTargetVersion
-> m (Either FilePath GHCTargetVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath GHCTargetVersion
-> m (Either FilePath GHCTargetVersion))
-> Either FilePath GHCTargetVersion
-> m (Either FilePath GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Either FilePath GHCTargetVersion
forall a b. b -> Either a b
Right GHCTargetVersion
r
Left SomeException
_ -> Either FilePath GHCTargetVersion
-> m (Either FilePath GHCTargetVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath GHCTargetVersion
-> m (Either FilePath GHCTargetVersion))
-> Either FilePath GHCTargetVersion
-> m (Either FilePath GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath GHCTargetVersion
forall a b. a -> Either a b
Left FilePath
f
getInstalledCabals :: ( MonadReader env m
, HasDirs env
, MonadIO m
, MonadCatch m
)
=> m [Either FilePath Version]
getInstalledCabals :: m [Either FilePath Version]
getInstalledCabals = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
[FilePath]
bins <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
FilePath
binDir
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended ExecOption
execBlank ([s|^cabal-.*$|] :: ByteString))
[Either FilePath Version]
vs <- [FilePath]
-> (FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
bins ((FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version])
-> (FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version]
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> case Text -> Either (ParseErrorBundle Text Void) Version
version (Text -> Either (ParseErrorBundle Text Void) Version)
-> (FilePath -> Text)
-> FilePath
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Either (ParseErrorBundle Text Void) Version)
-> Maybe FilePath
-> Maybe (Either (ParseErrorBundle Text Void) Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix FilePath
exeExt (FilePath -> Maybe FilePath) -> Maybe FilePath -> Maybe FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
"cabal-" FilePath
f) of
Just (Right Version
r) -> Either FilePath Version -> m (Either FilePath Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Version -> m (Either FilePath Version))
-> Either FilePath Version -> m (Either FilePath Version)
forall a b. (a -> b) -> a -> b
$ Version -> Either FilePath Version
forall a b. b -> Either a b
Right Version
r
Just (Left ParseErrorBundle Text Void
_) -> Either FilePath Version -> m (Either FilePath Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Version -> m (Either FilePath Version))
-> Either FilePath Version -> m (Either FilePath Version)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Version
forall a b. a -> Either a b
Left FilePath
f
Maybe (Either (ParseErrorBundle Text Void) Version)
Nothing -> Either FilePath Version -> m (Either FilePath Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Version -> m (Either FilePath Version))
-> Either FilePath Version -> m (Either FilePath Version)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Version
forall a b. a -> Either a b
Left FilePath
f
[Either FilePath Version] -> m [Either FilePath Version]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either FilePath Version] -> m [Either FilePath Version])
-> [Either FilePath Version] -> m [Either FilePath Version]
forall a b. (a -> b) -> a -> b
$ [Either FilePath Version] -> [Either FilePath Version]
forall a. Eq a => [a] -> [a]
nub [Either FilePath Version]
vs
cabalInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
cabalInstalled :: Version -> m Bool
cabalInstalled Version
ver = do
[Version]
vers <- ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledCabals
Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
ver [Version]
vers
cabalSet :: (HasLog env, MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
cabalSet :: m (Maybe Version)
cabalSet = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let cabalbin :: FilePath
cabalbin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"cabal" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
IOErrorType
-> (IOException -> m (Maybe Version))
-> m (Maybe Version)
-> m (Maybe Version)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
NoSuchThing (\IOException
_ -> Maybe Version -> m (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing) (m (Maybe Version) -> m (Maybe Version))
-> m (Maybe Version) -> m (Maybe Version)
forall a b. (a -> b) -> a -> b
$ do
Bool
broken <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
isBrokenSymlink FilePath
cabalbin
if Bool
broken
then Maybe Version -> m (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing
else do
Either SomeException FilePath
link <- IO (Either SomeException FilePath)
-> m (Either SomeException FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO (Either SomeException FilePath)
-> m (Either SomeException FilePath))
-> IO (Either SomeException FilePath)
-> m (Either SomeException FilePath)
forall a b. (a -> b) -> a -> b
$ IOErrorType
-> (IOException -> IO (Either SomeException FilePath))
-> IO (Either SomeException FilePath)
-> IO (Either SomeException FilePath)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
InvalidArgument
(\IOException
e -> Either SomeException FilePath -> IO (Either SomeException FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException FilePath
-> IO (Either SomeException FilePath))
-> Either SomeException FilePath
-> IO (Either SomeException FilePath)
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException FilePath
forall a b. a -> Either a b
Left (IOException -> SomeException
forall e. Exception e => e -> SomeException
toException IOException
e))
(IO (Either SomeException FilePath)
-> IO (Either SomeException FilePath))
-> IO (Either SomeException FilePath)
-> IO (Either SomeException FilePath)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Either SomeException FilePath)
-> IO FilePath -> IO (Either SomeException FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Either SomeException FilePath
forall a b. b -> Either a b
Right (IO FilePath -> IO (Either SomeException FilePath))
-> IO FilePath -> IO (Either SomeException FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
getLinkTarget FilePath
cabalbin
case FilePath -> Either SomeException Version
forall (m :: * -> *). MonadThrow m => FilePath -> m Version
linkVersion (FilePath -> Either SomeException Version)
-> Either SomeException FilePath -> Either SomeException Version
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either SomeException FilePath
link of
Right Version
v -> Maybe Version -> m (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Version -> m (Maybe Version))
-> Maybe Version -> m (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v
Left SomeException
err -> do
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to parse cabal symlink target with: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (SomeException -> FilePath
forall e. Exception e => e -> FilePath
displayException SomeException
err)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". The symlink "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
cabalbin
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" needs to point to valid cabal binary, such as 'cabal-3.4.0.0'."
Maybe Version -> m (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing
where
linkVersion :: MonadThrow m => FilePath -> m Version
linkVersion :: FilePath -> m Version
linkVersion = Either (ParseErrorBundle Text Void) Version -> m Version
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either (ParseErrorBundle Text Void) Version -> m Version)
-> (FilePath -> Either (ParseErrorBundle Text Void) Version)
-> FilePath
-> m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Version
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) Version
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Version
parser FilePath
"linkVersion" (Text -> Either (ParseErrorBundle Text Void) Version)
-> (FilePath -> Text)
-> FilePath
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix FilePath
exeExt
parser :: Parsec Void Text Version
parser
= Parsec Void Text Version -> Parsec Void Text Version
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void Text Identity [FilePath]
stripAbsolutePath ParsecT Void Text Identity [FilePath]
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Version
cabalParse)
Parsec Void Text Version
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Version -> Parsec Void Text Version
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void Text Identity [FilePath]
stripRelativePath ParsecT Void Text Identity [FilePath]
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Version
cabalParse)
Parsec Void Text Version
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Version
cabalParse
cabalParse :: Parsec Void Text Version
cabalParse = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"cabal-" Parsec Void Text Text
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Version
version'
stripPathComponet :: Parsec Void Text FilePath
stripPathComponet = Parsec Void Text Char -> Parsec Void Text Text
forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 Parsec Void Text Char
pathSep Parsec Void Text Text
-> Parsec Void Text FilePath -> Parsec Void Text FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Char -> Parsec Void Text FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some Parsec Void Text Char
pathSep
stripAbsolutePath :: ParsecT Void Text Identity [FilePath]
stripAbsolutePath = Parsec Void Text Char -> Parsec Void Text FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some Parsec Void Text Char
pathSep Parsec Void Text FilePath
-> ParsecT Void Text Identity [FilePath]
-> ParsecT Void Text Identity [FilePath]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text FilePath -> ParsecT Void Text Identity [FilePath]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text FilePath -> Parsec Void Text FilePath
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text FilePath
stripPathComponet)
stripRelativePath :: ParsecT Void Text Identity [FilePath]
stripRelativePath = Parsec Void Text FilePath -> ParsecT Void Text Identity [FilePath]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text FilePath -> Parsec Void Text FilePath
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text FilePath
stripPathComponet)
getInstalledHLSs :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
=> m [Either FilePath Version]
getInstalledHLSs :: m [Either FilePath Version]
getInstalledHLSs = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
[FilePath]
bins <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
FilePath
binDir
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
ExecOption
execBlank
([s|^haskell-language-server-wrapper-.*$|] :: ByteString)
)
[Either FilePath Version]
legacy <- [FilePath]
-> (FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
bins ((FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version])
-> (FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version]
forall a b. (a -> b) -> a -> b
$ \FilePath
f ->
case
Text -> Either (ParseErrorBundle Text Void) Version
version (Text -> Either (ParseErrorBundle Text Void) Version)
-> (FilePath -> Text)
-> FilePath
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Either (ParseErrorBundle Text Void) Version)
-> Maybe FilePath
-> Maybe (Either (ParseErrorBundle Text Void) Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix FilePath
exeExt (FilePath -> Maybe FilePath) -> Maybe FilePath -> Maybe FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
"haskell-language-server-wrapper-" FilePath
f)
of
Just (Right Version
r) -> Either FilePath Version -> m (Either FilePath Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Version -> m (Either FilePath Version))
-> Either FilePath Version -> m (Either FilePath Version)
forall a b. (a -> b) -> a -> b
$ Version -> Either FilePath Version
forall a b. b -> Either a b
Right Version
r
Just (Left ParseErrorBundle Text Void
_) -> Either FilePath Version -> m (Either FilePath Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Version -> m (Either FilePath Version))
-> Either FilePath Version -> m (Either FilePath Version)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Version
forall a b. a -> Either a b
Left FilePath
f
Maybe (Either (ParseErrorBundle Text Void) Version)
Nothing -> Either FilePath Version -> m (Either FilePath Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Version -> m (Either FilePath Version))
-> Either FilePath Version -> m (Either FilePath Version)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Version
forall a b. a -> Either a b
Left FilePath
f
FilePath
hlsdir <- m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env) =>
m FilePath
ghcupHLSBaseDir
[FilePath]
fs <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ [IOErrorType] -> [FilePath] -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
NoSuchThing] [] (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
listDirectory FilePath
hlsdir
[Either FilePath Version]
new <- [FilePath]
-> (FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
fs ((FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version])
-> (FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version]
forall a b. (a -> b) -> a -> b
$ \FilePath
f -> case FilePath -> Either SomeException Version
forall (m :: * -> *). MonadThrow m => FilePath -> m Version
parseGHCupHLSDir FilePath
f of
Right Version
r -> Either FilePath Version -> m (Either FilePath Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Version -> m (Either FilePath Version))
-> Either FilePath Version -> m (Either FilePath Version)
forall a b. (a -> b) -> a -> b
$ Version -> Either FilePath Version
forall a b. b -> Either a b
Right Version
r
Left SomeException
_ -> Either FilePath Version -> m (Either FilePath Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Version -> m (Either FilePath Version))
-> Either FilePath Version -> m (Either FilePath Version)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Version
forall a b. a -> Either a b
Left FilePath
f
[Either FilePath Version] -> m [Either FilePath Version]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either FilePath Version] -> [Either FilePath Version]
forall a. Eq a => [a] -> [a]
nub ([Either FilePath Version]
new [Either FilePath Version]
-> [Either FilePath Version] -> [Either FilePath Version]
forall a. Semigroup a => a -> a -> a
<> [Either FilePath Version]
legacy))
getInstalledStacks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m)
=> m [Either FilePath Version]
getInstalledStacks :: m [Either FilePath Version]
getInstalledStacks = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
[FilePath]
bins <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
FilePath
binDir
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
ExecOption
execBlank
([s|^stack-.*$|] :: ByteString)
)
[FilePath]
-> (FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
bins ((FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version])
-> (FilePath -> m (Either FilePath Version))
-> m [Either FilePath Version]
forall a b. (a -> b) -> a -> b
$ \FilePath
f ->
case Text -> Either (ParseErrorBundle Text Void) Version
version (Text -> Either (ParseErrorBundle Text Void) Version)
-> (FilePath -> Text)
-> FilePath
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Either (ParseErrorBundle Text Void) Version)
-> Maybe FilePath
-> Maybe (Either (ParseErrorBundle Text Void) Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix FilePath
exeExt (FilePath -> Maybe FilePath) -> Maybe FilePath -> Maybe FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
"stack-" FilePath
f) of
Just (Right Version
r) -> Either FilePath Version -> m (Either FilePath Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Version -> m (Either FilePath Version))
-> Either FilePath Version -> m (Either FilePath Version)
forall a b. (a -> b) -> a -> b
$ Version -> Either FilePath Version
forall a b. b -> Either a b
Right Version
r
Just (Left ParseErrorBundle Text Void
_) -> Either FilePath Version -> m (Either FilePath Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Version -> m (Either FilePath Version))
-> Either FilePath Version -> m (Either FilePath Version)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Version
forall a b. a -> Either a b
Left FilePath
f
Maybe (Either (ParseErrorBundle Text Void) Version)
Nothing -> Either FilePath Version -> m (Either FilePath Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either FilePath Version -> m (Either FilePath Version))
-> Either FilePath Version -> m (Either FilePath Version)
forall a b. (a -> b) -> a -> b
$ FilePath -> Either FilePath Version
forall a b. a -> Either a b
Left FilePath
f
stackSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m, HasLog env) => m (Maybe Version)
stackSet :: m (Maybe Version)
stackSet = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let stackBin :: FilePath
stackBin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"stack" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
IOErrorType
-> (IOException -> m (Maybe Version))
-> m (Maybe Version)
-> m (Maybe Version)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
NoSuchThing (\IOException
_ -> Maybe Version -> m (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing) (m (Maybe Version) -> m (Maybe Version))
-> m (Maybe Version) -> m (Maybe Version)
forall a b. (a -> b) -> a -> b
$ do
Bool
broken <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
isBrokenSymlink FilePath
stackBin
if Bool
broken
then Maybe Version -> m (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing
else do
Either SomeException FilePath
link <- IO (Either SomeException FilePath)
-> m (Either SomeException FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO (Either SomeException FilePath)
-> m (Either SomeException FilePath))
-> IO (Either SomeException FilePath)
-> m (Either SomeException FilePath)
forall a b. (a -> b) -> a -> b
$ IOErrorType
-> (IOException -> IO (Either SomeException FilePath))
-> IO (Either SomeException FilePath)
-> IO (Either SomeException FilePath)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
InvalidArgument
(\IOException
e -> Either SomeException FilePath -> IO (Either SomeException FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SomeException FilePath
-> IO (Either SomeException FilePath))
-> Either SomeException FilePath
-> IO (Either SomeException FilePath)
forall a b. (a -> b) -> a -> b
$ SomeException -> Either SomeException FilePath
forall a b. a -> Either a b
Left (IOException -> SomeException
forall e. Exception e => e -> SomeException
toException IOException
e))
(IO (Either SomeException FilePath)
-> IO (Either SomeException FilePath))
-> IO (Either SomeException FilePath)
-> IO (Either SomeException FilePath)
forall a b. (a -> b) -> a -> b
$ (FilePath -> Either SomeException FilePath)
-> IO FilePath -> IO (Either SomeException FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Either SomeException FilePath
forall a b. b -> Either a b
Right (IO FilePath -> IO (Either SomeException FilePath))
-> IO FilePath -> IO (Either SomeException FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
getLinkTarget FilePath
stackBin
case FilePath -> Either SomeException Version
forall (m :: * -> *). MonadThrow m => FilePath -> m Version
linkVersion (FilePath -> Either SomeException Version)
-> Either SomeException FilePath -> Either SomeException Version
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either SomeException FilePath
link of
Right Version
v -> Maybe Version -> m (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Version -> m (Maybe Version))
-> Maybe Version -> m (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just Version
v
Left SomeException
err -> do
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to parse stack symlink target with: "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (SomeException -> FilePath
forall e. Exception e => e -> FilePath
displayException SomeException
err)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". The symlink "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
stackBin
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" needs to point to valid stack binary, such as 'stack-2.7.1'."
Maybe Version -> m (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing
where
linkVersion :: MonadThrow m => FilePath -> m Version
linkVersion :: FilePath -> m Version
linkVersion = Either (ParseErrorBundle Text Void) Version -> m Version
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either (ParseErrorBundle Text Void) Version -> m Version)
-> (FilePath -> Either (ParseErrorBundle Text Void) Version)
-> FilePath
-> m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Version
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) Version
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Version
parser FilePath
"" (Text -> Either (ParseErrorBundle Text Void) Version)
-> (FilePath -> Text)
-> FilePath
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix FilePath
exeExt
where
parser :: Parsec Void Text Version
parser
= Parsec Void Text Version -> Parsec Void Text Version
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void Text Identity [FilePath]
stripAbsolutePath ParsecT Void Text Identity [FilePath]
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Version
cabalParse)
Parsec Void Text Version
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Version -> Parsec Void Text Version
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void Text Identity [FilePath]
stripRelativePath ParsecT Void Text Identity [FilePath]
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Version
cabalParse)
Parsec Void Text Version
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Version
cabalParse
cabalParse :: Parsec Void Text Version
cabalParse = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"stack-" Parsec Void Text Text
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Version
version'
stripPathComponet :: Parsec Void Text FilePath
stripPathComponet = Parsec Void Text Char -> Parsec Void Text Text
forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 Parsec Void Text Char
pathSep Parsec Void Text Text
-> Parsec Void Text FilePath -> Parsec Void Text FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Char -> Parsec Void Text FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some Parsec Void Text Char
pathSep
stripAbsolutePath :: ParsecT Void Text Identity [FilePath]
stripAbsolutePath = Parsec Void Text Char -> Parsec Void Text FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some Parsec Void Text Char
pathSep Parsec Void Text FilePath
-> ParsecT Void Text Identity [FilePath]
-> ParsecT Void Text Identity [FilePath]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text FilePath -> ParsecT Void Text Identity [FilePath]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text FilePath -> Parsec Void Text FilePath
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text FilePath
stripPathComponet)
stripRelativePath :: ParsecT Void Text Identity [FilePath]
stripRelativePath = Parsec Void Text FilePath -> ParsecT Void Text Identity [FilePath]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text FilePath -> Parsec Void Text FilePath
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text FilePath
stripPathComponet)
stackInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
stackInstalled :: Version -> m Bool
stackInstalled Version
ver = do
[Version]
vers <- ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledStacks
Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
ver [Version]
vers
hlsInstalled :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
hlsInstalled :: Version -> m Bool
hlsInstalled Version
ver = do
[Version]
vers <- ([Either FilePath Version] -> [Version])
-> m [Either FilePath Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either FilePath Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either FilePath Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) =>
m [Either FilePath Version]
getInstalledHLSs
Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Version -> [Version] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Version
ver [Version]
vers
isLegacyHLS :: (MonadIO m, MonadReader env m, HasDirs env, MonadCatch m) => Version -> m Bool
isLegacyHLS :: Version -> m Bool
isLegacyHLS Version
ver = do
FilePath
bdir <- Version -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m FilePath
ghcupHLSDir Version
ver
Bool -> Bool
not (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO Bool
doesDirectoryExist FilePath
bdir)
hlsSet :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
hlsSet :: m (Maybe Version)
hlsSet = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let hlsBin :: FilePath
hlsBin = FilePath
binDir FilePath -> FilePath -> FilePath
</> FilePath
"haskell-language-server-wrapper" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
exeExt
IO (Maybe Version) -> m (Maybe Version)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Version) -> m (Maybe Version))
-> IO (Maybe Version) -> m (Maybe Version)
forall a b. (a -> b) -> a -> b
$ IOErrorType
-> (IOException -> IO (Maybe Version))
-> IO (Maybe Version)
-> IO (Maybe Version)
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
IOErrorType -> (IOException -> m a) -> m a -> m a
handleIO' IOErrorType
NoSuchThing (\IOException
_ -> Maybe Version -> IO (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing) (IO (Maybe Version) -> IO (Maybe Version))
-> IO (Maybe Version) -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ do
Bool
broken <- FilePath -> IO Bool
isBrokenSymlink FilePath
hlsBin
if Bool
broken
then Maybe Version -> IO (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing
else do
FilePath
link <- IO FilePath -> IO FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
getLinkTarget FilePath
hlsBin
Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> IO Version -> IO (Maybe Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Version
forall (m :: * -> *). MonadThrow m => FilePath -> m Version
linkVersion FilePath
link
where
linkVersion :: MonadThrow m => FilePath -> m Version
linkVersion :: FilePath -> m Version
linkVersion = Either (ParseErrorBundle Text Void) Version -> m Version
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either (ParseErrorBundle Text Void) Version -> m Version)
-> (FilePath -> Either (ParseErrorBundle Text Void) Version)
-> FilePath
-> m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Version
-> FilePath -> Text -> Either (ParseErrorBundle Text Void) Version
forall e s a.
Parsec e s a -> FilePath -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Version
parser FilePath
"" (Text -> Either (ParseErrorBundle Text Void) Version)
-> (FilePath -> Text)
-> FilePath
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack (FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix FilePath
exeExt
where
parser :: Parsec Void Text Version
parser
= Parsec Void Text Version -> Parsec Void Text Version
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void Text Identity [FilePath]
stripAbsolutePath ParsecT Void Text Identity [FilePath]
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Version
cabalParse)
Parsec Void Text Version
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Version -> Parsec Void Text Version
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try (ParsecT Void Text Identity [FilePath]
stripRelativePath ParsecT Void Text Identity [FilePath]
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Version
cabalParse)
Parsec Void Text Version
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parsec Void Text Version
cabalParse
cabalParse :: Parsec Void Text Version
cabalParse = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
MP.chunk Tokens Text
"haskell-language-server-wrapper-" Parsec Void Text Text
-> Parsec Void Text Version -> Parsec Void Text Version
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Version
version'
stripPathComponet :: Parsec Void Text FilePath
stripPathComponet = Parsec Void Text Char -> Parsec Void Text Text
forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 Parsec Void Text Char
pathSep Parsec Void Text Text
-> Parsec Void Text FilePath -> Parsec Void Text FilePath
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Char -> Parsec Void Text FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some Parsec Void Text Char
pathSep
stripAbsolutePath :: ParsecT Void Text Identity [FilePath]
stripAbsolutePath = Parsec Void Text Char -> Parsec Void Text FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.some Parsec Void Text Char
pathSep Parsec Void Text FilePath
-> ParsecT Void Text Identity [FilePath]
-> ParsecT Void Text Identity [FilePath]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text FilePath -> ParsecT Void Text Identity [FilePath]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text FilePath -> Parsec Void Text FilePath
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text FilePath
stripPathComponet)
stripRelativePath :: ParsecT Void Text Identity [FilePath]
stripRelativePath = Parsec Void Text FilePath -> ParsecT Void Text Identity [FilePath]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text FilePath -> Parsec Void Text FilePath
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text FilePath
stripPathComponet)
hlsGHCVersions :: ( MonadReader env m
, HasDirs env
, MonadIO m
, MonadThrow m
, MonadCatch m
)
=> m [Version]
hlsGHCVersions :: m [Version]
hlsGHCVersions = do
Maybe Version
h <- m (Maybe Version)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
MonadCatch m) =>
m (Maybe Version)
hlsSet
[Version] -> Maybe [Version] -> [Version]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Version] -> [Version])
-> m (Maybe [Version]) -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Version -> (Version -> m [Version]) -> m (Maybe [Version])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Version
h Version -> m [Version]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadThrow m,
MonadCatch m) =>
Version -> m [Version]
hlsGHCVersions'
hlsGHCVersions' :: ( MonadReader env m
, HasDirs env
, MonadIO m
, MonadThrow m
, MonadCatch m
)
=> Version
-> m [Version]
hlsGHCVersions' :: Version -> m [Version]
hlsGHCVersions' Version
v' = do
[FilePath]
bins <- Version -> Maybe Version -> m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Version -> Maybe Version -> m [FilePath]
hlsServerBinaries Version
v' Maybe Version
forall a. Maybe a
Nothing
let vers :: [Either (ParseErrorBundle Text Void) Version]
vers = (FilePath -> Either (ParseErrorBundle Text Void) Version)
-> [FilePath] -> [Either (ParseErrorBundle Text Void) Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
(Text -> Either (ParseErrorBundle Text Void) Version
version
(Text -> Either (ParseErrorBundle Text Void) Version)
-> (FilePath -> Text)
-> FilePath
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack
(FilePath -> Text) -> (FilePath -> FilePath) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe FilePath -> FilePath
forall a. HasCallStack => Maybe a -> a
fromJust
(Maybe FilePath -> FilePath)
-> (FilePath -> Maybe FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix FilePath
"haskell-language-server-"
(FilePath -> Maybe FilePath)
-> (FilePath -> FilePath) -> FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
forall a. [a] -> a
head
([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> [FilePath]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn FilePath
"~"
)
[FilePath]
bins
[Version] -> m [Version]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Version] -> m [Version])
-> ([Either (ParseErrorBundle Text Void) Version] -> [Version])
-> [Either (ParseErrorBundle Text Void) Version]
-> m [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version -> Version -> Ordering) -> [Version] -> [Version]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Version -> Version -> Ordering) -> Version -> Version -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) ([Version] -> [Version])
-> ([Either (ParseErrorBundle Text Void) Version] -> [Version])
-> [Either (ParseErrorBundle Text Void) Version]
-> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either (ParseErrorBundle Text Void) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights ([Either (ParseErrorBundle Text Void) Version] -> m [Version])
-> [Either (ParseErrorBundle Text Void) Version] -> m [Version]
forall a b. (a -> b) -> a -> b
$ [Either (ParseErrorBundle Text Void) Version]
vers
hlsServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m)
=> Version
-> Maybe Version
-> m [FilePath]
hlsServerBinaries :: Version -> Maybe Version -> m [FilePath]
hlsServerBinaries Version
ver Maybe Version
mghcVer = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
FilePath
binDir
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts
CompOption
compExtended
ExecOption
execBlank
([s|^haskell-language-server-|]
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
-> (Version -> ByteString) -> Maybe Version -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [s|.*|] Version -> ByteString
escapeVerRex Maybe Version
mghcVer
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [s|~|]
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
escapeVerRex Version
ver
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
E.encodeUtf8 (FilePath -> Text
T.pack FilePath
exeExt)
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [s|$|] :: ByteString
)
)
hlsInternalServerScripts :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
=> Version
-> Maybe Version
-> m [FilePath]
hlsInternalServerScripts :: Version -> Maybe Version -> m [FilePath]
hlsInternalServerScripts Version
ver Maybe Version
mghcVer = do
FilePath
dir <- Version -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m FilePath
ghcupHLSDir Version
ver
let bdir :: FilePath
bdir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"bin"
(FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
bdir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
f -> Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\Version
gv -> (FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
gv)) FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
f) Maybe Version
mghcVer)
([FilePath] -> [FilePath]) -> m [FilePath] -> m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
listDirectory FilePath
bdir)
hlsInternalServerBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadFail m)
=> Version
-> Maybe Version
-> m [FilePath]
hlsInternalServerBinaries :: Version -> Maybe Version -> m [FilePath]
hlsInternalServerBinaries Version
ver Maybe Version
mghcVer = do
FilePath
dir <- Version -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m FilePath
ghcupHLSDir Version
ver
let regex :: Regex
regex = CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended ExecOption
execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
(Just FilePath
bdir) <- ([FilePath] -> Maybe FilePath)
-> m [FilePath] -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
headMay (m [FilePath] -> m (Maybe FilePath))
-> m [FilePath] -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ [Either FilePath Regex] -> IO [FilePath]
expandFilePath [FilePath -> Either FilePath Regex
forall a b. a -> Either a b
Left (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"lib"), Regex -> Either FilePath Regex
forall a b. b -> Either a b
Right Regex
regex, FilePath -> Either FilePath Regex
forall a b. a -> Either a b
Left FilePath
"bin"]
(FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
bdir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (\FilePath
f -> Bool -> (Version -> Bool) -> Maybe Version -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (\Version
gv -> (FilePath
"-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
gv)) FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
f) Maybe Version
mghcVer)
([FilePath] -> [FilePath]) -> m [FilePath] -> m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
listDirectory FilePath
bdir)
hlsInternalServerLibs :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m, MonadFail m)
=> Version
-> Version
-> m [FilePath]
hlsInternalServerLibs :: Version -> Version -> m [FilePath]
hlsInternalServerLibs Version
ver Version
ghcVer = do
FilePath
dir <- Version -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
Version -> m FilePath
ghcupHLSDir Version
ver
let regex :: Regex
regex = CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended ExecOption
execBlank ([s|^haskell-language-server-.*$|] :: ByteString)
(Just FilePath
bdir) <- ([FilePath] -> Maybe FilePath)
-> m [FilePath] -> m (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
headMay (m [FilePath] -> m (Maybe FilePath))
-> m [FilePath] -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ [Either FilePath Regex] -> IO [FilePath]
expandFilePath [FilePath -> Either FilePath Regex
forall a b. a -> Either a b
Left (FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"lib"), Regex -> Either FilePath Regex
forall a b. b -> Either a b
Right Regex
regex, FilePath -> Either FilePath Regex
forall a b. a -> Either a b
Left (FilePath
"lib" FilePath -> FilePath -> FilePath
</> Text -> FilePath
T.unpack (Version -> Text
prettyVer Version
ghcVer))]
(FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath
bdir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath]) -> m [FilePath] -> m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
listDirectory FilePath
bdir)
hlsWrapperBinary :: (MonadReader env m, HasDirs env, MonadThrow m, MonadIO m)
=> Version
-> m (Maybe FilePath)
hlsWrapperBinary :: Version -> m (Maybe FilePath)
hlsWrapperBinary Version
ver = do
Dirs {FilePath
recycleDir :: FilePath
confDir :: FilePath
logsDir :: FilePath
cacheDir :: FilePath
binDir :: FilePath
baseDir :: FilePath
$sel:recycleDir:Dirs :: Dirs -> FilePath
$sel:confDir:Dirs :: Dirs -> FilePath
$sel:logsDir:Dirs :: Dirs -> FilePath
$sel:cacheDir:Dirs :: Dirs -> FilePath
$sel:binDir:Dirs :: Dirs -> FilePath
$sel:baseDir:Dirs :: Dirs -> FilePath
..} <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
[FilePath]
wrapper <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> m [FilePath]) -> IO [FilePath] -> m [FilePath]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> Regex -> IO [FilePath]
findFiles
FilePath
binDir
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts
CompOption
compExtended
ExecOption
execBlank
([s|^haskell-language-server-wrapper-|] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
escapeVerRex Version
ver ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
E.encodeUtf8 (FilePath -> Text
T.pack FilePath
exeExt) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [s|$|] :: ByteString
)
)
case [FilePath]
wrapper of
[] -> Maybe FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
[FilePath
x] -> Maybe FilePath -> m (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> m (Maybe FilePath))
-> Maybe FilePath -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
x
[FilePath]
_ -> UnexpectedListLength -> m (Maybe FilePath)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnexpectedListLength -> m (Maybe FilePath))
-> UnexpectedListLength -> m (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> UnexpectedListLength
UnexpectedListLength
FilePath
"There were multiple hls wrapper binaries for a single version"
hlsAllBinaries :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m) => Version -> m [FilePath]
hlsAllBinaries :: Version -> m [FilePath]
hlsAllBinaries Version
ver = do
[FilePath]
hls <- Version -> Maybe Version -> m [FilePath]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
Version -> Maybe Version -> m [FilePath]
hlsServerBinaries Version
ver Maybe Version
forall a. Maybe a
Nothing
Maybe FilePath
wrapper <- Version -> m (Maybe FilePath)
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadIO m) =>
Version -> m (Maybe FilePath)
hlsWrapperBinary Version
ver
[FilePath] -> m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe FilePath -> [FilePath]
forall a. Maybe a -> [a]
maybeToList Maybe FilePath
wrapper [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [FilePath]
hls)
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
getMajorMinorV :: Version -> m (Int, Int)
getMajorMinorV Version {[VChunk]
Maybe Word
Maybe Text
NonEmpty VChunk
_vEpoch :: Version -> Maybe Word
_vChunks :: Version -> NonEmpty VChunk
_vRel :: Version -> [VChunk]
_vMeta :: Version -> Maybe Text
_vMeta :: Maybe Text
_vRel :: [VChunk]
_vChunks :: NonEmpty VChunk
_vEpoch :: Maybe Word
..} = case NonEmpty VChunk
_vChunks of
((Digits Word
x :| []) :| ((Digits Word
y :| []):[VChunk]
_)) -> (Int, Int) -> m (Int, Int)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
x, Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
y)
NonEmpty VChunk
_ -> ParseError -> m (Int, Int)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m (Int, Int)) -> ParseError -> m (Int, Int)
forall a b. (a -> b) -> a -> b
$ FilePath -> ParseError
ParseError FilePath
"Could not parse X.Y from version"
matchMajor :: Version -> Int -> Int -> Bool
matchMajor :: Version -> Int -> Int -> Bool
matchMajor Version
v' Int
major' Int
minor' = case Version -> Maybe (Int, Int)
forall (m :: * -> *). MonadThrow m => Version -> m (Int, Int)
getMajorMinorV Version
v' of
Just (Int
x, Int
y) -> Int
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
major' Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
minor'
Maybe (Int, Int)
Nothing -> Bool
False
matchPVPrefix :: PVP -> PVP -> Bool
matchPVPrefix :: PVP -> PVP -> Bool
matchPVPrefix (PVP -> [Int]
toL -> [Int]
prefix) (PVP -> [Int]
toL -> [Int]
full) = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool) -> [Int] -> [Int] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) [Int]
prefix [Int]
full
toL :: PVP -> [Int]
toL :: PVP -> [Int]
toL (PVP NonEmpty Word
inner) = (Word -> Int) -> [Word] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Word] -> [Int]) -> [Word] -> [Int]
forall a b. (a -> b) -> a -> b
$ NonEmpty Word -> [Word]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Word
inner
getGHCForPVP :: (MonadReader env m, HasDirs env, MonadIO m, MonadThrow m)
=> PVP
-> Maybe Text
-> m (Maybe GHCTargetVersion)
getGHCForPVP :: PVP -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForPVP PVP
pvpIn Maybe Text
mt = do
[GHCTargetVersion]
ghcs <- [Either FilePath GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights ([Either FilePath GHCTargetVersion] -> [GHCTargetVersion])
-> m [Either FilePath GHCTargetVersion] -> m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Either FilePath GHCTargetVersion]
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m) =>
m [Either FilePath GHCTargetVersion]
getInstalledGHCs
let ghcs' :: [(PVP, Text, Maybe Text)]
ghcs' = [Maybe (PVP, Text, Maybe Text)] -> [(PVP, Text, Maybe Text)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PVP, Text, Maybe Text)] -> [(PVP, Text, Maybe Text)])
-> [Maybe (PVP, Text, Maybe Text)] -> [(PVP, Text, Maybe Text)]
forall a b. (a -> b) -> a -> b
$ ((GHCTargetVersion -> Maybe (PVP, Text, Maybe Text))
-> [GHCTargetVersion] -> [Maybe (PVP, Text, Maybe Text)])
-> [GHCTargetVersion]
-> (GHCTargetVersion -> Maybe (PVP, Text, Maybe Text))
-> [Maybe (PVP, Text, Maybe Text)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (GHCTargetVersion -> Maybe (PVP, Text, Maybe Text))
-> [GHCTargetVersion] -> [Maybe (PVP, Text, Maybe Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GHCTargetVersion]
ghcs ((GHCTargetVersion -> Maybe (PVP, Text, Maybe Text))
-> [Maybe (PVP, Text, Maybe Text)])
-> (GHCTargetVersion -> Maybe (PVP, Text, Maybe Text))
-> [Maybe (PVP, Text, Maybe Text)]
forall a b. (a -> b) -> a -> b
$ \GHCTargetVersion{Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
$sel:_tvVersion:GHCTargetVersion :: GHCTargetVersion -> Version
$sel:_tvTarget:GHCTargetVersion :: GHCTargetVersion -> Maybe Text
..} -> do
(PVP
pvp_, Text
rest) <- Version -> Maybe (PVP, Text)
forall (m :: * -> *). MonadThrow m => Version -> m (PVP, Text)
versionToPVP Version
_tvVersion
(PVP, Text, Maybe Text) -> Maybe (PVP, Text, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PVP
pvp_, Text
rest, Maybe Text
_tvTarget)
PVP
-> [(PVP, Text, Maybe Text)]
-> Maybe Text
-> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
MonadThrow m =>
PVP
-> [(PVP, Text, Maybe Text)]
-> Maybe Text
-> m (Maybe GHCTargetVersion)
getGHCForPVP' PVP
pvpIn [(PVP, Text, Maybe Text)]
ghcs' Maybe Text
mt
getGHCForPVP' :: MonadThrow m
=> PVP
-> [(PVP, Text, Maybe Text)]
-> Maybe Text
-> m (Maybe GHCTargetVersion)
getGHCForPVP' :: PVP
-> [(PVP, Text, Maybe Text)]
-> Maybe Text
-> m (Maybe GHCTargetVersion)
getGHCForPVP' PVP
pvpIn [(PVP, Text, Maybe Text)]
ghcs' Maybe Text
mt = do
let mResult :: Maybe (PVP, Text, Maybe Text)
mResult = [(PVP, Text, Maybe Text)] -> Maybe (PVP, Text, Maybe Text)
forall a. [a] -> Maybe a
lastMay
([(PVP, Text, Maybe Text)] -> Maybe (PVP, Text, Maybe Text))
-> ([(PVP, Text, Maybe Text)] -> [(PVP, Text, Maybe Text)])
-> [(PVP, Text, Maybe Text)]
-> Maybe (PVP, Text, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PVP, Text, Maybe Text) -> (PVP, Text, Maybe Text) -> Ordering)
-> [(PVP, Text, Maybe Text)] -> [(PVP, Text, Maybe Text)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(PVP
x, Text
_, Maybe Text
_) (PVP
y, Text
_, Maybe Text
_) -> PVP -> PVP -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PVP
x PVP
y)
([(PVP, Text, Maybe Text)] -> [(PVP, Text, Maybe Text)])
-> ([(PVP, Text, Maybe Text)] -> [(PVP, Text, Maybe Text)])
-> [(PVP, Text, Maybe Text)]
-> [(PVP, Text, Maybe Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PVP, Text, Maybe Text) -> Bool)
-> [(PVP, Text, Maybe Text)] -> [(PVP, Text, Maybe Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\(PVP
pvp_, Text
_, Maybe Text
target) ->
Maybe Text
target Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
mt Bool -> Bool -> Bool
&& PVP -> PVP -> Bool
matchPVPrefix PVP
pvp_ PVP
pvpIn
)
([(PVP, Text, Maybe Text)] -> Maybe (PVP, Text, Maybe Text))
-> [(PVP, Text, Maybe Text)] -> Maybe (PVP, Text, Maybe Text)
forall a b. (a -> b) -> a -> b
$ [(PVP, Text, Maybe Text)]
ghcs'
Maybe (PVP, Text, Maybe Text)
-> ((PVP, Text, Maybe Text) -> m GHCTargetVersion)
-> m (Maybe GHCTargetVersion)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe (PVP, Text, Maybe Text)
mResult (((PVP, Text, Maybe Text) -> m GHCTargetVersion)
-> m (Maybe GHCTargetVersion))
-> ((PVP, Text, Maybe Text) -> m GHCTargetVersion)
-> m (Maybe GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ \(PVP
pvp_, Text
rest, Maybe Text
target) -> do
Version
ver' <- PVP -> Text -> m Version
forall (m :: * -> *). MonadThrow m => PVP -> Text -> m Version
pvpToVersion PVP
pvp_ Text
rest
GHCTargetVersion -> m GHCTargetVersion
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> Version -> GHCTargetVersion
GHCTargetVersion Maybe Text
target Version
ver')
getLatestToolFor :: MonadThrow m
=> Tool
-> PVP
-> GHCupDownloads
-> m (Maybe (PVP, VersionInfo))
getLatestToolFor :: Tool -> PVP -> GHCupDownloads -> m (Maybe (PVP, VersionInfo))
getLatestToolFor Tool
tool PVP
pvpIn GHCupDownloads
dls = do
let ls :: [(Version, VersionInfo)]
ls = [(Version, VersionInfo)]
-> Maybe [(Version, VersionInfo)] -> [(Version, VersionInfo)]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [(Version, VersionInfo)] -> [(Version, VersionInfo)])
-> Maybe [(Version, VersionInfo)] -> [(Version, VersionInfo)]
forall a b. (a -> b) -> a -> b
$ Optic' An_AffineFold '[] GHCupDownloads [(Version, VersionInfo)]
-> GHCupDownloads -> Maybe [(Version, VersionInfo)]
forall k (is :: [*]) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index GHCupDownloads
-> Optic'
(IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
tool Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
[(Version, VersionInfo)]
[(Version, VersionInfo)]
-> Optic' An_AffineFold '[] GHCupDownloads [(Version, VersionInfo)]
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Map Version VersionInfo -> [(Version, VersionInfo)])
-> Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
[(Version, VersionInfo)]
[(Version, VersionInfo)]
forall s a. (s -> a) -> Getter s a
to Map Version VersionInfo -> [(Version, VersionInfo)]
forall k a. Map k a -> [(k, a)]
Map.toDescList) GHCupDownloads
dls
let ps :: [((PVP, Text), VersionInfo)]
ps = [Maybe ((PVP, Text), VersionInfo)] -> [((PVP, Text), VersionInfo)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ((PVP, Text), VersionInfo)]
-> [((PVP, Text), VersionInfo)])
-> [Maybe ((PVP, Text), VersionInfo)]
-> [((PVP, Text), VersionInfo)]
forall a b. (a -> b) -> a -> b
$ ((Version, VersionInfo) -> Maybe ((PVP, Text), VersionInfo))
-> [(Version, VersionInfo)] -> [Maybe ((PVP, Text), VersionInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Version
v, VersionInfo
vi) -> (,VersionInfo
vi) ((PVP, Text) -> ((PVP, Text), VersionInfo))
-> Maybe (PVP, Text) -> Maybe ((PVP, Text), VersionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Maybe (PVP, Text)
forall (m :: * -> *). MonadThrow m => Version -> m (PVP, Text)
versionToPVP Version
v) [(Version, VersionInfo)]
ls
Maybe (PVP, VersionInfo) -> m (Maybe (PVP, VersionInfo))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (PVP, VersionInfo) -> m (Maybe (PVP, VersionInfo)))
-> ([((PVP, Text), VersionInfo)] -> Maybe (PVP, VersionInfo))
-> [((PVP, Text), VersionInfo)]
-> m (Maybe (PVP, VersionInfo))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((PVP, Text), VersionInfo) -> (PVP, VersionInfo))
-> Maybe ((PVP, Text), VersionInfo) -> Maybe (PVP, VersionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((PVP, Text) -> PVP)
-> ((PVP, Text), VersionInfo) -> (PVP, VersionInfo)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (PVP, Text) -> PVP
forall a b. (a, b) -> a
fst) (Maybe ((PVP, Text), VersionInfo) -> Maybe (PVP, VersionInfo))
-> ([((PVP, Text), VersionInfo)]
-> Maybe ((PVP, Text), VersionInfo))
-> [((PVP, Text), VersionInfo)]
-> Maybe (PVP, VersionInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [((PVP, Text), VersionInfo)] -> Maybe ((PVP, Text), VersionInfo)
forall a. [a] -> Maybe a
headMay ([((PVP, Text), VersionInfo)] -> Maybe ((PVP, Text), VersionInfo))
-> ([((PVP, Text), VersionInfo)] -> [((PVP, Text), VersionInfo)])
-> [((PVP, Text), VersionInfo)]
-> Maybe ((PVP, Text), VersionInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (((PVP, Text), VersionInfo) -> Bool)
-> [((PVP, Text), VersionInfo)] -> [((PVP, Text), VersionInfo)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\((PVP
v, Text
_), VersionInfo
_) -> PVP -> PVP -> Bool
matchPVPrefix PVP
pvpIn PVP
v) ([((PVP, Text), VersionInfo)] -> m (Maybe (PVP, VersionInfo)))
-> [((PVP, Text), VersionInfo)] -> m (Maybe (PVP, VersionInfo))
forall a b. (a -> b) -> a -> b
$ [((PVP, Text), VersionInfo)]
ps
unpackToDir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
=> FilePath
-> FilePath
-> Excepts '[UnknownArchive
, ArchiveResult
] m ()
unpackToDir :: FilePath
-> FilePath -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir FilePath
dfp FilePath
av = do
let fn :: FilePath
fn = FilePath -> FilePath
takeFileName FilePath
av
m () -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[UnknownArchive, ArchiveResult] m ())
-> m () -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall a b. (a -> b) -> a -> b
$ 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
$ Text
"Unpacking: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" to " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
dfp
let untar :: MonadIO m => BL.ByteString -> Excepts '[ArchiveResult] m ()
untar :: ByteString -> Excepts '[ArchiveResult] m ()
untar = m (Either ArchiveResult ()) -> Excepts '[ArchiveResult] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Either e a) -> Excepts es m a
lEM (m (Either ArchiveResult ()) -> Excepts '[ArchiveResult] m ())
-> (ByteString -> m (Either ArchiveResult ()))
-> ByteString
-> Excepts '[ArchiveResult] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either ArchiveResult ()) -> m (Either ArchiveResult ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ArchiveResult ()) -> m (Either ArchiveResult ()))
-> (ByteString -> IO (Either ArchiveResult ()))
-> ByteString
-> m (Either ArchiveResult ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArchiveM () -> IO (Either ArchiveResult ())
forall a. ArchiveM a -> IO (Either ArchiveResult a)
runArchiveM (ArchiveM () -> IO (Either ArchiveResult ()))
-> (ByteString -> ArchiveM ())
-> ByteString
-> IO (Either ArchiveResult ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ByteString -> ArchiveM ()
unpackToDirLazy FilePath
dfp
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
rf :: FilePath -> Excepts '[ArchiveResult] m ByteString
rf = IO ByteString -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Excepts '[ArchiveResult] m ByteString)
-> (FilePath -> IO ByteString)
-> FilePath
-> Excepts '[ArchiveResult] m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
BL.readFile
if
| FilePath
".tar.gz" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fn -> Excepts '[ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE
(ByteString -> Excepts '[ArchiveResult] m ()
forall (m :: * -> *).
MonadIO m =>
ByteString -> Excepts '[ArchiveResult] m ()
untar (ByteString -> Excepts '[ArchiveResult] m ())
-> (ByteString -> ByteString)
-> ByteString
-> Excepts '[ArchiveResult] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZip.decompress (ByteString -> Excepts '[ArchiveResult] m ())
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[ArchiveResult] m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[ArchiveResult] m ByteString
rf FilePath
av)
| FilePath
".tar.xz" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fn -> do
ByteString
filecontents <- Excepts '[ArchiveResult] m ByteString
-> Excepts '[UnknownArchive, ArchiveResult] m ByteString
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ArchiveResult] m ByteString
-> Excepts '[UnknownArchive, ArchiveResult] m ByteString)
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[UnknownArchive, ArchiveResult] m ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[ArchiveResult] m ByteString
rf FilePath
av
let decompressed :: ByteString
decompressed = DecompressParams -> ByteString -> ByteString
Lzma.decompressWith (DecompressParams
Lzma.defaultDecompressParams { decompressAutoDecoder :: Bool
Lzma.decompressAutoDecoder= Bool
True }) ByteString
filecontents
Excepts '[ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ())
-> Excepts '[ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Excepts '[ArchiveResult] m ()
forall (m :: * -> *).
MonadIO m =>
ByteString -> Excepts '[ArchiveResult] m ()
untar ByteString
decompressed
| FilePath
".tar.bz2" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fn ->
Excepts '[ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (ByteString -> Excepts '[ArchiveResult] m ()
forall (m :: * -> *).
MonadIO m =>
ByteString -> Excepts '[ArchiveResult] m ()
untar (ByteString -> Excepts '[ArchiveResult] m ())
-> (ByteString -> ByteString)
-> ByteString
-> Excepts '[ArchiveResult] m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BZip.decompress (ByteString -> Excepts '[ArchiveResult] m ())
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[ArchiveResult] m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[ArchiveResult] m ByteString
rf FilePath
av)
| FilePath
".tar" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fn -> Excepts '[ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (ByteString -> Excepts '[ArchiveResult] m ()
forall (m :: * -> *).
MonadIO m =>
ByteString -> Excepts '[ArchiveResult] m ()
untar (ByteString -> Excepts '[ArchiveResult] m ())
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[ArchiveResult] m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[ArchiveResult] m ByteString
rf FilePath
av)
| FilePath
".zip" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fn -> Excepts '[ArchiveResult] m ()
-> Excepts '[UnknownArchive, ArchiveResult] m ()
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (ByteString -> Excepts '[ArchiveResult] m ()
forall (m :: * -> *).
MonadIO m =>
ByteString -> Excepts '[ArchiveResult] m ()
untar (ByteString -> Excepts '[ArchiveResult] m ())
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[ArchiveResult] m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[ArchiveResult] m ByteString
rf FilePath
av)
| Bool
otherwise -> UnknownArchive -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (UnknownArchive -> Excepts '[UnknownArchive, ArchiveResult] m ())
-> UnknownArchive -> Excepts '[UnknownArchive, ArchiveResult] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> UnknownArchive
UnknownArchive FilePath
fn
getArchiveFiles :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m)
=> FilePath
-> Excepts '[UnknownArchive
, ArchiveResult
] m [FilePath]
getArchiveFiles :: FilePath -> Excepts '[UnknownArchive, ArchiveResult] m [FilePath]
getArchiveFiles FilePath
av = do
let fn :: FilePath
fn = FilePath -> FilePath
takeFileName FilePath
av
let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [FilePath]
entries :: ByteString -> Excepts '[ArchiveResult] m [FilePath]
entries = (([Entry FilePath ByteString] -> [FilePath])
-> Excepts '[ArchiveResult] m [Entry FilePath ByteString]
-> Excepts '[ArchiveResult] m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Entry FilePath ByteString] -> [FilePath])
-> Excepts '[ArchiveResult] m [Entry FilePath ByteString]
-> Excepts '[ArchiveResult] m [FilePath])
-> ((Entry FilePath ByteString -> FilePath)
-> [Entry FilePath ByteString] -> [FilePath])
-> (Entry FilePath ByteString -> FilePath)
-> Excepts '[ArchiveResult] m [Entry FilePath ByteString]
-> Excepts '[ArchiveResult] m [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entry FilePath ByteString -> FilePath)
-> [Entry FilePath ByteString] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) Entry FilePath ByteString -> FilePath
forall fp e. Entry fp e -> fp
filepath (Excepts '[ArchiveResult] m [Entry FilePath ByteString]
-> Excepts '[ArchiveResult] m [FilePath])
-> (ByteString
-> Excepts '[ArchiveResult] m [Entry FilePath ByteString])
-> ByteString
-> Excepts '[ArchiveResult] m [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ArchiveResult [Entry FilePath ByteString]
-> Excepts '[ArchiveResult] m [Entry FilePath ByteString]
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either ArchiveResult [Entry FilePath ByteString]
-> Excepts '[ArchiveResult] m [Entry FilePath ByteString])
-> (ByteString -> Either ArchiveResult [Entry FilePath ByteString])
-> ByteString
-> Excepts '[ArchiveResult] m [Entry FilePath ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ArchiveResult [Entry FilePath ByteString]
readArchiveBSL
rf :: MonadIO m => FilePath -> Excepts '[ArchiveResult] m BL.ByteString
rf :: FilePath -> Excepts '[ArchiveResult] m ByteString
rf = IO ByteString -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> Excepts '[ArchiveResult] m ByteString)
-> (FilePath -> IO ByteString)
-> FilePath
-> Excepts '[ArchiveResult] m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
BL.readFile
if
| FilePath
".tar.gz" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fn -> Excepts '[ArchiveResult] m [FilePath]
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE
(ByteString -> Excepts '[ArchiveResult] m [FilePath]
forall (m :: * -> *).
Monad m =>
ByteString -> Excepts '[ArchiveResult] m [FilePath]
entries (ByteString -> Excepts '[ArchiveResult] m [FilePath])
-> (ByteString -> ByteString)
-> ByteString
-> Excepts '[ArchiveResult] m [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZip.decompress (ByteString -> Excepts '[ArchiveResult] m [FilePath])
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[ArchiveResult] m [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[ArchiveResult] m ByteString
rf FilePath
av)
| FilePath
".tar.xz" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fn -> do
ByteString
filecontents <- Excepts '[ArchiveResult] m ByteString
-> Excepts '[UnknownArchive, ArchiveResult] m ByteString
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ArchiveResult] m ByteString
-> Excepts '[UnknownArchive, ArchiveResult] m ByteString)
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[UnknownArchive, ArchiveResult] m ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[ArchiveResult] m ByteString
rf FilePath
av
let decompressed :: ByteString
decompressed = DecompressParams -> ByteString -> ByteString
Lzma.decompressWith (DecompressParams
Lzma.defaultDecompressParams { decompressAutoDecoder :: Bool
Lzma.decompressAutoDecoder= Bool
True }) ByteString
filecontents
Excepts '[ArchiveResult] m [FilePath]
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[ArchiveResult] m [FilePath]
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath])
-> Excepts '[ArchiveResult] m [FilePath]
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath]
forall a b. (a -> b) -> a -> b
$ ByteString -> Excepts '[ArchiveResult] m [FilePath]
forall (m :: * -> *).
Monad m =>
ByteString -> Excepts '[ArchiveResult] m [FilePath]
entries ByteString
decompressed
| FilePath
".tar.bz2" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fn ->
Excepts '[ArchiveResult] m [FilePath]
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (ByteString -> Excepts '[ArchiveResult] m [FilePath]
forall (m :: * -> *).
Monad m =>
ByteString -> Excepts '[ArchiveResult] m [FilePath]
entries (ByteString -> Excepts '[ArchiveResult] m [FilePath])
-> (ByteString -> ByteString)
-> ByteString
-> Excepts '[ArchiveResult] m [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BZip.decompress (ByteString -> Excepts '[ArchiveResult] m [FilePath])
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[ArchiveResult] m [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[ArchiveResult] m ByteString
rf FilePath
av)
| FilePath
".tar" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fn -> Excepts '[ArchiveResult] m [FilePath]
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (ByteString -> Excepts '[ArchiveResult] m [FilePath]
forall (m :: * -> *).
Monad m =>
ByteString -> Excepts '[ArchiveResult] m [FilePath]
entries (ByteString -> Excepts '[ArchiveResult] m [FilePath])
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[ArchiveResult] m [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[ArchiveResult] m ByteString
rf FilePath
av)
| FilePath
".zip" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
fn -> Excepts '[ArchiveResult] m [FilePath]
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (ByteString -> Excepts '[ArchiveResult] m [FilePath]
forall (m :: * -> *).
Monad m =>
ByteString -> Excepts '[ArchiveResult] m [FilePath]
entries (ByteString -> Excepts '[ArchiveResult] m [FilePath])
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[ArchiveResult] m [FilePath]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
FilePath -> Excepts '[ArchiveResult] m ByteString
rf FilePath
av)
| Bool
otherwise -> UnknownArchive
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath]
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (UnknownArchive
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath])
-> UnknownArchive
-> Excepts '[UnknownArchive, ArchiveResult] m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> UnknownArchive
UnknownArchive FilePath
fn
intoSubdir :: (MonadReader env m, HasLog env, MonadIO m, MonadThrow m, MonadCatch m)
=> FilePath
-> TarDir
-> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir :: FilePath -> TarDir -> Excepts '[TarDirDoesNotExist] m FilePath
intoSubdir FilePath
bdir TarDir
tardir = case TarDir
tardir of
RealDir FilePath
pr -> do
Excepts '[TarDirDoesNotExist] m Bool
-> Excepts '[TarDirDoesNotExist] m ()
-> Excepts '[TarDirDoesNotExist] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((Bool -> Bool)
-> Excepts '[TarDirDoesNotExist] m Bool
-> Excepts '[TarDirDoesNotExist] m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Excepts '[TarDirDoesNotExist] m Bool
-> Excepts '[TarDirDoesNotExist] m Bool)
-> (FilePath -> Excepts '[TarDirDoesNotExist] m Bool)
-> FilePath
-> Excepts '[TarDirDoesNotExist] m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Bool -> Excepts '[TarDirDoesNotExist] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Excepts '[TarDirDoesNotExist] m Bool)
-> (FilePath -> IO Bool)
-> FilePath
-> Excepts '[TarDirDoesNotExist] m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
doesDirectoryExist (FilePath -> Excepts '[TarDirDoesNotExist] m Bool)
-> FilePath -> Excepts '[TarDirDoesNotExist] m Bool
forall a b. (a -> b) -> a -> b
$ (FilePath
bdir FilePath -> FilePath -> FilePath
</> FilePath
pr))
(TarDirDoesNotExist -> Excepts '[TarDirDoesNotExist] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (TarDirDoesNotExist -> Excepts '[TarDirDoesNotExist] m ())
-> TarDirDoesNotExist -> Excepts '[TarDirDoesNotExist] m ()
forall a b. (a -> b) -> a -> b
$ TarDir -> TarDirDoesNotExist
TarDirDoesNotExist TarDir
tardir)
FilePath -> Excepts '[TarDirDoesNotExist] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
bdir FilePath -> FilePath -> FilePath
</> FilePath
pr)
RegexDir FilePath
r -> do
let rs :: [FilePath]
rs = (Char -> Bool) -> FilePath -> [FilePath]
forall a. (a -> Bool) -> [a] -> [[a]]
split (Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
pathSeparators) FilePath
r
(FilePath -> FilePath -> Excepts '[TarDirDoesNotExist] m FilePath)
-> FilePath
-> [FilePath]
-> Excepts '[TarDirDoesNotExist] m FilePath
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
(\FilePath
y FilePath
x ->
((IOException -> Excepts '[TarDirDoesNotExist] m [FilePath])
-> Excepts '[TarDirDoesNotExist] m [FilePath]
-> Excepts '[TarDirDoesNotExist] m [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [FilePath] -> Excepts '[TarDirDoesNotExist] m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (Excepts '[TarDirDoesNotExist] m [FilePath]
-> Excepts '[TarDirDoesNotExist] m [FilePath])
-> (FilePath -> Excepts '[TarDirDoesNotExist] m [FilePath])
-> FilePath
-> Excepts '[TarDirDoesNotExist] m [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [FilePath] -> Excepts '[TarDirDoesNotExist] m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Excepts '[TarDirDoesNotExist] m [FilePath])
-> (FilePath -> IO [FilePath])
-> FilePath
-> Excepts '[TarDirDoesNotExist] m [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Regex -> IO [FilePath]
findFiles FilePath
y (Regex -> IO [FilePath])
-> (FilePath -> Regex) -> FilePath -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Regex
regex (FilePath -> Excepts '[TarDirDoesNotExist] m [FilePath])
-> FilePath -> Excepts '[TarDirDoesNotExist] m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
x) Excepts '[TarDirDoesNotExist] m [FilePath]
-> ([FilePath] -> Excepts '[TarDirDoesNotExist] m FilePath)
-> Excepts '[TarDirDoesNotExist] m FilePath
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\case
[] -> TarDirDoesNotExist -> Excepts '[TarDirDoesNotExist] m FilePath
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (TarDirDoesNotExist -> Excepts '[TarDirDoesNotExist] m FilePath)
-> TarDirDoesNotExist -> Excepts '[TarDirDoesNotExist] m FilePath
forall a b. (a -> b) -> a -> b
$ TarDir -> TarDirDoesNotExist
TarDirDoesNotExist TarDir
tardir
(FilePath
p : [FilePath]
_) -> FilePath -> Excepts '[TarDirDoesNotExist] m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
y FilePath -> FilePath -> FilePath
</> FilePath
p)) ([FilePath] -> Excepts '[TarDirDoesNotExist] m FilePath)
-> ([FilePath] -> [FilePath])
-> [FilePath]
-> Excepts '[TarDirDoesNotExist] m FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort
)
FilePath
bdir
[FilePath]
rs
where regex :: FilePath -> Regex
regex = CompOption -> ExecOption -> FilePath -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compIgnoreCase ExecOption
execBlank
getTagged :: Tag
-> Fold (Map.Map Version VersionInfo) (Version, VersionInfo)
getTagged :: Tag -> Fold (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
tag =
(Map Version VersionInfo -> [(Version, VersionInfo)])
-> Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
[(Version, VersionInfo)]
[(Version, VersionInfo)]
forall s a. (s -> a) -> Getter s a
to (Map Version VersionInfo -> [(Version, VersionInfo)]
forall k a. Map k a -> [(k, a)]
Map.toDescList (Map Version VersionInfo -> [(Version, VersionInfo)])
-> (Map Version VersionInfo -> Map Version VersionInfo)
-> Map Version VersionInfo
-> [(Version, VersionInfo)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VersionInfo -> Bool)
-> Map Version VersionInfo -> Map Version VersionInfo
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (\VersionInfo {[Tag]
Maybe Text
Maybe URI
Maybe DownloadInfo
ArchitectureSpec
$sel:_viPreCompile:VersionInfo :: VersionInfo -> Maybe Text
$sel:_viPostRemove:VersionInfo :: VersionInfo -> Maybe Text
$sel:_viPostInstall:VersionInfo :: VersionInfo -> Maybe Text
$sel:_viArch:VersionInfo :: VersionInfo -> ArchitectureSpec
$sel:_viSourceDL:VersionInfo :: VersionInfo -> Maybe DownloadInfo
$sel:_viChangeLog:VersionInfo :: VersionInfo -> Maybe URI
$sel:_viTags:VersionInfo :: VersionInfo -> [Tag]
_viPreCompile :: Maybe Text
_viPostRemove :: Maybe Text
_viPostInstall :: Maybe Text
_viArch :: ArchitectureSpec
_viSourceDL :: Maybe DownloadInfo
_viChangeLog :: Maybe URI
_viTags :: [Tag]
..} -> Tag
tag Tag -> [Tag] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Tag]
_viTags))
Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
[(Version, VersionInfo)]
[(Version, VersionInfo)]
-> Optic
A_Fold
'[]
[(Version, VersionInfo)]
[(Version, VersionInfo)]
(Version, VersionInfo)
(Version, VersionInfo)
-> Fold (Map Version VersionInfo) (Version, VersionInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% ([(Version, VersionInfo)] -> [(Version, VersionInfo)])
-> Optic
A_Fold
'[]
[(Version, VersionInfo)]
[(Version, VersionInfo)]
(Version, VersionInfo)
(Version, VersionInfo)
forall (f :: * -> *) s a. Foldable f => (s -> f a) -> Fold s a
folding [(Version, VersionInfo)] -> [(Version, VersionInfo)]
forall a. a -> a
id
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest GHCupDownloads
av Tool
tool = Optic' A_Fold '[] GHCupDownloads (Version, VersionInfo)
-> GHCupDownloads -> Maybe (Version, VersionInfo)
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> Maybe a
headOf (Index GHCupDownloads
-> Optic'
(IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
tool Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Fold (Map Version VersionInfo) (Version, VersionInfo)
-> Optic' A_Fold '[] GHCupDownloads (Version, VersionInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Tag -> Fold (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
Latest) GHCupDownloads
av
getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getRecommended :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getRecommended GHCupDownloads
av Tool
tool = Optic' A_Fold '[] GHCupDownloads (Version, VersionInfo)
-> GHCupDownloads -> Maybe (Version, VersionInfo)
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> Maybe a
headOf (Index GHCupDownloads
-> Optic'
(IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
tool Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Fold (Map Version VersionInfo) (Version, VersionInfo)
-> Optic' A_Fold '[] GHCupDownloads (Version, VersionInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Tag -> Fold (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
Recommended) GHCupDownloads
av
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo)
getLatestBaseVersion :: GHCupDownloads -> PVP -> Maybe (Version, VersionInfo)
getLatestBaseVersion GHCupDownloads
av PVP
pvpVer =
Optic' A_Fold '[] GHCupDownloads (Version, VersionInfo)
-> GHCupDownloads -> Maybe (Version, VersionInfo)
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> Maybe a
headOf (Index GHCupDownloads
-> Optic'
(IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
GHC Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Fold (Map Version VersionInfo) (Version, VersionInfo)
-> Optic' A_Fold '[] GHCupDownloads (Version, VersionInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Tag -> Fold (Map Version VersionInfo) (Version, VersionInfo)
getTagged (PVP -> Tag
Base PVP
pvpVer)) GHCupDownloads
av
ghcInternalBinDir :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
=> GHCTargetVersion
-> m FilePath
ghcInternalBinDir :: GHCTargetVersion -> m FilePath
ghcInternalBinDir GHCTargetVersion
ver = do
FilePath
ghcdir <- GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ver
FilePath -> m FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
ghcdir FilePath -> FilePath -> FilePath
</> FilePath
"bin")
ghcToolFiles :: (MonadReader env m, HasDirs env, MonadThrow m, MonadFail m, MonadIO m)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles :: GHCTargetVersion -> Excepts '[NotInstalled] m [FilePath]
ghcToolFiles GHCTargetVersion
ver = do
FilePath
bindir <- GHCTargetVersion -> Excepts '[NotInstalled] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m, MonadFail m,
MonadIO m) =>
GHCTargetVersion -> m FilePath
ghcInternalBinDir GHCTargetVersion
ver
Excepts '[NotInstalled] m Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM ((Bool -> Bool)
-> Excepts '[NotInstalled] m Bool -> Excepts '[NotInstalled] m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (Excepts '[NotInstalled] m Bool -> Excepts '[NotInstalled] m Bool)
-> Excepts '[NotInstalled] m Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m Bool
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver)
(NotInstalled -> Excepts '[NotInstalled] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (Tool -> GHCTargetVersion -> NotInstalled
NotInstalled Tool
GHC GHCTargetVersion
ver))
[FilePath]
files <- IO [FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> IO [FilePath]
listDirectory FilePath
bindir IO [FilePath] -> ([FilePath] -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesFileExist (FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
bindir FilePath -> FilePath -> FilePath
</>)))
[FilePath] -> Excepts '[NotInstalled] m [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[(FilePath, FilePath)]] -> [FilePath]
getUniqueTools ([[(FilePath, FilePath)]] -> [FilePath])
-> ([FilePath] -> [[(FilePath, FilePath)]])
-> [FilePath]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [[(FilePath, FilePath)]]
groupToolFiles ([FilePath] -> [[(FilePath, FilePath)]])
-> ([FilePath] -> [FilePath])
-> [FilePath]
-> [[(FilePath, FilePath)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropSuffix FilePath
exeExt) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath]
files)
where
groupToolFiles :: [FilePath] -> [[(FilePath, String)]]
groupToolFiles :: [FilePath] -> [[(FilePath, FilePath)]]
groupToolFiles = ((FilePath, FilePath) -> (FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath)] -> [[(FilePath, FilePath)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(FilePath
a, FilePath
_) (FilePath
b, FilePath
_) -> FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
b) ([(FilePath, FilePath)] -> [[(FilePath, FilePath)]])
-> ([FilePath] -> [(FilePath, FilePath)])
-> [FilePath]
-> [[(FilePath, FilePath)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> (FilePath, FilePath))
-> [FilePath] -> [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath -> FilePath -> (FilePath, FilePath)
splitOnPVP FilePath
"-")
getUniqueTools :: [[(FilePath, String)]] -> [String]
getUniqueTools :: [[(FilePath, FilePath)]] -> [FilePath]
getUniqueTools = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter ([FilePath] -> FilePath -> Bool
isNotAnyInfix [FilePath]
blackListedTools) ([FilePath] -> [FilePath])
-> ([[(FilePath, FilePath)]] -> [FilePath])
-> [[(FilePath, FilePath)]]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath])
-> ([[(FilePath, FilePath)]] -> [FilePath])
-> [[(FilePath, FilePath)]]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ([(FilePath, FilePath)] -> [FilePath])
-> ([[(FilePath, FilePath)]] -> [(FilePath, FilePath)])
-> [[(FilePath, FilePath)]]
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"") (FilePath -> Bool)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd) ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> ([[(FilePath, FilePath)]] -> [(FilePath, FilePath)])
-> [[(FilePath, FilePath)]]
-> [(FilePath, FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[(FilePath, FilePath)]] -> [(FilePath, FilePath)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
blackListedTools :: [String]
blackListedTools :: [FilePath]
blackListedTools = [FilePath
"haddock-ghc"]
isNotAnyInfix :: [String] -> String -> Bool
isNotAnyInfix :: [FilePath] -> FilePath -> Bool
isNotAnyInfix [FilePath]
xs FilePath
t = (FilePath -> Bool -> Bool) -> Bool -> [FilePath] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\FilePath
a Bool
b -> Bool -> Bool
not (FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` FilePath
t) Bool -> Bool -> Bool
&& Bool
b) Bool
True [FilePath]
xs
ghcUpSrcBuiltFile :: FilePath
ghcUpSrcBuiltFile :: FilePath
ghcUpSrcBuiltFile = FilePath
".ghcup_src_built"
make :: ( MonadThrow m
, MonadIO m
, MonadReader env m
, HasDirs env
, HasLog env
, HasSettings env
)
=> [String]
-> Maybe FilePath
-> m (Either ProcessError ())
make :: [FilePath] -> Maybe FilePath -> m (Either ProcessError ())
make [FilePath]
args Maybe FilePath
workdir = do
[FilePath]
spaths <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
getSearchPath
Bool
has_gmake <- Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool) -> m (Maybe FilePath) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath [FilePath]
spaths FilePath
"gmake")
let mymake :: FilePath
mymake = if Bool
has_gmake then FilePath
"gmake" else FilePath
"make"
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall env (m :: * -> *).
(MonadReader env m, HasSettings env, HasLog env, HasDirs env,
MonadIO m, MonadThrow m) =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
execLogged FilePath
mymake [FilePath]
args Maybe FilePath
workdir FilePath
"ghc-make" Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
makeOut :: (MonadReader env m, HasDirs env, MonadIO m)
=> [String]
-> Maybe FilePath
-> m CapturedProcess
makeOut :: [FilePath] -> Maybe FilePath -> m CapturedProcess
makeOut [FilePath]
args Maybe FilePath
workdir = do
[FilePath]
spaths <- IO [FilePath] -> m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [FilePath]
getSearchPath
Bool
has_gmake <- Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust (Maybe FilePath -> Bool) -> m (Maybe FilePath) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe FilePath) -> m (Maybe FilePath)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([FilePath] -> FilePath -> IO (Maybe FilePath)
searchPath [FilePath]
spaths FilePath
"gmake")
let mymake :: FilePath
mymake = if Bool
has_gmake then FilePath
"gmake" else FilePath
"make"
FilePath -> [FilePath] -> Maybe FilePath -> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
FilePath -> [FilePath] -> Maybe FilePath -> m CapturedProcess
executeOut FilePath
mymake [FilePath]
args Maybe FilePath
workdir
applyPatches :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
=> FilePath
-> FilePath
-> Excepts '[PatchFailed] m ()
applyPatches :: FilePath -> FilePath -> Excepts '[PatchFailed] m ()
applyPatches FilePath
pdir FilePath
ddir = do
let lexicographical :: IO [FilePath]
lexicographical = (([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath])
-> ((FilePath -> FilePath) -> [FilePath] -> [FilePath])
-> (FilePath -> FilePath)
-> IO [FilePath]
-> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (FilePath
pdir FilePath -> FilePath -> FilePath
</>) (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Regex -> IO [FilePath]
findFiles
FilePath
pdir
(CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compExtended
ExecOption
execBlank
([s|.+\.(patch|diff)$|] :: ByteString)
)
let quilt :: IO [FilePath]
quilt = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
pdir FilePath -> FilePath -> FilePath
</>) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
readFile (FilePath
pdir FilePath -> FilePath -> FilePath
</> FilePath
"series")
[FilePath]
patches <- IO [FilePath] -> Excepts '[PatchFailed] m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Excepts '[PatchFailed] m [FilePath])
-> IO [FilePath] -> Excepts '[PatchFailed] m [FilePath]
forall a b. (a -> b) -> a -> b
$ IO [FilePath]
quilt IO [FilePath] -> (IOException -> IO [FilePath]) -> IO [FilePath]
forall (m :: * -> *) a.
MonadCatch m =>
m a -> (IOException -> m a) -> m a
`catchIO` (\IOException
e ->
if IOException -> Bool
isDoesNotExistError IOException
e Bool -> Bool -> Bool
|| IOException -> Bool
isPermissionError IOException
e then
IO [FilePath]
lexicographical
else IOException -> IO [FilePath]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO IOException
e)
[FilePath]
-> (FilePath -> Excepts '[PatchFailed] m ())
-> Excepts '[PatchFailed] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [FilePath]
patches ((FilePath -> Excepts '[PatchFailed] m ())
-> Excepts '[PatchFailed] m ())
-> (FilePath -> Excepts '[PatchFailed] m ())
-> Excepts '[PatchFailed] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
patch' -> FilePath -> FilePath -> Excepts '[PatchFailed] m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasLog env, MonadIO m) =>
FilePath -> FilePath -> Excepts '[PatchFailed] m ()
applyPatch FilePath
patch' FilePath
ddir
applyPatch :: (MonadReader env m, HasDirs env, HasLog env, MonadIO m)
=> FilePath
-> FilePath
-> Excepts '[PatchFailed] m ()
applyPatch :: FilePath -> FilePath -> Excepts '[PatchFailed] m ()
applyPatch FilePath
patch FilePath
ddir = do
m () -> Excepts '[PatchFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[PatchFailed] m ())
-> m () -> Excepts '[PatchFailed] m ()
forall a b. (a -> b) -> a -> b
$ 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
$ Text
"Applying patch " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
patch
(Either ProcessError () -> Maybe ())
-> m (Either ProcessError ()) -> m (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ProcessError -> Maybe ())
-> (() -> Maybe ()) -> Either ProcessError () -> Maybe ()
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe () -> ProcessError -> Maybe ()
forall a b. a -> b -> a
const Maybe ()
forall a. Maybe a
Nothing) () -> Maybe ()
forall a. a -> Maybe a
Just)
(FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall (m :: * -> *).
MonadIO m =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
exec
FilePath
"patch"
[FilePath
"-p1", FilePath
"-s", FilePath
"-f", FilePath
"-i", FilePath
patch]
(FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
ddir)
Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing)
m (Maybe ()) -> PatchFailed -> Excepts '[PatchFailed] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
m (Maybe a) -> e -> Excepts es m a
!? PatchFailed
PatchFailed
darwinNotarization :: (MonadReader env m, HasDirs env, MonadIO m)
=> Platform
-> FilePath
-> m (Either ProcessError ())
darwinNotarization :: Platform -> FilePath -> m (Either ProcessError ())
darwinNotarization Platform
Darwin FilePath
path = FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
forall (m :: * -> *).
MonadIO m =>
FilePath
-> [FilePath]
-> Maybe FilePath
-> Maybe [(FilePath, FilePath)]
-> m (Either ProcessError ())
exec
FilePath
"xattr"
[FilePath
"-r", FilePath
"-d", FilePath
"com.apple.quarantine", FilePath
path]
Maybe FilePath
forall a. Maybe a
Nothing
Maybe [(FilePath, FilePath)]
forall a. Maybe a
Nothing
darwinNotarization Platform
_ FilePath
_ = Either ProcessError () -> m (Either ProcessError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProcessError () -> m (Either ProcessError ()))
-> Either ProcessError () -> m (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ () -> Either ProcessError ()
forall a b. b -> Either a b
Right ()
getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
getChangeLog :: GHCupDownloads -> Tool -> Either Version Tag -> Maybe URI
getChangeLog GHCupDownloads
dls Tool
tool (Left Version
v') =
Optic' An_AffineTraversal '[] GHCupDownloads URI
-> GHCupDownloads -> Maybe URI
forall k (is :: [*]) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index GHCupDownloads
-> Optic'
(IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
tool Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Optic
An_AffineTraversal
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
VersionInfo
VersionInfo
-> Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
VersionInfo
VersionInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Version VersionInfo)
-> Optic'
(IxKind (Map Version VersionInfo))
'[]
(Map Version VersionInfo)
(IxValue (Map Version VersionInfo))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map Version VersionInfo)
Version
v' Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
VersionInfo
VersionInfo
-> Optic A_Lens '[] VersionInfo VersionInfo (Maybe URI) (Maybe URI)
-> Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Maybe URI)
(Maybe URI)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] VersionInfo VersionInfo (Maybe URI) (Maybe URI)
viChangeLog Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Maybe URI)
(Maybe URI)
-> Optic A_Prism '[] (Maybe URI) (Maybe URI) URI URI
-> Optic' An_AffineTraversal '[] GHCupDownloads URI
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism '[] (Maybe URI) (Maybe URI) URI URI
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) GHCupDownloads
dls
getChangeLog GHCupDownloads
dls Tool
tool (Right Tag
tag) =
Optic' An_AffineFold '[] GHCupDownloads URI
-> GHCupDownloads -> Maybe URI
forall k (is :: [*]) s a.
Is k An_AffineFold =>
Optic' k is s a -> s -> Maybe a
preview (Index GHCupDownloads
-> Optic'
(IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
tool Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Optic
An_AffineFold
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
(Version, VersionInfo)
(Version, VersionInfo)
-> Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
(Version, VersionInfo)
(Version, VersionInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Fold (Map Version VersionInfo) (Version, VersionInfo)
-> Optic
An_AffineFold
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
(Version, VersionInfo)
(Version, VersionInfo)
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> AffineFold s a
pre (Tag -> Fold (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
tag) Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
(Version, VersionInfo)
(Version, VersionInfo)
-> Optic
A_Getter
'[]
(Version, VersionInfo)
(Version, VersionInfo)
VersionInfo
VersionInfo
-> Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
VersionInfo
VersionInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% ((Version, VersionInfo) -> VersionInfo)
-> Optic
A_Getter
'[]
(Version, VersionInfo)
(Version, VersionInfo)
VersionInfo
VersionInfo
forall s a. (s -> a) -> Getter s a
to (Version, VersionInfo) -> VersionInfo
forall a b. (a, b) -> b
snd Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
VersionInfo
VersionInfo
-> Optic A_Lens '[] VersionInfo VersionInfo (Maybe URI) (Maybe URI)
-> Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
(Maybe URI)
(Maybe URI)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Lens '[] VersionInfo VersionInfo (Maybe URI) (Maybe URI)
viChangeLog Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
(Maybe URI)
(Maybe URI)
-> Optic A_Prism '[] (Maybe URI) (Maybe URI) URI URI
-> Optic' An_AffineFold '[] GHCupDownloads URI
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Prism '[] (Maybe URI) (Maybe URI) URI URI
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) GHCupDownloads
dls
runBuildAction :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadIO m
, MonadMask m
, HasLog env
, MonadUnliftIO m
, MonadFail m
, MonadCatch m
)
=> FilePath
-> Maybe FilePath
-> Excepts e m a
-> Excepts e m a
runBuildAction :: FilePath -> Maybe FilePath -> Excepts e m a -> Excepts e m a
runBuildAction FilePath
bdir Maybe FilePath
instdir Excepts e m a
action = do
Settings {Bool
Integer
GPGSetting
Downloader
KeepDirs
URLSource
$sel:noColor:Settings :: Settings -> Bool
$sel:gpgSetting:Settings :: Settings -> GPGSetting
$sel:noNetwork:Settings :: Settings -> Bool
$sel:urlSource:Settings :: Settings -> URLSource
$sel:verbose:Settings :: Settings -> Bool
$sel:downloader:Settings :: Settings -> Downloader
$sel:keepDirs:Settings :: Settings -> KeepDirs
$sel:noVerify:Settings :: Settings -> Bool
$sel:metaCache:Settings :: Settings -> Integer
$sel:cache:Settings :: Settings -> Bool
noColor :: Bool
gpgSetting :: GPGSetting
noNetwork :: Bool
urlSource :: URLSource
verbose :: Bool
downloader :: Downloader
keepDirs :: KeepDirs
noVerify :: Bool
metaCache :: Integer
cache :: Bool
..} <- m Settings -> Excepts e m Settings
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Settings
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "settings" A_Lens env Settings) =>
m Settings
getSettings
let exAction :: m ()
exAction = do
Maybe FilePath -> (FilePath -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe FilePath
instdir ((FilePath -> m ()) -> m ()) -> (FilePath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
dir ->
IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasDirs env, MonadMask m) =>
FilePath -> m ()
recyclePathForcibly FilePath
dir
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KeepDirs
keepDirs KeepDirs -> KeepDirs -> Bool
forall a. Eq a => a -> a -> Bool
== KeepDirs
Never)
(m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadUnliftIO m, MonadIO m) =>
FilePath -> m ()
rmBDir FilePath
bdir
a
v <-
(Excepts e m a -> Excepts e m () -> Excepts e m a)
-> Excepts e m () -> Excepts e m a -> Excepts e m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts e m a -> Excepts e m () -> Excepts e m a
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
onException (m () -> Excepts e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
exAction)
(Excepts e m a -> Excepts e m a) -> Excepts e m a -> Excepts e m a
forall a b. (a -> b) -> a -> b
$ m () -> Excepts e m a -> Excepts e m a
forall (m :: * -> *) (es :: [*]) a.
Monad m =>
m () -> Excepts es m a -> Excepts es m a
onE_ m ()
exAction Excepts e m a
action
Bool -> Excepts e m () -> Excepts e m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KeepDirs
keepDirs KeepDirs -> KeepDirs -> Bool
forall a. Eq a => a -> a -> Bool
== KeepDirs
Never Bool -> Bool -> Bool
|| KeepDirs
keepDirs KeepDirs -> KeepDirs -> Bool
forall a. Eq a => a -> a -> Bool
== KeepDirs
Errors) (Excepts e m () -> Excepts e m ())
-> Excepts e m () -> Excepts e m ()
forall a b. (a -> b) -> a -> b
$ m () -> Excepts e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts e m ()) -> m () -> Excepts e m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadUnliftIO m, MonadIO m) =>
FilePath -> m ()
rmBDir FilePath
bdir
a -> Excepts e m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
cleanUpOnError :: ( MonadReader env m
, HasDirs env
, HasSettings env
, MonadIO m
, MonadMask m
, HasLog env
, MonadUnliftIO m
, MonadFail m
, MonadCatch m
)
=> FilePath
-> Excepts e m a
-> Excepts e m a
cleanUpOnError :: FilePath -> Excepts e m a -> Excepts e m a
cleanUpOnError FilePath
bdir Excepts e m a
action = do
Settings {Bool
Integer
GPGSetting
Downloader
KeepDirs
URLSource
noColor :: Bool
gpgSetting :: GPGSetting
noNetwork :: Bool
urlSource :: URLSource
verbose :: Bool
downloader :: Downloader
keepDirs :: KeepDirs
noVerify :: Bool
metaCache :: Integer
cache :: Bool
$sel:noColor:Settings :: Settings -> Bool
$sel:gpgSetting:Settings :: Settings -> GPGSetting
$sel:noNetwork:Settings :: Settings -> Bool
$sel:urlSource:Settings :: Settings -> URLSource
$sel:verbose:Settings :: Settings -> Bool
$sel:downloader:Settings :: Settings -> Downloader
$sel:keepDirs:Settings :: Settings -> KeepDirs
$sel:noVerify:Settings :: Settings -> Bool
$sel:metaCache:Settings :: Settings -> Integer
$sel:cache:Settings :: Settings -> Bool
..} <- m Settings -> Excepts e m Settings
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Settings
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "settings" A_Lens env Settings) =>
m Settings
getSettings
let exAction :: m ()
exAction = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KeepDirs
keepDirs KeepDirs -> KeepDirs -> Bool
forall a. Eq a => a -> a -> Bool
== KeepDirs
Never) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadUnliftIO m, MonadIO m) =>
FilePath -> m ()
rmBDir FilePath
bdir
(Excepts e m a -> Excepts e m () -> Excepts e m a)
-> Excepts e m () -> Excepts e m a -> Excepts e m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts e m a -> Excepts e m () -> Excepts e m a
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
onException (m () -> Excepts e m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ()
exAction) (Excepts e m a -> Excepts e m a) -> Excepts e m a -> Excepts e m a
forall a b. (a -> b) -> a -> b
$ m () -> Excepts e m a -> Excepts e m a
forall (m :: * -> *) (es :: [*]) a.
Monad m =>
m () -> Excepts es m a -> Excepts es m a
onE_ m ()
exAction Excepts e m a
action
rmBDir :: (MonadReader env m, HasLog env, MonadUnliftIO m, MonadIO m) => FilePath -> m ()
rmBDir :: FilePath -> m ()
rmBDir FilePath
dir = ((forall a. m a -> IO a) -> IO ()) -> m ()
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO (\forall a. m a -> IO a
run -> m () -> IO ()
forall a. m a -> IO a
run (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ (IOException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> m () -> IO ()
forall a. m a -> IO a
run (m () -> IO ()) -> m () -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Couldn't remove build dir " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", error was: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (IOException -> FilePath
forall e. Exception e => e -> FilePath
displayException IOException
e))
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> IO () -> IO ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType
(IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall (m :: * -> *). (MonadIO m, MonadMask m) => FilePath -> m ()
rmPathForcibly FilePath
dir)
getVersionInfo :: Version
-> Tool
-> GHCupDownloads
-> Maybe VersionInfo
getVersionInfo :: Version -> Tool -> GHCupDownloads -> Maybe VersionInfo
getVersionInfo Version
v' Tool
tool =
Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
VersionInfo
VersionInfo
-> GHCupDownloads -> Maybe VersionInfo
forall k (is :: [*]) s a.
Is k A_Fold =>
Optic' k is s a -> s -> Maybe a
headOf
( Index GHCupDownloads
-> Optic'
(IxKind GHCupDownloads) '[] GHCupDownloads (IxValue GHCupDownloads)
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index GHCupDownloads
Tool
tool
Optic
An_AffineTraversal
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Map Version VersionInfo -> Map Version VersionInfo)
-> Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
(Map Version VersionInfo)
(Map Version VersionInfo)
forall s a. (s -> a) -> Getter s a
to ((Version -> VersionInfo -> Bool)
-> Map Version VersionInfo -> Map Version VersionInfo
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Version
k VersionInfo
_ -> Version
k Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
v'))
Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
(Map Version VersionInfo)
(Map Version VersionInfo)
-> Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
[VersionInfo]
[VersionInfo]
-> Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
[VersionInfo]
[VersionInfo]
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% (Map Version VersionInfo -> [VersionInfo])
-> Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
[VersionInfo]
[VersionInfo]
forall s a. (s -> a) -> Getter s a
to Map Version VersionInfo -> [VersionInfo]
forall k a. Map k a -> [a]
Map.elems
Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
[VersionInfo]
[VersionInfo]
-> Optic
An_AffineTraversal
'[]
[VersionInfo]
[VersionInfo]
VersionInfo
VersionInfo
-> Optic
An_AffineFold
'[]
GHCupDownloads
GHCupDownloads
VersionInfo
VersionInfo
forall k l m (is :: [*]) (js :: [*]) (ks :: [*]) s t u v a b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic
An_AffineTraversal
'[]
[VersionInfo]
[VersionInfo]
VersionInfo
VersionInfo
forall s a. Cons s s a a => AffineTraversal' s a
_head
)
exeExt :: String
exeExt :: FilePath
exeExt
| Bool
isWindows = FilePath
".exe"
| Bool
otherwise = FilePath
""
exeExt' :: ByteString
exeExt' :: ByteString
exeExt'
| Bool
isWindows = ByteString
".exe"
| Bool
otherwise = ByteString
""
getLinkTarget :: FilePath -> IO FilePath
getLinkTarget :: FilePath -> IO FilePath
getLinkTarget FilePath
fp
| Bool
isWindows = do
FilePath
content <- FilePath -> IO FilePath
readFile (FilePath -> FilePath
dropExtension FilePath
fp FilePath -> FilePath -> FilePath
<.> FilePath
"shim")
[FilePath
p] <- [FilePath] -> IO [FilePath]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([FilePath] -> IO [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> IO [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath
"path = " FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
lines (FilePath -> IO [FilePath]) -> FilePath -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
content
FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
stripNewline (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
forall a. Eq a => [a] -> [a] -> [a]
dropPrefix FilePath
"path = " FilePath
p
| Bool
otherwise = FilePath -> IO FilePath
getSymbolicLinkTarget FilePath
fp
pathIsLink :: FilePath -> IO Bool
pathIsLink :: FilePath -> IO Bool
pathIsLink FilePath
fp
| Bool
isWindows = FilePath -> IO Bool
doesPathExist (FilePath -> FilePath
dropExtension FilePath
fp FilePath -> FilePath -> FilePath
<.> FilePath
"shim")
| Bool
otherwise = FilePath -> IO Bool
pathIsSymbolicLink FilePath
fp
rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m ()
rmLink :: FilePath -> m ()
rmLink FilePath
fp
| Bool
isWindows = do
IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> (FilePath -> m ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
fp
IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> (FilePath -> m ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath
dropExtension FilePath
fp FilePath -> FilePath -> FilePath
<.> FilePath
"shim")
| Bool
otherwise = IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> (FilePath -> m ()) -> FilePath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (FilePath -> m ()) -> FilePath -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath
fp
createLink :: ( MonadMask m
, MonadThrow m
, HasLog env
, MonadIO m
, MonadReader env m
, HasDirs env
, MonadUnliftIO m
, MonadFail m
)
=> FilePath
-> FilePath
-> m ()
createLink :: FilePath -> FilePath -> m ()
createLink FilePath
link FilePath
exe
| Bool
isWindows = do
Dirs
dirs <- m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
let shimGen :: FilePath
shimGen = Dirs -> FilePath
cacheDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"gs.exe"
let shim :: FilePath
shim = FilePath -> FilePath
dropExtension FilePath
exe FilePath -> FilePath -> FilePath
<.> FilePath
"shim"
fullLink :: FilePath
fullLink = FilePath -> FilePath
takeDirectory FilePath
exe FilePath -> FilePath -> FilePath
</> FilePath
link
shimContents :: FilePath
shimContents = FilePath
"path = " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fullLink
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
exe
FilePath -> m ()
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadIO m, MonadMask m) =>
FilePath -> m ()
rmLink FilePath
exe
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"ln -s " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
fullLink Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
exe
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
copyFile FilePath
shimGen FilePath
exe
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
writeFile FilePath
shim FilePath
shimContents
| Bool
otherwise = do
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
exe
IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile FilePath
exe
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"ln -s " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
link Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
exe
IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
createFileLink FilePath
link FilePath
exe
ensureGlobalTools :: ( MonadMask m
, MonadThrow m
, HasLog env
, MonadIO m
, MonadReader env m
, HasDirs env
, HasSettings env
, HasGHCupInfo env
, MonadUnliftIO m
, MonadFail m
)
=> Excepts '[GPGError, DigestError , DownloadFailed, NoDownload] m ()
ensureGlobalTools :: Excepts '[GPGError, DigestError, DownloadFailed, NoDownload] m ()
ensureGlobalTools
| Bool
isWindows = do
(GHCupInfo ToolRequirements
_ GHCupDownloads
_ Map GlobalTool DownloadInfo
gTools) <- m GHCupInfo
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m GHCupInfo
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m GHCupInfo
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "ghcupInfo" A_Lens env GHCupInfo) =>
m GHCupInfo
getGHCupInfo
Dirs
dirs <- m Dirs
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m Dirs
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m Dirs
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
DownloadInfo
shimDownload <- Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m DownloadInfo
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload]
m
DownloadInfo)
-> Excepts '[NoDownload] m DownloadInfo
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m DownloadInfo
forall a b. (a -> b) -> a -> b
$ forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
forall a (m :: * -> *).
(Monad m, NoDownload :< '[NoDownload]) =>
Either NoDownload a -> Excepts '[NoDownload] m a
lE @_ @'[NoDownload]
(Either NoDownload DownloadInfo
-> Excepts '[NoDownload] m DownloadInfo)
-> Either NoDownload DownloadInfo
-> Excepts '[NoDownload] m DownloadInfo
forall a b. (a -> b) -> a -> b
$ Either NoDownload DownloadInfo
-> (DownloadInfo -> Either NoDownload DownloadInfo)
-> Maybe DownloadInfo
-> Either NoDownload DownloadInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (NoDownload -> Either NoDownload DownloadInfo
forall a b. a -> Either a b
Left NoDownload
NoDownload) DownloadInfo -> Either NoDownload DownloadInfo
forall a b. b -> Either a b
Right (Maybe DownloadInfo -> Either NoDownload DownloadInfo)
-> Maybe DownloadInfo -> Either NoDownload DownloadInfo
forall a b. (a -> b) -> a -> b
$ GlobalTool -> Map GlobalTool DownloadInfo -> Maybe DownloadInfo
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup GlobalTool
ShimGen Map GlobalTool DownloadInfo
gTools
let dl :: Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
dl = DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, HasSettings env, MonadMask m,
MonadThrow m, HasLog env, MonadIO m, MonadUnliftIO m) =>
DownloadInfo
-> Maybe FilePath
-> Maybe FilePath
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
downloadCached' DownloadInfo
shimDownload (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"gs.exe") Maybe FilePath
forall a. Maybe a
Nothing
Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m FilePath
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m FilePath
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m ())
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m FilePath
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m ()
forall a b. (a -> b) -> a -> b
$ (\DigestError{} -> do
m () -> Excepts '[GPGError, DigestError, DownloadFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[GPGError, DigestError, DownloadFailed] m ())
-> m () -> Excepts '[GPGError, DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logWarn Text
"Digest doesn't match, redownloading gs.exe..."
m () -> Excepts '[GPGError, DigestError, DownloadFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[GPGError, DigestError, DownloadFailed] m ())
-> m () -> Excepts '[GPGError, DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
"rm -f " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack (Dirs -> FilePath
cacheDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"gs.exe"))
m () -> Excepts '[GPGError, DigestError, DownloadFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[GPGError, DigestError, DownloadFailed] m ())
-> m () -> Excepts '[GPGError, DigestError, DownloadFailed] m ()
forall a b. (a -> b) -> a -> b
$ IOErrorType -> m () -> m ()
forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
IOErrorType -> m () -> m ()
hideError IOErrorType
doesNotExistErrorType (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> m ()
forall (m :: * -> *) env.
(MonadIO m, MonadMask m, MonadReader env m, HasDirs env) =>
FilePath -> m ()
recycleFile (Dirs -> FilePath
cacheDir Dirs
dirs FilePath -> FilePath -> FilePath
</> FilePath
"gs.exe")
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
forall (es :: [*]) a (m :: * -> *).
(Monad m,
VEitherLift es '[GPGError, DigestError, DownloadFailed]) =>
Excepts es m a
-> Excepts '[GPGError, DigestError, DownloadFailed] m a
liftE @'[GPGError, DigestError , DownloadFailed] (Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts '[GPGError, DigestError, DownloadFailed] m FilePath)
-> Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts '[GPGError, DigestError, DownloadFailed] m FilePath
forall a b. (a -> b) -> a -> b
$ Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
dl
) (DigestError
-> Excepts '[GPGError, DigestError, DownloadFailed] m FilePath)
-> Excepts '[GPGError, DigestError, DownloadFailed] m FilePath
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m FilePath
forall e (es' :: [*]) (es'' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, e :< es, LiftVariant (Remove e es) es',
LiftVariant es'' es') =>
(e -> Excepts es'' m a) -> Excepts es m a -> Excepts es' m a
`catchE` Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
-> Excepts '[GPGError, DigestError, DownloadFailed] m FilePath
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE @'[GPGError, DigestError , DownloadFailed] Excepts '[DigestError, DownloadFailed, GPGError] m FilePath
dl
| Bool
otherwise = ()
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ensureDirectories :: Dirs -> IO ()
ensureDirectories :: Dirs -> IO ()
ensureDirectories (Dirs FilePath
baseDir FilePath
binDir FilePath
cacheDir FilePath
logsDir FilePath
confDir FilePath
trashDir) = do
FilePath -> IO ()
createDirRecursive' FilePath
baseDir
FilePath -> IO ()
createDirRecursive' (FilePath
baseDir FilePath -> FilePath -> FilePath
</> FilePath
"ghc")
FilePath -> IO ()
createDirRecursive' FilePath
binDir
FilePath -> IO ()
createDirRecursive' FilePath
cacheDir
FilePath -> IO ()
createDirRecursive' FilePath
logsDir
FilePath -> IO ()
createDirRecursive' FilePath
confDir
FilePath -> IO ()
createDirRecursive' FilePath
trashDir
() -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
ghcBinaryName :: GHCTargetVersion -> String
ghcBinaryName :: GHCTargetVersion -> FilePath
ghcBinaryName (GHCTargetVersion (Just Text
t) Version
_) = Text -> FilePath
T.unpack (Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-ghc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
exeExt)
ghcBinaryName (GHCTargetVersion Maybe Text
Nothing Version
_) = Text -> FilePath
T.unpack (Text
"ghc" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
exeExt)
installDestSanityCheck :: ( MonadIO m
, MonadCatch m
) =>
InstallDirResolved ->
Excepts '[DirNotEmpty] m ()
installDestSanityCheck :: InstallDirResolved -> Excepts '[DirNotEmpty] m ()
installDestSanityCheck (IsolateDirResolved FilePath
isoDir) = do
[IOErrorType]
-> () -> Excepts '[DirNotEmpty] m () -> Excepts '[DirNotEmpty] m ()
forall (m :: * -> *) a.
(MonadIO m, MonadCatch m) =>
[IOErrorType] -> a -> m a -> m a
hideErrorDef [IOErrorType
doesNotExistErrorType] () (Excepts '[DirNotEmpty] m () -> Excepts '[DirNotEmpty] m ())
-> Excepts '[DirNotEmpty] m () -> Excepts '[DirNotEmpty] m ()
forall a b. (a -> b) -> a -> b
$ do
[FilePath]
contents <- IO [FilePath] -> Excepts '[DirNotEmpty] m [FilePath]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [FilePath] -> Excepts '[DirNotEmpty] m [FilePath])
-> IO [FilePath] -> Excepts '[DirNotEmpty] m [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContentsRecursive FilePath
isoDir
Bool -> Excepts '[DirNotEmpty] m () -> Excepts '[DirNotEmpty] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
contents) (DirNotEmpty -> Excepts '[DirNotEmpty] m ()
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (DirNotEmpty -> Excepts '[DirNotEmpty] m ())
-> DirNotEmpty -> Excepts '[DirNotEmpty] m ()
forall a b. (a -> b) -> a -> b
$ FilePath -> DirNotEmpty
DirNotEmpty FilePath
isoDir)
installDestSanityCheck InstallDirResolved
_ = () -> Excepts '[DirNotEmpty] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()