{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
module GHCup.Utils
( module GHCup.Utils.Dirs
, module GHCup.Utils
)
where
#if defined(IS_WINDOWS)
import GHCup.Download
#endif
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 ) )
#if defined(IS_WINDOWS)
import Data.Bits
#endif
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
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
#if defined(IS_WINDOWS)
import System.Win32.Console
import System.Win32.File hiding ( copyFile )
import System.Win32.Types
#endif
import Text.PrettyPrint.HughesPJClass hiding ( (<>) )
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
ghcLinkDestination :: ( MonadReader env m
, HasDirs env
, MonadThrow m, MonadIO m)
=> FilePath
-> GHCTargetVersion
-> m FilePath
ghcLinkDestination :: FilePath -> GHCTargetVersion -> m FilePath
ghcLinkDestination FilePath
tool GHCTargetVersion
ver = 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
forall env (m :: * -> *).
(MonadReader env m, LabelOptic' "dirs" A_Lens env Dirs) =>
m Dirs
getDirs
FilePath
ghcd <- 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 -> FilePath -> FilePath
relativeSymlink FilePath
binDir (FilePath
ghcd FilePath -> FilePath -> FilePath
</> FilePath
"bin" FilePath -> FilePath -> FilePath
</> FilePath
tool))
rmMinorSymlinks :: ( MonadReader env m
, HasDirs env
, MonadIO m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadMask m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMinorSymlinks :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorSymlinks 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
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]
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
rmPlain :: ( MonadReader env m
, HasDirs env
, HasLog env
, MonadThrow m
, MonadFail m
, MonadIO m
, MonadMask m
)
=> Maybe Text
-> Excepts '[NotInstalled] m ()
rmPlain :: Maybe Text -> Excepts '[NotInstalled] m ()
rmPlain 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
rmMajorSymlinks :: ( MonadReader env m
, HasDirs env
, MonadIO m
, HasLog env
, MonadThrow m
, MonadFail m
, MonadMask m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMajorSymlinks :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorSymlinks 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
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 Char -> Parsec Void Text Text
forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 Parsec Void Text Char
ghcSubPath
Char
_ <- Parsec Void Text Char
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 Char -> Parsec Void Text GHCTargetVersion
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* 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 Char
ghcSubPath = Parsec Void Text Char
pathSep Parsec Void Text Char
-> Parsec Void Text Text -> Parsec Void Text Char
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 Char
-> Parsec Void Text Char -> Parsec Void Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 Char
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 Char -> Parsec Void Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Char
pathSep
stripAbsolutePath :: ParsecT Void Text Identity FilePath
stripAbsolutePath = Parsec Void Text Char
pathSep Parsec Void Text Char
-> 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 Char -> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text Char -> Parsec Void Text Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text Char
stripPathComponet)
stripRelativePath :: ParsecT Void Text Identity FilePath
stripRelativePath = Parsec Void Text Char -> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text Char -> Parsec Void Text Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text Char
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)
)
[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
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 Char
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 Char -> Parsec Void Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Char
pathSep
stripAbsolutePath :: ParsecT Void Text Identity FilePath
stripAbsolutePath = Parsec Void Text Char
pathSep Parsec Void Text Char
-> 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 Char -> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text Char -> Parsec Void Text Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text Char
stripPathComponet)
stripRelativePath :: ParsecT Void Text Identity FilePath
stripRelativePath = Parsec Void Text Char -> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text Char -> Parsec Void Text Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text Char
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
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 Char
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 Char -> Parsec Void Text Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Char
pathSep
stripAbsolutePath :: ParsecT Void Text Identity FilePath
stripAbsolutePath = Parsec Void Text Char
pathSep Parsec Void Text Char
-> 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 Char -> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text Char -> Parsec Void Text Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text Char
stripPathComponet)
stripRelativePath :: ParsecT Void Text Identity FilePath
stripRelativePath = Parsec Void Text Char -> ParsecT Void Text Identity FilePath
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text Char -> Parsec Void Text Char
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text Char
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
)
)
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)
hlsSymlinks :: (MonadReader env m, HasDirs env, MonadIO m, MonadCatch m) => m [FilePath]
hlsSymlinks :: m [FilePath]
hlsSymlinks = 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]
oldSyms <- 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)
)
(FilePath -> m Bool) -> [FilePath] -> m [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM
( IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO Bool -> m Bool) -> (FilePath -> IO Bool) -> FilePath -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
pathIsLink
(FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
binDir FilePath -> FilePath -> FilePath
</>)
)
[FilePath]
oldSyms
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, Maybe Text)]
ghcs' = [Maybe (PVP, Maybe Text)] -> [(PVP, Maybe Text)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PVP, Maybe Text)] -> [(PVP, Maybe Text)])
-> [Maybe (PVP, Maybe Text)] -> [(PVP, Maybe Text)]
forall a b. (a -> b) -> a -> b
$ ((GHCTargetVersion -> Maybe (PVP, Maybe Text))
-> [GHCTargetVersion] -> [Maybe (PVP, Maybe Text)])
-> [GHCTargetVersion]
-> (GHCTargetVersion -> Maybe (PVP, Maybe Text))
-> [Maybe (PVP, Maybe Text)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (GHCTargetVersion -> Maybe (PVP, Maybe Text))
-> [GHCTargetVersion] -> [Maybe (PVP, Maybe Text)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [GHCTargetVersion]
ghcs ((GHCTargetVersion -> Maybe (PVP, Maybe Text))
-> [Maybe (PVP, Maybe Text)])
-> (GHCTargetVersion -> Maybe (PVP, Maybe Text))
-> [Maybe (PVP, 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_ <- Version -> Maybe PVP
forall (m :: * -> *). MonadThrow m => Version -> m PVP
versionToPVP Version
_tvVersion
(PVP, Maybe Text) -> Maybe (PVP, Maybe Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PVP
pvp_, Maybe Text
_tvTarget)
PVP
-> [(PVP, Maybe Text)] -> Maybe Text -> m (Maybe GHCTargetVersion)
forall (m :: * -> *).
MonadThrow m =>
PVP
-> [(PVP, Maybe Text)] -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForPVP' PVP
pvpIn [(PVP, Maybe Text)]
ghcs' Maybe Text
mt
getGHCForPVP' :: MonadThrow m
=> PVP
-> [(PVP, Maybe Text)]
-> Maybe Text
-> m (Maybe GHCTargetVersion)
getGHCForPVP' :: PVP
-> [(PVP, Maybe Text)] -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForPVP' PVP
pvpIn [(PVP, Maybe Text)]
ghcs' Maybe Text
mt = do
let mResult :: Maybe (PVP, Maybe Text)
mResult = [(PVP, Maybe Text)] -> Maybe (PVP, Maybe Text)
forall a. [a] -> Maybe a
lastMay
([(PVP, Maybe Text)] -> Maybe (PVP, Maybe Text))
-> ([(PVP, Maybe Text)] -> [(PVP, Maybe Text)])
-> [(PVP, Maybe Text)]
-> Maybe (PVP, Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PVP, Maybe Text) -> (PVP, Maybe Text) -> Ordering)
-> [(PVP, Maybe Text)] -> [(PVP, Maybe Text)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\(PVP
x, Maybe Text
_) (PVP
y, Maybe Text
_) -> PVP -> PVP -> Ordering
forall a. Ord a => a -> a -> Ordering
compare PVP
x PVP
y)
([(PVP, Maybe Text)] -> [(PVP, Maybe Text)])
-> ([(PVP, Maybe Text)] -> [(PVP, Maybe Text)])
-> [(PVP, Maybe Text)]
-> [(PVP, Maybe Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PVP, Maybe Text) -> Bool)
-> [(PVP, Maybe Text)] -> [(PVP, Maybe Text)]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\(PVP
pvp_, 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, Maybe Text)] -> Maybe (PVP, Maybe Text))
-> [(PVP, Maybe Text)] -> Maybe (PVP, Maybe Text)
forall a b. (a -> b) -> a -> b
$ [(PVP, Maybe Text)]
ghcs'
Maybe (PVP, Maybe Text)
-> ((PVP, 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, Maybe Text)
mResult (((PVP, Maybe Text) -> m GHCTargetVersion)
-> m (Maybe GHCTargetVersion))
-> ((PVP, Maybe Text) -> m GHCTargetVersion)
-> m (Maybe GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ \(PVP
pvp_, Maybe Text
target) -> do
Version
ver' <- PVP -> m Version
forall (m :: * -> *). MonadThrow m => PVP -> m Version
pvpToVersion PVP
pvp_
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, VersionInfo)]
ps = [Maybe (PVP, VersionInfo)] -> [(PVP, VersionInfo)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (PVP, VersionInfo)] -> [(PVP, VersionInfo)])
-> [Maybe (PVP, VersionInfo)] -> [(PVP, VersionInfo)]
forall a b. (a -> b) -> a -> b
$ ((Version, VersionInfo) -> Maybe (PVP, VersionInfo))
-> [(Version, VersionInfo)] -> [Maybe (PVP, VersionInfo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Version
v, VersionInfo
vi) -> (,VersionInfo
vi) (PVP -> (PVP, VersionInfo))
-> Maybe PVP -> Maybe (PVP, VersionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Version -> Maybe PVP
forall (m :: * -> *). MonadThrow m => Version -> m PVP
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, VersionInfo)] -> Maybe (PVP, VersionInfo))
-> [(PVP, VersionInfo)]
-> m (Maybe (PVP, VersionInfo))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PVP, VersionInfo)] -> Maybe (PVP, VersionInfo)
forall a. [a] -> Maybe a
headMay ([(PVP, VersionInfo)] -> Maybe (PVP, VersionInfo))
-> ([(PVP, VersionInfo)] -> [(PVP, VersionInfo)])
-> [(PVP, VersionInfo)]
-> Maybe (PVP, VersionInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PVP, VersionInfo) -> Bool)
-> [(PVP, VersionInfo)] -> [(PVP, VersionInfo)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(PVP
v, VersionInfo
_) -> PVP -> PVP -> Bool
matchPVPrefix PVP
pvpIn PVP
v) ([(PVP, VersionInfo)] -> m (Maybe (PVP, VersionInfo)))
-> [(PVP, VersionInfo)] -> m (Maybe (PVP, VersionInfo))
forall a b. (a -> b) -> a -> b
$ [(PVP, 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 = ByteString -> ByteString
Lzma.decompress 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 = ByteString -> ByteString
Lzma.decompress 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
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
ghcdir <- m FilePath -> Excepts '[NotInstalled] m FilePath
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m FilePath -> Excepts '[NotInstalled] m FilePath)
-> m FilePath -> Excepts '[NotInstalled] m FilePath
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m FilePath
forall env (m :: * -> *).
(MonadReader env m, HasDirs env, MonadThrow m) =>
GHCTargetVersion -> m FilePath
ghcupGHCDir GHCTargetVersion
ver
let bindir :: FilePath
bindir = FilePath
ghcdir FilePath -> FilePath -> FilePath
</> FilePath
"bin"
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
$ IO Bool -> Excepts '[NotInstalled] m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Excepts '[NotInstalled] m Bool)
-> IO Bool -> Excepts '[NotInstalled] m Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
ghcdir)
(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
, 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, 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
[FilePath]
patches <- (([FilePath] -> [FilePath])
-> Excepts '[PatchFailed] m [FilePath]
-> Excepts '[PatchFailed] m [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([FilePath] -> [FilePath])
-> Excepts '[PatchFailed] m [FilePath]
-> Excepts '[PatchFailed] m [FilePath])
-> ((FilePath -> FilePath) -> [FilePath] -> [FilePath])
-> (FilePath -> FilePath)
-> Excepts '[PatchFailed] m [FilePath]
-> Excepts '[PatchFailed] m [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
</>) (Excepts '[PatchFailed] m [FilePath]
-> Excepts '[PatchFailed] m [FilePath])
-> Excepts '[PatchFailed] m [FilePath]
-> Excepts '[PatchFailed] m [FilePath]
forall a b. (a -> b) -> a -> b
$ 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
$ 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)
)
[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] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort [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' -> 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
"-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 :: ( Pretty (V e)
, Show (V e)
, PopVariant BuildFailed e
, ToVariantMaybe BuildFailed e
, 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 '[BuildFailed] m a
runBuildAction :: FilePath
-> Maybe FilePath -> Excepts e m a -> Excepts '[BuildFailed] m a
runBuildAction FilePath
bdir Maybe FilePath
instdir Excepts e m a
action = do
Settings {Bool
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:cache:Settings :: Settings -> Bool
noColor :: Bool
gpgSetting :: GPGSetting
noNetwork :: Bool
urlSource :: URLSource
verbose :: Bool
downloader :: Downloader
keepDirs :: KeepDirs
noVerify :: Bool
cache :: Bool
..} <- m Settings -> Excepts '[BuildFailed] 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 :: Excepts '[BuildFailed] m ()
exAction = do
Maybe FilePath
-> (FilePath -> Excepts '[BuildFailed] m ())
-> Excepts '[BuildFailed] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe FilePath
instdir ((FilePath -> Excepts '[BuildFailed] m ())
-> Excepts '[BuildFailed] m ())
-> (FilePath -> Excepts '[BuildFailed] m ())
-> Excepts '[BuildFailed] m ()
forall a b. (a -> b) -> a -> b
$ \FilePath
dir ->
m () -> Excepts '[BuildFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[BuildFailed] m ())
-> m () -> Excepts '[BuildFailed] 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, MonadReader env m, HasDirs env, MonadMask m) =>
FilePath -> m ()
recyclePathForcibly FilePath
dir
Bool -> Excepts '[BuildFailed] m () -> Excepts '[BuildFailed] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (KeepDirs
keepDirs KeepDirs -> KeepDirs -> Bool
forall a. Eq a => a -> a -> Bool
== KeepDirs
Never)
(Excepts '[BuildFailed] m () -> Excepts '[BuildFailed] m ())
-> Excepts '[BuildFailed] m () -> Excepts '[BuildFailed] m ()
forall a b. (a -> b) -> a -> b
$ m () -> Excepts '[BuildFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[BuildFailed] m ())
-> m () -> Excepts '[BuildFailed] 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 '[BuildFailed] m a
-> Excepts '[BuildFailed] m () -> Excepts '[BuildFailed] m a)
-> Excepts '[BuildFailed] m ()
-> Excepts '[BuildFailed] m a
-> Excepts '[BuildFailed] m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Excepts '[BuildFailed] m a
-> Excepts '[BuildFailed] m () -> Excepts '[BuildFailed] m a
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
onException Excepts '[BuildFailed] m ()
exAction
(Excepts '[BuildFailed] m a -> Excepts '[BuildFailed] m a)
-> Excepts '[BuildFailed] m a -> Excepts '[BuildFailed] m a
forall a b. (a -> b) -> a -> b
$ (V e -> Excepts '[BuildFailed] m a)
-> Excepts e m a -> Excepts '[BuildFailed] m a
forall (m :: * -> *) (es :: [*]) (es' :: [*]) a.
Monad m =>
(V es -> Excepts es' m a) -> Excepts es m a -> Excepts es' m a
catchAllE
(\V e
es -> do
Excepts '[BuildFailed] m ()
exAction
BuildFailed -> Excepts '[BuildFailed] m a
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (FilePath -> V e -> BuildFailed
forall (es :: [*]).
(ToVariantMaybe BuildFailed es, PopVariant BuildFailed es,
Pretty (V es), Show (V es)) =>
FilePath -> V es -> BuildFailed
BuildFailed FilePath
bdir V e
es)
) Excepts e m a
action
Bool -> Excepts '[BuildFailed] m () -> Excepts '[BuildFailed] 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 '[BuildFailed] m () -> Excepts '[BuildFailed] m ())
-> Excepts '[BuildFailed] m () -> Excepts '[BuildFailed] m ()
forall a b. (a -> b) -> a -> b
$ m () -> Excepts '[BuildFailed] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[BuildFailed] m ())
-> m () -> Excepts '[BuildFailed] 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 '[BuildFailed] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
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
#if defined(IS_WINDOWS)
exeExt = ".exe"
#else
exeExt :: FilePath
exeExt = FilePath
""
#endif
exeExt' :: ByteString
#if defined(IS_WINDOWS)
exeExt' = ".exe"
#else
exeExt' :: ByteString
exeExt' = ByteString
""
#endif
enableAnsiSupport :: IO (Either String Bool)
#if defined(IS_WINDOWS)
enableAnsiSupport = handleIO (pure . Left . displayException) $ do
h <- createFile "CONOUT$" (gENERIC_WRITE .|. gENERIC_READ)
fILE_SHARE_WRITE Nothing oPEN_EXISTING 0 Nothing
when (h == iNVALID_HANDLE_VALUE ) $ fail "invalid handle value"
m <- getConsoleMode h
if ((m .&. eNABLE_VIRTUAL_TERMINAL_PROCESSING) == 0)
then setConsoleMode h (m .|. eNABLE_VIRTUAL_TERMINAL_PROCESSING)
>> pure (Right False)
else pure (Right True)
#else
enableAnsiSupport :: IO (Either FilePath Bool)
enableAnsiSupport = Either FilePath Bool -> IO (Either FilePath Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Either FilePath Bool
forall a b. b -> Either a b
Right Bool
True)
#endif
getLinkTarget :: FilePath -> IO FilePath
getLinkTarget :: FilePath -> IO FilePath
getLinkTarget FilePath
fp = do
#if defined(IS_WINDOWS)
content <- readFile (dropExtension fp <.> "shim")
[p] <- pure . filter ("path = " `isPrefixOf`) . lines $ content
pure $ stripNewline $ dropPrefix "path = " p
#else
FilePath -> IO FilePath
getSymbolicLinkTarget FilePath
fp
#endif
pathIsLink :: FilePath -> IO Bool
#if defined(IS_WINDOWS)
pathIsLink fp = doesPathExist (dropExtension fp <.> "shim")
#else
pathIsLink :: FilePath -> IO Bool
pathIsLink = FilePath -> IO Bool
pathIsSymbolicLink
#endif
rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m ()
#if defined(IS_WINDOWS)
rmLink fp = do
hideError doesNotExistErrorType . recycleFile $ fp
hideError doesNotExistErrorType . recycleFile $ (dropExtension fp <.> "shim")
#else
rmLink :: FilePath -> m ()
rmLink = 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
#endif
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 = do
#if defined(IS_WINDOWS)
dirs <- getDirs
let shimGen = cacheDir dirs </> "gs.exe"
let shim = dropExtension exe <.> "shim"
fullLink = takeDirectory exe </> link
shimContents = "path = " <> fullLink
logDebug $ "rm -f " <> T.pack exe
rmLink exe
logDebug $ "ln -s " <> T.pack fullLink <> " " <> T.pack exe
liftIO $ copyFile shimGen exe
liftIO $ writeFile shim shimContents
#else
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
#endif
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 = do
#if defined(IS_WINDOWS)
(GHCupInfo _ _ gTools) <- lift getGHCupInfo
dirs <- lift getDirs
shimDownload <- liftE $ lE @_ @'[NoDownload]
$ maybe (Left NoDownload) Right $ Map.lookup ShimGen gTools
let dl = downloadCached' shimDownload (Just "gs.exe") Nothing
void $ (\(DigestError _ _ _) -> do
lift $ logWarn "Digest doesn't match, redownloading gs.exe..."
lift $ logDebug ("rm -f " <> T.pack (cacheDir dirs </> "gs.exe"))
lift $ hideError doesNotExistErrorType $ recycleFile (cacheDir dirs </> "gs.exe")
liftE @'[GPGError, DigestError , DownloadFailed] $ dl
) `catchE` (liftE @'[GPGError, DigestError , DownloadFailed] dl)
pure ()
#else
()
-> Excepts
'[GPGError, DigestError, DownloadFailed, NoDownload] m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
#endif
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
v') = 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
<> Version -> Text
prettyVer Version
v' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
exeExt)
ghcBinaryName (GHCTargetVersion Maybe Text
Nothing Version
v') = Text -> FilePath
T.unpack (Text
"ghc-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
v' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Text
T.pack FilePath
exeExt)