{-# 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
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.MegaParsec
import GHCup.Utils.Prelude
import GHCup.Utils.String.QQ
#if !defined(TAR)
import Codec.Archive hiding ( Directory )
#endif
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.Logger
import Control.Monad.Reader
import Data.ByteString ( ByteString )
import Data.Either
import Data.Foldable
import Data.List
import Data.List.NonEmpty ( NonEmpty( (:|) ))
import Data.List.Split
import Data.Maybe
import Data.String.Interpolate
import Data.Text ( Text )
import Data.Versions
import Data.Word8
import GHC.IO.Exception
import HPath
import HPath.IO hiding ( hideError )
import Haskus.Utils.Variant.Excepts
import Optics
import Prelude hiding ( abs
, readFile
, writeFile
)
import Safe
import System.IO.Error
import System.Posix.FilePath ( getSearchPath
, takeFileName
)
import System.Posix.Files.ByteString ( readSymbolicLink )
import Text.Regex.Posix
import URI.ByteString
#if defined(TAR)
import qualified Codec.Archive.Tar as Tar
#endif
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 as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map.Strict as Map
#if !defined(TAR)
import qualified Data.Text as T
#endif
import qualified Data.Text.Encoding as E
import qualified Text.Megaparsec as MP
ghcLinkDestination :: (MonadReader AppState m, MonadThrow m, MonadIO m)
=> ByteString
-> GHCTargetVersion
-> m ByteString
ghcLinkDestination :: ByteString -> GHCTargetVersion -> m ByteString
ghcLinkDestination ByteString
tool GHCTargetVersion
ver = do
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
..} } <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
Path Rel
t <- ByteString -> m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel ByteString
tool
Path Abs
ghcd <- GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
ghcupGHCDir GHCTargetVersion
ver
ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs -> Path Abs -> ByteString
relativeSymlink Path Abs
binDir (Path Abs
ghcd Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|bin|] Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
t))
rmMinorSymlinks :: ( MonadReader AppState m
, MonadIO m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader AppState m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMinorSymlinks :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMinorSymlinks tv :: GHCTargetVersion
tv@GHCTargetVersion{Maybe Text
Version
_tvVersion :: GHCTargetVersion -> Version
_tvTarget :: GHCTargetVersion -> Maybe Text
_tvVersion :: Version
_tvTarget :: Maybe Text
..} = do
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
[Path Rel]
files <- Excepts '[NotInstalled] m [Path Rel]
-> Excepts '[NotInstalled] m [Path Rel]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m [Path Rel]
-> Excepts '[NotInstalled] m [Path Rel])
-> Excepts '[NotInstalled] m [Path Rel]
-> Excepts '[NotInstalled] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel]
ghcToolFiles GHCTargetVersion
tv
[Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
files ((Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> do
Path Rel
f_xyz <- IO (Path Rel) -> Excepts '[NotInstalled] m (Path Rel)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Rel) -> Excepts '[NotInstalled] m (Path Rel))
-> IO (Path Rel) -> Excepts '[NotInstalled] m (Path Rel)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
f ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton Word8
_hyphen ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Version -> ByteString
verToBS Version
_tvVersion)
let fullF :: Path Abs
fullF = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath fullF}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
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
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
fullF
rmPlain :: ( MonadReader AppState m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadIO m
)
=> Maybe Text
-> Excepts '[NotInstalled] m ()
rmPlain :: Maybe Text -> Excepts '[NotInstalled] m ()
rmPlain Maybe Text
target = do
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
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 (m :: * -> *).
(MonadReader AppState m, 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
[Path Rel]
files <- Excepts '[NotInstalled] m [Path Rel]
-> Excepts '[NotInstalled] m [Path Rel]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m [Path Rel]
-> Excepts '[NotInstalled] m [Path Rel])
-> Excepts '[NotInstalled] m [Path Rel]
-> Excepts '[NotInstalled] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel]
ghcToolFiles GHCTargetVersion
tv
[Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
files ((Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> do
let fullF :: Path Abs
fullF = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
f
m () -> Excepts '[NotInstalled] m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NotInstalled] m ())
-> m () -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath fullF}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
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
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
fullF
let hdc_file :: Path Abs
hdc_file = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|haddock-ghc|]
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath hdc_file}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
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
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
hdc_file
rmMajorSymlinks :: ( MonadReader AppState m
, MonadIO m
, MonadLogger m
, MonadThrow m
, MonadFail m
, MonadReader AppState m
)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m ()
rmMajorSymlinks :: GHCTargetVersion -> Excepts '[NotInstalled] m ()
rmMajorSymlinks tv :: GHCTargetVersion
tv@GHCTargetVersion{Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
_tvVersion :: GHCTargetVersion -> Version
_tvTarget :: GHCTargetVersion -> Maybe Text
..} = do
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState -> Excepts '[NotInstalled] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
(Int
mj, Int
mi) <- Version -> Excepts '[NotInstalled] m CharPos
forall (m :: * -> *). MonadThrow m => Version -> m CharPos
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
[Path Rel]
files <- Excepts '[NotInstalled] m [Path Rel]
-> Excepts '[NotInstalled] m [Path Rel]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[NotInstalled] m [Path Rel]
-> Excepts '[NotInstalled] m [Path Rel])
-> Excepts '[NotInstalled] m [Path Rel]
-> Excepts '[NotInstalled] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m) =>
GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel]
ghcToolFiles GHCTargetVersion
tv
[Path Rel]
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Path Rel]
files ((Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ())
-> (Path Rel -> Excepts '[NotInstalled] m ())
-> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> do
Path Rel
f_xyz <- IO (Path Rel) -> Excepts '[NotInstalled] m (Path Rel)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Path Rel) -> Excepts '[NotInstalled] m (Path Rel))
-> IO (Path Rel) -> Excepts '[NotInstalled] m (Path Rel)
forall a b. (a -> b) -> a -> b
$ ByteString -> IO (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
f ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word8 -> ByteString
B.singleton Word8
_hyphen ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Text -> ByteString
E.encodeUtf8 Text
v')
let fullF :: Path Abs
fullF = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) [i|rm -f #{toFilePath fullF}|]
IO () -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[NotInstalled] m ())
-> IO () -> Excepts '[NotInstalled] m ()
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
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteFile Path Abs
fullF
ghcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
ghcInstalled :: GHCTargetVersion -> m Bool
ghcInstalled GHCTargetVersion
ver = do
Path Abs
ghcdir <- GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
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
$ Path Abs -> IO Bool
forall b. Path b -> IO Bool
doesDirectoryExist Path Abs
ghcdir
ghcSrcInstalled :: (MonadIO m, MonadReader AppState m, MonadThrow m) => GHCTargetVersion -> m Bool
ghcSrcInstalled :: GHCTargetVersion -> m Bool
ghcSrcInstalled GHCTargetVersion
ver = do
Path Abs
ghcdir <- GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
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
$ Path Abs -> IO Bool
forall b. Path b -> IO Bool
doesFileExist (Path Abs
ghcdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
ghcUpSrcBuiltFile)
ghcSet :: (MonadReader AppState m, MonadThrow m, MonadIO m)
=> Maybe Text
-> m (Maybe GHCTargetVersion)
ghcSet :: Maybe Text -> m (Maybe GHCTargetVersion)
ghcSet Maybe Text
mtarget = do
AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
Path Rel
ghc <- ByteString -> m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString -> m (Path Rel)) -> ByteString -> m (Path Rel)
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 (Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"ghc" (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-ghc") Maybe Text
mtarget)
let ghcBin :: Path Abs
ghcBin = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
ghc
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
ByteString
link <- ByteString -> IO ByteString
readSymbolicLink (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
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
<$> ByteString -> IO GHCTargetVersion
forall (m :: * -> *).
MonadThrow m =>
ByteString -> m GHCTargetVersion
ghcLinkVersion ByteString
link
ghcLinkVersion :: MonadThrow m => ByteString -> m GHCTargetVersion
ghcLinkVersion :: ByteString -> m GHCTargetVersion
ghcLinkVersion ByteString
bs = do
Text
t <- Either UnicodeException Text -> m Text
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either UnicodeException Text -> m Text)
-> Either UnicodeException Text -> m Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
E.decodeUtf8' ByteString
bs
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
-> String
-> Text
-> Either (ParseErrorBundle Text Void) GHCTargetVersion
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text GHCTargetVersion
parser String
"ghcLinkVersion" Text
t
where
parser :: Parsec Void Text GHCTargetVersion
parser =
(do
Text
_ <- Parsec Void Text Text -> Parsec Void Text Text
forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 (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/")
Text
_ <- 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/"
Text
r <- Parsec Void Text Text -> Parsec Void Text Text
forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 (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
"/")
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 Text -> Parsec Void Text GHCTargetVersion
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
"/"
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
getInstalledGHCs :: (MonadReader AppState m, MonadIO m) => m [Either (Path Rel) GHCTargetVersion]
getInstalledGHCs :: m [Either (Path Rel) GHCTargetVersion]
getInstalledGHCs = do
Path Abs
ghcdir <- m (Path Abs)
forall (m :: * -> *). MonadReader AppState m => m (Path Abs)
ghcupGHCBaseDir
[Path Rel]
fs <- IO [Path Rel] -> m [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel] -> m [Path Rel]) -> IO [Path Rel] -> m [Path Rel]
forall a b. (a -> b) -> a -> b
$ [IOErrorType] -> [Path Rel] -> IO [Path Rel] -> IO [Path Rel]
forall a. [IOErrorType] -> a -> IO a -> IO a
hideErrorDef [IOErrorType
NoSuchThing] [] (IO [Path Rel] -> IO [Path Rel]) -> IO [Path Rel] -> IO [Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO [Path Rel]
forall b. Path b -> IO [Path Rel]
getDirsFiles' Path Abs
ghcdir
[Path Rel]
-> (Path Rel -> m (Either (Path Rel) GHCTargetVersion))
-> m [Either (Path Rel) GHCTargetVersion]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path Rel]
fs ((Path Rel -> m (Either (Path Rel) GHCTargetVersion))
-> m [Either (Path Rel) GHCTargetVersion])
-> (Path Rel -> m (Either (Path Rel) GHCTargetVersion))
-> m [Either (Path Rel) GHCTargetVersion]
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> case Path Rel -> Either SomeException GHCTargetVersion
forall (m :: * -> *).
MonadThrow m =>
Path Rel -> m GHCTargetVersion
parseGHCupGHCDir Path Rel
f of
Right GHCTargetVersion
r -> Either (Path Rel) GHCTargetVersion
-> m (Either (Path Rel) GHCTargetVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Rel) GHCTargetVersion
-> m (Either (Path Rel) GHCTargetVersion))
-> Either (Path Rel) GHCTargetVersion
-> m (Either (Path Rel) GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> Either (Path Rel) GHCTargetVersion
forall a b. b -> Either a b
Right GHCTargetVersion
r
Left SomeException
_ -> Either (Path Rel) GHCTargetVersion
-> m (Either (Path Rel) GHCTargetVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Rel) GHCTargetVersion
-> m (Either (Path Rel) GHCTargetVersion))
-> Either (Path Rel) GHCTargetVersion
-> m (Either (Path Rel) GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ Path Rel -> Either (Path Rel) GHCTargetVersion
forall a b. a -> Either a b
Left Path Rel
f
getInstalledCabals :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
=> m [Either (Path Rel) Version]
getInstalledCabals :: m [Either (Path Rel) Version]
getInstalledCabals = do
Maybe Version
cs <- m (Maybe Version)
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m,
MonadCatch m) =>
m (Maybe Version)
cabalSet
Maybe Version -> m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) =>
Maybe Version -> m [Either (Path Rel) Version]
getInstalledCabals' Maybe Version
cs
getInstalledCabals' :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m)
=> Maybe Version
-> m [Either (Path Rel) Version]
getInstalledCabals' :: Maybe Version -> m [Either (Path Rel) Version]
getInstalledCabals' Maybe Version
cs = do
AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
[Path Rel]
bins <- IO [Path Rel] -> m [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel] -> m [Path Rel]) -> IO [Path Rel] -> m [Path Rel]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [Path Rel]) -> IO [Path Rel] -> IO [Path Rel]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [Path Rel] -> IO [Path Rel]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [Path Rel] -> IO [Path Rel]) -> IO [Path Rel] -> IO [Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> Regex -> IO [Path Rel]
findFiles
Path Abs
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 (Path Rel) Version]
vs <- [Path Rel]
-> (Path Rel -> m (Either (Path Rel) Version))
-> m [Either (Path Rel) Version]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path Rel]
bins ((Path Rel -> m (Either (Path Rel) Version))
-> m [Either (Path Rel) Version])
-> (Path Rel -> m (Either (Path Rel) Version))
-> m [Either (Path Rel) Version]
forall a b. (a -> b) -> a -> b
$ \Path Rel
f -> case (ByteString -> Either (ParseErrorBundle Text Void) Version)
-> Maybe ByteString
-> Maybe (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)
-> (ByteString -> Text)
-> ByteString
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe) (Maybe ByteString
-> Maybe (Either (ParseErrorBundle Text Void) Version))
-> (Path Rel -> Maybe ByteString)
-> Path Rel
-> Maybe (Either (ParseErrorBundle Text Void) Version)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Maybe ByteString
B.stripPrefix ByteString
"cabal-" (ByteString -> Maybe ByteString)
-> (Path Rel -> ByteString) -> Path Rel -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Rel -> Maybe (Either (ParseErrorBundle Text Void) Version))
-> Path Rel -> Maybe (Either (ParseErrorBundle Text Void) Version)
forall a b. (a -> b) -> a -> b
$ Path Rel
f of
Just (Right Version
r) -> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Rel) Version -> m (Either (Path Rel) Version))
-> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall a b. (a -> b) -> a -> b
$ Version -> Either (Path Rel) Version
forall a b. b -> Either a b
Right Version
r
Just (Left ParseErrorBundle Text Void
_) -> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Rel) Version -> m (Either (Path Rel) Version))
-> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall a b. (a -> b) -> a -> b
$ Path Rel -> Either (Path Rel) Version
forall a b. a -> Either a b
Left Path Rel
f
Maybe (Either (ParseErrorBundle Text Void) Version)
Nothing -> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Rel) Version -> m (Either (Path Rel) Version))
-> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall a b. (a -> b) -> a -> b
$ Path Rel -> Either (Path Rel) Version
forall a b. a -> Either a b
Left Path Rel
f
[Either (Path Rel) Version] -> m [Either (Path Rel) Version]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either (Path Rel) Version] -> m [Either (Path Rel) Version])
-> [Either (Path Rel) Version] -> m [Either (Path Rel) Version]
forall a b. (a -> b) -> a -> b
$ [Either (Path Rel) Version]
-> (Version -> [Either (Path Rel) Version])
-> Maybe Version
-> [Either (Path Rel) Version]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Either (Path Rel) Version]
vs (\Version
x -> [Either (Path Rel) Version] -> [Either (Path Rel) Version]
forall a. Eq a => [a] -> [a]
nub ([Either (Path Rel) Version] -> [Either (Path Rel) Version])
-> [Either (Path Rel) Version] -> [Either (Path Rel) Version]
forall a b. (a -> b) -> a -> b
$ Version -> Either (Path Rel) Version
forall a b. b -> Either a b
Right Version
xEither (Path Rel) Version
-> [Either (Path Rel) Version] -> [Either (Path Rel) Version]
forall a. a -> [a] -> [a]
:[Either (Path Rel) Version]
vs) Maybe Version
cs
cabalInstalled :: (MonadLogger m, MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
cabalInstalled :: Version -> m Bool
cabalInstalled Version
ver = do
[Version]
vers <- ([Either (Path Rel) Version] -> [Version])
-> m [Either (Path Rel) Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadLogger m, MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) 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 :: (MonadLogger m, MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
cabalSet :: m (Maybe Version)
cabalSet = do
AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
let cabalbin :: Path Abs
cabalbin = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|cabal|]
Bool
b <- (IOException -> m Bool) -> m Bool -> m Bool
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False) (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ (FileType -> Bool) -> m FileType -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FileType -> FileType -> Bool
forall a. Eq a => a -> a -> Bool
== FileType
SymbolicLink) (m FileType -> m Bool) -> m FileType -> m Bool
forall a b. (a -> b) -> a -> b
$ IO FileType -> m FileType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FileType -> m FileType) -> IO FileType -> m FileType
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO FileType
forall b. Path b -> IO FileType
getFileType Path Abs
cabalbin
if
| Bool
b -> do
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
$ Path Abs -> IO Bool
isBrokenSymlink Path Abs
cabalbin
if Bool
broken
then do
$(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|Symlink #{cabalbin} is broken.|]
Maybe Version -> m (Maybe Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Version
forall a. Maybe a
Nothing
else do
ByteString
link <- IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ByteString
readSymbolicLink (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
cabalbin
case ByteString -> Either SomeException Version
forall (m :: * -> *). MonadThrow m => ByteString -> m Version
linkVersion ByteString
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
$(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logWarn) [i|Failed to parse cabal symlink target with: "#{err}". The symlink #{toFilePath cabalbin} 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
| Bool
otherwise -> do
Maybe CapturedProcess
mc <- IO (Maybe CapturedProcess) -> m (Maybe CapturedProcess)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CapturedProcess) -> m (Maybe CapturedProcess))
-> IO (Maybe CapturedProcess) -> m (Maybe CapturedProcess)
forall a b. (a -> b) -> a -> b
$ (IOException -> IO (Maybe CapturedProcess))
-> IO (Maybe CapturedProcess) -> IO (Maybe CapturedProcess)
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> Maybe CapturedProcess -> IO (Maybe CapturedProcess)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe CapturedProcess
forall a. Maybe a
Nothing) (IO (Maybe CapturedProcess) -> IO (Maybe CapturedProcess))
-> IO (Maybe CapturedProcess) -> IO (Maybe CapturedProcess)
forall a b. (a -> b) -> a -> b
$ (CapturedProcess -> Maybe CapturedProcess)
-> IO CapturedProcess -> IO (Maybe CapturedProcess)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CapturedProcess -> Maybe CapturedProcess
forall a. a -> Maybe a
Just (IO CapturedProcess -> IO (Maybe CapturedProcess))
-> IO CapturedProcess -> IO (Maybe CapturedProcess)
forall a b. (a -> b) -> a -> b
$ Path Abs -> [ByteString] -> Maybe (Path Abs) -> IO CapturedProcess
forall b.
Path b -> [ByteString] -> Maybe (Path Abs) -> IO CapturedProcess
executeOut
Path Abs
cabalbin
[ByteString
"--numeric-version"]
Maybe (Path Abs)
forall a. Maybe a
Nothing
(Maybe (Maybe Version) -> Maybe Version)
-> m (Maybe (Maybe Version)) -> m (Maybe Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe Version) -> Maybe Version
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (Maybe (Maybe Version)) -> m (Maybe Version))
-> m (Maybe (Maybe Version)) -> m (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Maybe CapturedProcess
-> (CapturedProcess -> m (Maybe Version))
-> m (Maybe (Maybe Version))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe CapturedProcess
mc ((CapturedProcess -> m (Maybe Version))
-> m (Maybe (Maybe Version)))
-> (CapturedProcess -> m (Maybe Version))
-> m (Maybe (Maybe Version))
forall a b. (a -> b) -> a -> b
$ \CapturedProcess
c -> if
| Bool -> Bool
not (ByteString -> Bool
B.null (CapturedProcess -> ByteString
_stdOut CapturedProcess
c)), CapturedProcess -> ExitCode
_exitCode CapturedProcess
c ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess -> do
let reportedVer :: ByteString
reportedVer = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (CapturedProcess -> (ByteString, ByteString))
-> CapturedProcess
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.spanEnd (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_lf) (ByteString -> (ByteString, ByteString))
-> (CapturedProcess -> ByteString)
-> CapturedProcess
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CapturedProcess -> ByteString
_stdOut (CapturedProcess -> ByteString) -> CapturedProcess -> ByteString
forall a b. (a -> b) -> a -> b
$ CapturedProcess
c
case Text -> Either (ParseErrorBundle Text Void) Version
version (Text -> Either (ParseErrorBundle Text Void) Version)
-> Text -> Either (ParseErrorBundle Text Void) Version
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decUTF8Safe ByteString
reportedVer of
Left ParseErrorBundle Text Void
e -> ParseErrorBundle Text Void -> m (Maybe Version)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM ParseErrorBundle Text Void
e
Right Version
r -> 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
r
| Bool
otherwise -> 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 => ByteString -> m Version
linkVersion :: ByteString -> m Version
linkVersion ByteString
bs = do
Text
t <- Either UnicodeException Text -> m Text
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either UnicodeException Text -> m Text)
-> Either UnicodeException Text -> m Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
E.decodeUtf8' ByteString
bs
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)
-> Either (ParseErrorBundle Text Void) Version -> m Version
forall a b. (a -> b) -> a -> b
$ Parsec Void Text Version
-> String -> Text -> Either (ParseErrorBundle Text Void) Version
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Version
parser String
"" Text
t
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 [Text]
stripAbsolutePath ParsecT Void Text Identity [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
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 [Text]
stripRelativePath ParsecT Void Text Identity [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
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 Text
stripPathComponet = Parsec Void Text Text -> Parsec Void Text Text
forall a. Parsec Void Text a -> Parsec Void Text Text
parseUntil1 Parsec Void Text Text
"/" Parsec Void Text Text
-> Parsec Void Text Text -> Parsec Void Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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
"/"
stripAbsolutePath :: ParsecT Void Text Identity [Text]
stripAbsolutePath = 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
"/" Parsec Void Text Text
-> ParsecT Void Text Identity [Text]
-> ParsecT Void Text Identity [Text]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parsec Void Text Text -> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text Text -> Parsec Void Text Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text Text
stripPathComponet)
stripRelativePath :: ParsecT Void Text Identity [Text]
stripRelativePath = Parsec Void Text Text -> ParsecT Void Text Identity [Text]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
MP.many (Parsec Void Text Text -> Parsec Void Text Text
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
MP.try Parsec Void Text Text
stripPathComponet)
getInstalledHLSs :: (MonadReader AppState m, MonadIO m, MonadCatch m)
=> m [Either (Path Rel) Version]
getInstalledHLSs :: m [Either (Path Rel) Version]
getInstalledHLSs = do
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
[Path Rel]
bins <- IO [Path Rel] -> m [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel] -> m [Path Rel]) -> IO [Path Rel] -> m [Path Rel]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [Path Rel]) -> IO [Path Rel] -> IO [Path Rel]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [Path Rel] -> IO [Path Rel]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [Path Rel] -> IO [Path Rel]) -> IO [Path Rel] -> IO [Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> Regex -> IO [Path Rel]
findFiles
Path Abs
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)
)
[Path Rel]
-> (Path Rel -> m (Either (Path Rel) Version))
-> m [Either (Path Rel) Version]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Path Rel]
bins ((Path Rel -> m (Either (Path Rel) Version))
-> m [Either (Path Rel) Version])
-> (Path Rel -> m (Either (Path Rel) Version))
-> m [Either (Path Rel) Version]
forall a b. (a -> b) -> a -> b
$ \Path Rel
f ->
case
(ByteString -> Either (ParseErrorBundle Text Void) Version)
-> Maybe ByteString
-> Maybe (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)
-> (ByteString -> Text)
-> ByteString
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe) (Maybe ByteString
-> Maybe (Either (ParseErrorBundle Text Void) Version))
-> (Path Rel -> Maybe ByteString)
-> Path Rel
-> Maybe (Either (ParseErrorBundle Text Void) Version)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Maybe ByteString
B.stripPrefix ByteString
"haskell-language-server-wrapper-" (ByteString -> Maybe ByteString)
-> (Path Rel -> ByteString) -> Path Rel -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Rel -> Maybe (Either (ParseErrorBundle Text Void) Version))
-> Path Rel -> Maybe (Either (ParseErrorBundle Text Void) Version)
forall a b. (a -> b) -> a -> b
$ Path Rel
f
of
Just (Right Version
r) -> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Rel) Version -> m (Either (Path Rel) Version))
-> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall a b. (a -> b) -> a -> b
$ Version -> Either (Path Rel) Version
forall a b. b -> Either a b
Right Version
r
Just (Left ParseErrorBundle Text Void
_) -> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Rel) Version -> m (Either (Path Rel) Version))
-> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall a b. (a -> b) -> a -> b
$ Path Rel -> Either (Path Rel) Version
forall a b. a -> Either a b
Left Path Rel
f
Maybe (Either (ParseErrorBundle Text Void) Version)
Nothing -> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (Path Rel) Version -> m (Either (Path Rel) Version))
-> Either (Path Rel) Version -> m (Either (Path Rel) Version)
forall a b. (a -> b) -> a -> b
$ Path Rel -> Either (Path Rel) Version
forall a b. a -> Either a b
Left Path Rel
f
hlsInstalled :: (MonadIO m, MonadReader AppState m, MonadCatch m) => Version -> m Bool
hlsInstalled :: Version -> m Bool
hlsInstalled Version
ver = do
[Version]
vers <- ([Either (Path Rel) Version] -> [Version])
-> m [Either (Path Rel) Version] -> m [Version]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Either (Path Rel) Version] -> [Version]
forall a b. [Either a b] -> [b]
rights m [Either (Path Rel) Version]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadCatch m) =>
m [Either (Path Rel) 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 AppState m, MonadIO m, MonadThrow m, MonadCatch m) => m (Maybe Version)
hlsSet :: m (Maybe Version)
hlsSet = do
AppState {dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..}} <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
let hlsBin :: Path Abs
hlsBin = Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|haskell-language-server-wrapper|]
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 <- Path Abs -> IO Bool
isBrokenSymlink Path Abs
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
ByteString
link <- ByteString -> IO ByteString
readSymbolicLink (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
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
<$> ByteString -> IO Version
forall (m :: * -> *). MonadThrow m => ByteString -> m Version
linkVersion ByteString
link
where
linkVersion :: MonadThrow m => ByteString -> m Version
linkVersion :: ByteString -> m Version
linkVersion ByteString
bs = do
Text
t <- Either UnicodeException Text -> m Text
forall a (m :: * -> *) b.
(Exception a, MonadThrow m) =>
Either a b -> m b
throwEither (Either UnicodeException Text -> m Text)
-> Either UnicodeException Text -> m Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Either UnicodeException Text
E.decodeUtf8' ByteString
bs
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)
-> Either (ParseErrorBundle Text Void) Version -> m Version
forall a b. (a -> b) -> a -> b
$ Parsec Void Text Version
-> String -> Text -> Either (ParseErrorBundle Text Void) Version
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Version
parser String
"" Text
t
where
parser :: Parsec Void Text Version
parser =
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'
hlsGHCVersions :: ( MonadReader AppState m
, MonadIO m
, MonadThrow m
, MonadCatch m
)
=> m [Version]
hlsGHCVersions :: m [Version]
hlsGHCVersions = do
Maybe Version
h <- m (Maybe Version)
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m, MonadCatch m) =>
m (Maybe Version)
hlsSet
Maybe [Either (ParseErrorBundle Text Void) Version]
vers <- Maybe Version
-> (Version -> m [Either (ParseErrorBundle Text Void) Version])
-> m (Maybe [Either (ParseErrorBundle Text Void) Version])
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe Version
h ((Version -> m [Either (ParseErrorBundle Text Void) Version])
-> m (Maybe [Either (ParseErrorBundle Text Void) Version]))
-> (Version -> m [Either (ParseErrorBundle Text Void) Version])
-> m (Maybe [Either (ParseErrorBundle Text Void) Version])
forall a b. (a -> b) -> a -> b
$ \Version
h' -> do
[Path Rel]
bins <- Version -> m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m) =>
Version -> m [Path Rel]
hlsServerBinaries Version
h'
[Either (ParseErrorBundle Text Void) Version]
-> m [Either (ParseErrorBundle Text Void) Version]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Either (ParseErrorBundle Text Void) Version]
-> m [Either (ParseErrorBundle Text Void) Version])
-> [Either (ParseErrorBundle Text Void) Version]
-> m [Either (ParseErrorBundle Text Void) Version]
forall a b. (a -> b) -> a -> b
$ (Path Rel -> Either (ParseErrorBundle Text Void) Version)
-> [Path Rel] -> [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)
-> (Path Rel -> Text)
-> Path Rel
-> Either (ParseErrorBundle Text Void) Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe
(ByteString -> Text)
-> (Path Rel -> ByteString) -> Path Rel -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust
(Maybe ByteString -> ByteString)
-> (Path Rel -> Maybe ByteString) -> Path Rel -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Maybe ByteString
B.stripPrefix ByteString
"haskell-language-server-"
(ByteString -> Maybe ByteString)
-> (Path Rel -> ByteString) -> Path Rel -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> ByteString
forall a. [a] -> a
head
([ByteString] -> ByteString)
-> (Path Rel -> [ByteString]) -> Path Rel -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
B.split Word8
_tilde
(ByteString -> [ByteString])
-> (Path Rel -> ByteString) -> Path Rel -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath
)
[Path Rel]
bins
[Version] -> m [Version]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Version] -> m [Version])
-> (Maybe [Either (ParseErrorBundle Text Void) Version]
-> [Version])
-> Maybe [Either (ParseErrorBundle Text Void) Version]
-> m [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] -> [Version])
-> (Maybe [Either (ParseErrorBundle Text Void) Version]
-> [Either (ParseErrorBundle Text Void) Version])
-> Maybe [Either (ParseErrorBundle Text Void) Version]
-> [Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Either (ParseErrorBundle Text Void) Version]]
-> [Either (ParseErrorBundle Text Void) Version]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Either (ParseErrorBundle Text Void) Version]]
-> [Either (ParseErrorBundle Text Void) Version])
-> (Maybe [Either (ParseErrorBundle Text Void) Version]
-> [[Either (ParseErrorBundle Text Void) Version]])
-> Maybe [Either (ParseErrorBundle Text Void) Version]
-> [Either (ParseErrorBundle Text Void) Version]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Either (ParseErrorBundle Text Void) Version]
-> [[Either (ParseErrorBundle Text Void) Version]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Either (ParseErrorBundle Text Void) Version]
-> m [Version])
-> Maybe [Either (ParseErrorBundle Text Void) Version]
-> m [Version]
forall a b. (a -> b) -> a -> b
$ Maybe [Either (ParseErrorBundle Text Void) Version]
vers
hlsServerBinaries :: (MonadReader AppState m, MonadIO m)
=> Version
-> m [Path Rel]
hlsServerBinaries :: Version -> m [Path Rel]
hlsServerBinaries Version
ver = do
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
IO [Path Rel] -> m [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel] -> m [Path Rel]) -> IO [Path Rel] -> m [Path Rel]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [Path Rel]) -> IO [Path Rel] -> IO [Path Rel]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [Path Rel] -> IO [Path Rel]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [Path Rel] -> IO [Path Rel]) -> IO [Path Rel] -> IO [Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> Regex -> IO [Path Rel]
findFiles
Path Abs
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
<> Version -> ByteString
escapeVerRex Version
ver ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [s|$|] :: ByteString
)
)
hlsWrapperBinary :: (MonadReader AppState m, MonadThrow m, MonadIO m)
=> Version
-> m (Maybe (Path Rel))
hlsWrapperBinary :: Version -> m (Maybe (Path Rel))
hlsWrapperBinary Version
ver = do
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
[Path Rel]
wrapper <- IO [Path Rel] -> m [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel] -> m [Path Rel]) -> IO [Path Rel] -> m [Path Rel]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [Path Rel]) -> IO [Path Rel] -> IO [Path Rel]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [Path Rel] -> IO [Path Rel]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [Path Rel] -> IO [Path Rel]) -> IO [Path Rel] -> IO [Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> Regex -> IO [Path Rel]
findFiles
Path Abs
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
<> [s|$|] :: ByteString
)
)
case [Path Rel]
wrapper of
[] -> Maybe (Path Rel) -> m (Maybe (Path Rel))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Path Rel)
forall a. Maybe a
Nothing
[Path Rel
x] -> Maybe (Path Rel) -> m (Maybe (Path Rel))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Path Rel) -> m (Maybe (Path Rel)))
-> Maybe (Path Rel) -> m (Maybe (Path Rel))
forall a b. (a -> b) -> a -> b
$ Path Rel -> Maybe (Path Rel)
forall a. a -> Maybe a
Just Path Rel
x
[Path Rel]
_ -> UnexpectedListLength -> m (Maybe (Path Rel))
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UnexpectedListLength -> m (Maybe (Path Rel)))
-> UnexpectedListLength -> m (Maybe (Path Rel))
forall a b. (a -> b) -> a -> b
$ String -> UnexpectedListLength
UnexpectedListLength
String
"There were multiple hls wrapper binaries for a single version"
hlsAllBinaries :: (MonadReader AppState m, MonadIO m, MonadThrow m) => Version -> m [Path Rel]
hlsAllBinaries :: Version -> m [Path Rel]
hlsAllBinaries Version
ver = do
[Path Rel]
hls <- Version -> m [Path Rel]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m) =>
Version -> m [Path Rel]
hlsServerBinaries Version
ver
Maybe (Path Rel)
wrapper <- Version -> m (Maybe (Path Rel))
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m, MonadIO m) =>
Version -> m (Maybe (Path Rel))
hlsWrapperBinary Version
ver
[Path Rel] -> m [Path Rel]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Path Rel) -> [Path Rel]
forall a. Maybe a -> [a]
maybeToList Maybe (Path Rel)
wrapper [Path Rel] -> [Path Rel] -> [Path Rel]
forall a. [a] -> [a] -> [a]
++ [Path Rel]
hls)
hlsSymlinks :: (MonadReader AppState m, MonadIO m, MonadCatch m) => m [Path Rel]
hlsSymlinks :: m [Path Rel]
hlsSymlinks = do
AppState { dirs :: AppState -> Dirs
dirs = Dirs {Path Abs
confDir :: Path Abs
logsDir :: Path Abs
cacheDir :: Path Abs
binDir :: Path Abs
baseDir :: Path Abs
confDir :: Dirs -> Path Abs
logsDir :: Dirs -> Path Abs
cacheDir :: Dirs -> Path Abs
binDir :: Dirs -> Path Abs
baseDir :: Dirs -> Path Abs
..} } <- m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
[Path Rel]
oldSyms <- IO [Path Rel] -> m [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel] -> m [Path Rel]) -> IO [Path Rel] -> m [Path Rel]
forall a b. (a -> b) -> a -> b
$ (IOException -> IO [Path Rel]) -> IO [Path Rel] -> IO [Path Rel]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [Path Rel] -> IO [Path Rel]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (IO [Path Rel] -> IO [Path Rel]) -> IO [Path Rel] -> IO [Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> Regex -> IO [Path Rel]
findFiles
Path Abs
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)
)
(Path Rel -> m Bool) -> [Path Rel] -> m [Path Rel]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM
( (FileType -> Bool) -> m FileType -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FileType -> FileType -> Bool
forall a. Eq a => a -> a -> Bool
== FileType
SymbolicLink)
(m FileType -> m Bool)
-> (Path Rel -> m FileType) -> Path Rel -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO FileType -> m FileType
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO FileType -> m FileType)
-> (Path Rel -> IO FileType) -> Path Rel -> m FileType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> IO FileType
forall b. Path b -> IO FileType
getFileType
(Path Abs -> IO FileType)
-> (Path Rel -> Path Abs) -> Path Rel -> IO FileType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs
binDir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</>)
)
[Path Rel]
oldSyms
getMajorMinorV :: MonadThrow m => Version -> m (Int, Int)
getMajorMinorV :: Version -> m CharPos
getMajorMinorV Version {[VChunk]
Maybe Word
NonEmpty VChunk
_vEpoch :: Version -> Maybe Word
_vChunks :: Version -> NonEmpty VChunk
_vMeta :: Version -> [VChunk]
_vRel :: Version -> [VChunk]
_vRel :: [VChunk]
_vMeta :: [VChunk]
_vChunks :: NonEmpty VChunk
_vEpoch :: Maybe Word
..} = case NonEmpty VChunk
_vChunks of
((Digits Word
x :| []) :| ((Digits Word
y :| []):[VChunk]
_)) -> CharPos -> m CharPos
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 CharPos
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (ParseError -> m CharPos) -> ParseError -> m CharPos
forall a b. (a -> b) -> a -> b
$ String -> ParseError
ParseError String
"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 CharPos
forall (m :: * -> *). MonadThrow m => Version -> m CharPos
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 CharPos
Nothing -> Bool
False
getGHCForMajor :: (MonadReader AppState m, MonadIO m, MonadThrow m)
=> Int
-> Int
-> Maybe Text
-> m (Maybe GHCTargetVersion)
getGHCForMajor :: Int -> Int -> Maybe Text -> m (Maybe GHCTargetVersion)
getGHCForMajor Int
major' Int
minor' Maybe Text
mt = do
[GHCTargetVersion]
ghcs <- [Either (Path Rel) GHCTargetVersion] -> [GHCTargetVersion]
forall a b. [Either a b] -> [b]
rights ([Either (Path Rel) GHCTargetVersion] -> [GHCTargetVersion])
-> m [Either (Path Rel) GHCTargetVersion] -> m [GHCTargetVersion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m [Either (Path Rel) GHCTargetVersion]
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m) =>
m [Either (Path Rel) GHCTargetVersion]
getInstalledGHCs
Maybe GHCTargetVersion -> m (Maybe GHCTargetVersion)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Maybe GHCTargetVersion -> m (Maybe GHCTargetVersion))
-> ([GHCTargetVersion] -> Maybe GHCTargetVersion)
-> [GHCTargetVersion]
-> m (Maybe GHCTargetVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GHCTargetVersion] -> Maybe GHCTargetVersion
forall a. [a] -> Maybe a
lastMay
([GHCTargetVersion] -> Maybe GHCTargetVersion)
-> ([GHCTargetVersion] -> [GHCTargetVersion])
-> [GHCTargetVersion]
-> Maybe GHCTargetVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GHCTargetVersion -> GHCTargetVersion -> Ordering)
-> [GHCTargetVersion] -> [GHCTargetVersion]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (\GHCTargetVersion
x GHCTargetVersion
y -> Version -> Version -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
x) (GHCTargetVersion -> Version
_tvVersion GHCTargetVersion
y))
([GHCTargetVersion] -> [GHCTargetVersion])
-> ([GHCTargetVersion] -> [GHCTargetVersion])
-> [GHCTargetVersion]
-> [GHCTargetVersion]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GHCTargetVersion -> Bool)
-> [GHCTargetVersion] -> [GHCTargetVersion]
forall a. (a -> Bool) -> [a] -> [a]
filter
(\GHCTargetVersion {Maybe Text
Version
_tvVersion :: Version
_tvTarget :: Maybe Text
_tvVersion :: GHCTargetVersion -> Version
_tvTarget :: GHCTargetVersion -> Maybe Text
..} ->
Maybe Text
_tvTarget Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe Text
mt Bool -> Bool -> Bool
&& Version -> Int -> Int -> Bool
matchMajor Version
_tvVersion Int
major' Int
minor'
)
([GHCTargetVersion] -> m (Maybe GHCTargetVersion))
-> [GHCTargetVersion] -> m (Maybe GHCTargetVersion)
forall a b. (a -> b) -> a -> b
$ [GHCTargetVersion]
ghcs
getLatestGHCFor :: Int
-> Int
-> GHCupDownloads
-> Maybe (Version, VersionInfo)
getLatestGHCFor :: Int -> Int -> GHCupDownloads -> Maybe (Version, VersionInfo)
getLatestGHCFor Int
major' Int
minor' GHCupDownloads
dls =
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
GHC 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 Maybe [(Version, VersionInfo)]
-> ([(Version, VersionInfo)] -> Maybe (Version, VersionInfo))
-> Maybe (Version, VersionInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [(Version, VersionInfo)] -> Maybe (Version, VersionInfo)
forall a. [a] -> Maybe a
lastMay ([(Version, VersionInfo)] -> Maybe (Version, VersionInfo))
-> ([(Version, VersionInfo)] -> [(Version, VersionInfo)])
-> [(Version, VersionInfo)]
-> Maybe (Version, VersionInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Version, VersionInfo) -> Bool)
-> [(Version, VersionInfo)] -> [(Version, VersionInfo)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Version
v, VersionInfo
_) -> Version -> Int -> Int -> Bool
matchMajor Version
v Int
major' Int
minor')
unpackToDir :: (MonadLogger m, MonadIO m, MonadThrow m)
=> Path Abs
-> Path Abs
-> Excepts '[UnknownArchive
#if !defined(TAR)
, ArchiveResult
#endif
] m ()
unpackToDir :: Path Abs
-> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m ()
unpackToDir Path Abs
dest Path Abs
av = do
Text
fp <- ByteString -> Text
decUTF8Safe (ByteString -> Text)
-> (Path Rel -> ByteString) -> Path Rel -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Rel -> Text)
-> Excepts '[UnknownArchive, ArchiveResult] m (Path Rel)
-> Excepts '[UnknownArchive, ArchiveResult] m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m (Path Rel)
forall (m :: * -> *) b. MonadThrow m => Path b -> m (Path Rel)
basename Path Abs
av
let dfp :: Text
dfp = ByteString -> Text
decUTF8Safe (ByteString -> Text)
-> (Path Abs -> ByteString) -> Path Abs -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Abs -> Text) -> Path Abs -> Text
forall a b. (a -> b) -> a -> b
$ Path Abs
dest
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Unpacking: #{fp} to #{dfp}|]
ByteString
fn <- Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Rel -> ByteString)
-> Excepts '[UnknownArchive, ArchiveResult] m (Path Rel)
-> Excepts '[UnknownArchive, ArchiveResult] m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m (Path Rel)
forall (m :: * -> *) b. MonadThrow m => Path b -> m (Path Rel)
basename Path Abs
av
#if defined(TAR)
let untar :: MonadIO m => BL.ByteString -> Excepts '[] m ()
untar = liftIO . Tar.unpack (toFilePath dest) . Tar.read
rf :: MonadIO m => Path Abs -> Excepts '[] m BL.ByteString
rf = liftIO . readFile
#else
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
. String -> ByteString -> ArchiveM ()
unpackToDirLazy (Text -> String
T.unpack (Text -> String) -> (Path Abs -> Text) -> Path Abs -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe (ByteString -> Text)
-> (Path Abs -> ByteString) -> Path Abs -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Abs -> String) -> Path Abs -> String
forall a b. (a -> b) -> a -> b
$ Path Abs
dest)
rf :: MonadIO m => Path Abs -> Excepts '[ArchiveResult] m BL.ByteString
rf :: Path Abs -> 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)
-> (Path Abs -> IO ByteString)
-> Path Abs
-> Excepts '[ArchiveResult] m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFile
#endif
if
| ByteString
".tar.gz" ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
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
=<< Path Abs -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
Path Abs -> Excepts '[ArchiveResult] m ByteString
rf Path Abs
av)
| ByteString
".tar.xz" ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
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
$ Path Abs -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
Path Abs -> Excepts '[ArchiveResult] m ByteString
rf Path Abs
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
| ByteString
".tar.bz2" ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
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
=<< Path Abs -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
Path Abs -> Excepts '[ArchiveResult] m ByteString
rf Path Abs
av)
| ByteString
".tar" ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
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
=<< Path Abs -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
Path Abs -> Excepts '[ArchiveResult] m ByteString
rf Path Abs
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
$ ByteString -> UnknownArchive
UnknownArchive ByteString
fn
getArchiveFiles :: (MonadLogger m, MonadIO m, MonadThrow m)
=> Path Abs
-> Excepts '[UnknownArchive
#if defined(TAR)
, Tar.FormatError
#else
, ArchiveResult
#endif
] m [ByteString]
getArchiveFiles :: Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m [ByteString]
getArchiveFiles Path Abs
av = do
ByteString
fn <- Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath (Path Rel -> ByteString)
-> Excepts '[UnknownArchive, ArchiveResult] m (Path Rel)
-> Excepts '[UnknownArchive, ArchiveResult] m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path Abs -> Excepts '[UnknownArchive, ArchiveResult] m (Path Rel)
forall (m :: * -> *) b. MonadThrow m => Path b -> m (Path Rel)
basename Path Abs
av
#if defined(TAR)
let entries :: Monad m => BL.ByteString -> Excepts '[Tar.FormatError] m [ByteString]
entries =
lE @Tar.FormatError
. Tar.foldEntries
(\e x -> fmap (Tar.entryPath e :) x)
(Right [])
(\e -> Left e)
. Tar.read
rf :: MonadIO m => Path Abs -> Excepts '[Tar.FormatError] m BL.ByteString
rf = liftIO . readFile
#else
let entries :: Monad m => BL.ByteString -> Excepts '[ArchiveResult] m [ByteString]
entries :: ByteString -> Excepts '[ArchiveResult] m [ByteString]
entries = (([Entry String ByteString] -> [ByteString])
-> Excepts '[ArchiveResult] m [Entry String ByteString]
-> Excepts '[ArchiveResult] m [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Entry String ByteString] -> [ByteString])
-> Excepts '[ArchiveResult] m [Entry String ByteString]
-> Excepts '[ArchiveResult] m [ByteString])
-> ((Entry String ByteString -> ByteString)
-> [Entry String ByteString] -> [ByteString])
-> (Entry String ByteString -> ByteString)
-> Excepts '[ArchiveResult] m [Entry String ByteString]
-> Excepts '[ArchiveResult] m [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entry String ByteString -> ByteString)
-> [Entry String ByteString] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Text -> ByteString
E.encodeUtf8 (Text -> ByteString)
-> (Entry String ByteString -> Text)
-> Entry String ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (Entry String ByteString -> String)
-> Entry String ByteString
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entry String ByteString -> String
forall fp e. Entry fp e -> fp
filepath) (Excepts '[ArchiveResult] m [Entry String ByteString]
-> Excepts '[ArchiveResult] m [ByteString])
-> (ByteString
-> Excepts '[ArchiveResult] m [Entry String ByteString])
-> ByteString
-> Excepts '[ArchiveResult] m [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ArchiveResult [Entry String ByteString]
-> Excepts '[ArchiveResult] m [Entry String ByteString]
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE (Either ArchiveResult [Entry String ByteString]
-> Excepts '[ArchiveResult] m [Entry String ByteString])
-> (ByteString -> Either ArchiveResult [Entry String ByteString])
-> ByteString
-> Excepts '[ArchiveResult] m [Entry String ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either ArchiveResult [Entry String ByteString]
readArchiveBSL
rf :: MonadIO m => Path Abs -> Excepts '[ArchiveResult] m BL.ByteString
rf :: Path Abs -> 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)
-> (Path Abs -> IO ByteString)
-> Path Abs
-> Excepts '[ArchiveResult] m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> IO ByteString
forall b. Path b -> IO ByteString
readFile
#endif
if
| ByteString
".tar.gz" ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
fn -> 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
(ByteString -> Excepts '[ArchiveResult] m [ByteString]
forall (m :: * -> *).
Monad m =>
ByteString -> Excepts '[ArchiveResult] m [ByteString]
entries (ByteString -> Excepts '[ArchiveResult] m [ByteString])
-> (ByteString -> ByteString)
-> ByteString
-> Excepts '[ArchiveResult] m [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
GZip.decompress (ByteString -> Excepts '[ArchiveResult] m [ByteString])
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[ArchiveResult] m [ByteString]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path Abs -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
Path Abs -> Excepts '[ArchiveResult] m ByteString
rf Path Abs
av)
| ByteString
".tar.xz" ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
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
$ Path Abs -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
Path Abs -> Excepts '[ArchiveResult] m ByteString
rf Path Abs
av
let decompressed :: ByteString
decompressed = ByteString -> ByteString
Lzma.decompress 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
$ ByteString -> Excepts '[ArchiveResult] m [ByteString]
forall (m :: * -> *).
Monad m =>
ByteString -> Excepts '[ArchiveResult] m [ByteString]
entries ByteString
decompressed
| ByteString
".tar.bz2" ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
fn ->
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 (ByteString -> Excepts '[ArchiveResult] m [ByteString]
forall (m :: * -> *).
Monad m =>
ByteString -> Excepts '[ArchiveResult] m [ByteString]
entries (ByteString -> Excepts '[ArchiveResult] m [ByteString])
-> (ByteString -> ByteString)
-> ByteString
-> Excepts '[ArchiveResult] m [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BZip.decompress (ByteString -> Excepts '[ArchiveResult] m [ByteString])
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[ArchiveResult] m [ByteString]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path Abs -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
Path Abs -> Excepts '[ArchiveResult] m ByteString
rf Path Abs
av)
| ByteString
".tar" ByteString -> ByteString -> Bool
`B.isSuffixOf` ByteString
fn -> 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 (ByteString -> Excepts '[ArchiveResult] m [ByteString]
forall (m :: * -> *).
Monad m =>
ByteString -> Excepts '[ArchiveResult] m [ByteString]
entries (ByteString -> Excepts '[ArchiveResult] m [ByteString])
-> Excepts '[ArchiveResult] m ByteString
-> Excepts '[ArchiveResult] m [ByteString]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Path Abs -> Excepts '[ArchiveResult] m ByteString
forall (m :: * -> *).
MonadIO m =>
Path Abs -> Excepts '[ArchiveResult] m ByteString
rf Path Abs
av)
| Bool
otherwise -> UnknownArchive
-> Excepts '[UnknownArchive, ArchiveResult] m [ByteString]
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (UnknownArchive
-> Excepts '[UnknownArchive, ArchiveResult] m [ByteString])
-> UnknownArchive
-> Excepts '[UnknownArchive, ArchiveResult] m [ByteString]
forall a b. (a -> b) -> a -> b
$ ByteString -> UnknownArchive
UnknownArchive ByteString
fn
intoSubdir :: (MonadLogger m, MonadIO m, MonadThrow m, MonadCatch m)
=> Path Abs
-> TarDir
-> Excepts '[TarDirDoesNotExist] m (Path Abs)
intoSubdir :: Path Abs -> TarDir -> Excepts '[TarDirDoesNotExist] m (Path Abs)
intoSubdir Path Abs
bdir TarDir
tardir = case TarDir
tardir of
RealDir Path Rel
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)
-> (Path Abs -> Excepts '[TarDirDoesNotExist] m Bool)
-> Path Abs
-> 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)
-> (Path Abs -> IO Bool)
-> Path Abs
-> Excepts '[TarDirDoesNotExist] m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> IO Bool
forall b. Path b -> IO Bool
doesDirectoryExist (Path Abs -> Excepts '[TarDirDoesNotExist] m Bool)
-> Path Abs -> Excepts '[TarDirDoesNotExist] m Bool
forall a b. (a -> b) -> a -> b
$ (Path Abs
bdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
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)
Path Abs -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
bdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
pr)
RegexDir String
r -> do
let rs :: [String]
rs = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"/" String
r
(Path Abs -> String -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> Path Abs
-> [String]
-> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM
(\Path Abs
y String
x ->
((IOException -> Excepts '[TarDirDoesNotExist] m [Path Rel])
-> Excepts '[TarDirDoesNotExist] m [Path Rel]
-> Excepts '[TarDirDoesNotExist] m [Path Rel]
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> [Path Rel] -> Excepts '[TarDirDoesNotExist] m [Path Rel]
forall (f :: * -> *) a. Applicative f => a -> f a
pure []) (Excepts '[TarDirDoesNotExist] m [Path Rel]
-> Excepts '[TarDirDoesNotExist] m [Path Rel])
-> (String -> Excepts '[TarDirDoesNotExist] m [Path Rel])
-> String
-> Excepts '[TarDirDoesNotExist] m [Path Rel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO [Path Rel] -> Excepts '[TarDirDoesNotExist] m [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel] -> Excepts '[TarDirDoesNotExist] m [Path Rel])
-> (String -> IO [Path Rel])
-> String
-> Excepts '[TarDirDoesNotExist] m [Path Rel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> Regex -> IO [Path Rel]
findFiles Path Abs
y (Regex -> IO [Path Rel])
-> (String -> Regex) -> String -> IO [Path Rel]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Regex
regex (String -> Excepts '[TarDirDoesNotExist] m [Path Rel])
-> String -> Excepts '[TarDirDoesNotExist] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ String
x) Excepts '[TarDirDoesNotExist] m [Path Rel]
-> ([Path Rel] -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\case
[] -> TarDirDoesNotExist -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (TarDirDoesNotExist -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> TarDirDoesNotExist -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall a b. (a -> b) -> a -> b
$ TarDir -> TarDirDoesNotExist
TarDirDoesNotExist TarDir
tardir
(Path Rel
p : [Path Rel]
_) -> Path Abs -> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path Abs
y Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
p)) ([Path Rel] -> Excepts '[TarDirDoesNotExist] m (Path Abs))
-> ([Path Rel] -> [Path Rel])
-> [Path Rel]
-> Excepts '[TarDirDoesNotExist] m (Path Abs)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Path Rel] -> [Path Rel]
forall a. Ord a => [a] -> [a]
sort
)
Path Abs
bdir
[String]
rs
where regex :: String -> Regex
regex = CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compIgnoreCase ExecOption
execBlank
getTagged :: Tag
-> AffineFold (Map.Map Version VersionInfo) (Version, VersionInfo)
getTagged :: Tag -> AffineFold (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
tag =
(Map Version VersionInfo -> Map Version VersionInfo)
-> Getter (Map Version VersionInfo) (Map Version VersionInfo)
forall s a. (s -> a) -> Getter s a
to ((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
_viPreCompile :: VersionInfo -> Maybe Text
_viPostRemove :: VersionInfo -> Maybe Text
_viPostInstall :: VersionInfo -> Maybe Text
_viArch :: VersionInfo -> ArchitectureSpec
_viSourceDL :: VersionInfo -> Maybe DownloadInfo
_viChangeLog :: VersionInfo -> Maybe URI
_viTags :: 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))
Getter (Map Version VersionInfo) (Map Version VersionInfo)
-> Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
[(Version, VersionInfo)]
[(Version, VersionInfo)]
-> Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
[(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
% (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
Optic
A_Getter
'[]
(Map Version VersionInfo)
(Map Version VersionInfo)
[(Version, VersionInfo)]
[(Version, VersionInfo)]
-> Optic
An_AffineTraversal
'[]
[(Version, VersionInfo)]
[(Version, VersionInfo)]
(Version, VersionInfo)
(Version, VersionInfo)
-> AffineFold (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
% Optic
An_AffineTraversal
'[]
[(Version, VersionInfo)]
[(Version, VersionInfo)]
(Version, VersionInfo)
(Version, VersionInfo)
forall s a. Cons s s a a => AffineTraversal' s a
_head
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest :: GHCupDownloads -> Tool -> Maybe (Version, VersionInfo)
getLatest GHCupDownloads
av Tool
tool = Optic' An_AffineFold '[] 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)
-> AffineFold (Map 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
% Tag -> AffineFold (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' An_AffineFold '[] 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)
-> AffineFold (Map 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
% Tag -> AffineFold (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' An_AffineFold '[] 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)
-> AffineFold (Map 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
% Tag -> AffineFold (Map Version VersionInfo) (Version, VersionInfo)
getTagged (PVP -> Tag
Base PVP
pvpVer)) GHCupDownloads
av
getCache :: MonadReader AppState m => m Bool
getCache :: m Bool
getCache = m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask m AppState -> (AppState -> Bool) -> m Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Settings -> Bool
cache (Settings -> Bool) -> (AppState -> Settings) -> AppState -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> Settings
settings
getDownloader :: MonadReader AppState m => m Downloader
getDownloader :: m Downloader
getDownloader = m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask m AppState -> (AppState -> Downloader) -> m Downloader
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Settings -> Downloader
downloader (Settings -> Downloader)
-> (AppState -> Settings) -> AppState -> Downloader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AppState -> Settings
settings
urlBaseName :: MonadThrow m
=> ByteString
-> m (Path Rel)
urlBaseName :: ByteString -> m (Path Rel)
urlBaseName = ByteString -> m (Path Rel)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Rel)
parseRel (ByteString -> m (Path Rel))
-> (ByteString -> ByteString) -> ByteString -> m (Path Rel)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
B.breakEnd (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_slash) (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlDecode Bool
False
ghcToolFiles :: (MonadReader AppState m, MonadThrow m, MonadFail m, MonadIO m)
=> GHCTargetVersion
-> Excepts '[NotInstalled] m [Path Rel]
ghcToolFiles :: GHCTargetVersion -> Excepts '[NotInstalled] m [Path Rel]
ghcToolFiles GHCTargetVersion
ver = do
Path Abs
ghcdir <- m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs))
-> m (Path Abs) -> Excepts '[NotInstalled] m (Path Abs)
forall a b. (a -> b) -> a -> b
$ GHCTargetVersion -> m (Path Abs)
forall (m :: * -> *).
(MonadReader AppState m, MonadThrow m) =>
GHCTargetVersion -> m (Path Abs)
ghcupGHCDir GHCTargetVersion
ver
let bindir :: Path Abs
bindir = Path Abs
ghcdir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> [rel|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
$ Path Abs -> IO Bool
forall b. Path b -> IO Bool
doesDirectoryExist Path Abs
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))
[Path Rel]
files <- IO [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel] -> Excepts '[NotInstalled] m [Path Rel])
-> IO [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO [Path Rel]
forall b. Path b -> IO [Path Rel]
getDirsFiles' Path Abs
bindir
[Path Rel
ghcbin] <- IO [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Rel] -> Excepts '[NotInstalled] m [Path Rel])
-> IO [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ Path Abs -> Regex -> IO [Path Rel]
findFiles
Path Abs
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|^([a-zA-Z0-9_-]*[a-zA-Z0-9_]-)?ghc$|] :: ByteString)
)
let ghcbinPath :: Path Abs
ghcbinPath = Path Abs
bindir Path Abs -> Path Rel -> Path Abs
forall b. Path b -> Path Rel -> Path b
</> Path Rel
ghcbin
Bool
ghcIsHadrian <- 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
$ Path Abs -> IO Bool
isHadrian Path Abs
ghcbinPath
[Path Rel] -> [Path Rel]
onlyUnversioned <- if Bool
ghcIsHadrian
then ([Path Rel] -> [Path Rel])
-> Excepts '[NotInstalled] m ([Path Rel] -> [Path Rel])
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Path Rel] -> [Path Rel]
forall a. a -> a
id
else do
(Just ByteString
symver) <-
ByteString -> ByteString -> Maybe ByteString
B.stripPrefix (Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
ghcbin ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-") (ByteString -> Maybe ByteString)
-> (ByteString -> ByteString) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
takeFileName
(ByteString -> Maybe ByteString)
-> Excepts '[NotInstalled] m ByteString
-> Excepts '[NotInstalled] m (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ByteString -> Excepts '[NotInstalled] m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> IO ByteString
readSymbolicLink (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
ghcbinPath)
Bool
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Bool
B.null ByteString
symver)
(IOException -> Excepts '[NotInstalled] m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (IOException -> Excepts '[NotInstalled] m ())
-> IOException -> Excepts '[NotInstalled] m ()
forall a b. (a -> b) -> a -> b
$ String -> IOException
userError String
"Fatal: ghc symlink target is broken")
([Path Rel] -> [Path Rel])
-> Excepts '[NotInstalled] m ([Path Rel] -> [Path Rel])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([Path Rel] -> [Path Rel])
-> Excepts '[NotInstalled] m ([Path Rel] -> [Path Rel]))
-> ([Path Rel] -> [Path Rel])
-> Excepts '[NotInstalled] m ([Path Rel] -> [Path Rel])
forall a b. (a -> b) -> a -> b
$ (Path Rel -> Bool) -> [Path Rel] -> [Path Rel]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Path Rel
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString
symver ByteString -> ByteString -> Bool
`B.isSuffixOf` Path Rel -> ByteString
forall b. Path b -> ByteString
toFilePath Path Rel
x)
[Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Path Rel] -> Excepts '[NotInstalled] m [Path Rel])
-> [Path Rel] -> Excepts '[NotInstalled] m [Path Rel]
forall a b. (a -> b) -> a -> b
$ [Path Rel] -> [Path Rel]
onlyUnversioned [Path Rel]
files
where
isHadrian :: Path Abs
-> IO Bool
isHadrian :: Path Abs -> IO Bool
isHadrian = (FileType -> Bool) -> IO FileType -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FileType -> FileType -> Bool
forall a. Eq a => a -> a -> Bool
/= FileType
SymbolicLink) (IO FileType -> IO Bool)
-> (Path Abs -> IO FileType) -> Path Abs -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs -> IO FileType
forall b. Path b -> IO FileType
getFileType
ghcUpSrcBuiltFile :: Path Rel
ghcUpSrcBuiltFile :: Path Rel
ghcUpSrcBuiltFile = [rel|.ghcup_src_built|]
make :: (MonadThrow m, MonadIO m, MonadReader AppState m)
=> [ByteString]
-> Maybe (Path Abs)
-> m (Either ProcessError ())
make :: [ByteString] -> Maybe (Path Abs) -> m (Either ProcessError ())
make [ByteString]
args Maybe (Path Abs)
workdir = do
[Path Abs]
spaths <- [Maybe (Path Abs)] -> [Path Abs]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (Path Abs)] -> [Path Abs])
-> ([ByteString] -> [Maybe (Path Abs)])
-> [ByteString]
-> [Path Abs]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe (Path Abs))
-> [ByteString] -> [Maybe (Path Abs)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Maybe (Path Abs)
forall (m :: * -> *). MonadThrow m => ByteString -> m (Path Abs)
parseAbs ([ByteString] -> [Path Abs]) -> m [ByteString] -> m [Path Abs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [ByteString] -> m [ByteString]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO [ByteString]
getSearchPath
Bool
has_gmake <- Maybe (Path Abs) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Path Abs) -> Bool) -> m (Maybe (Path Abs)) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe (Path Abs)) -> m (Maybe (Path Abs))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ([Path Abs] -> Path Rel -> IO (Maybe (Path Abs))
searchPath [Path Abs]
spaths [rel|gmake|])
let mymake :: ByteString
mymake = if Bool
has_gmake then ByteString
"gmake" else ByteString
"make"
ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
forall (m :: * -> *).
(MonadReader AppState m, MonadIO m, MonadThrow m) =>
ByteString
-> Bool
-> [ByteString]
-> Path Rel
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> m (Either ProcessError ())
execLogged ByteString
mymake Bool
True [ByteString]
args [rel|ghc-make|] Maybe (Path Abs)
workdir Maybe [(ByteString, ByteString)]
forall a. Maybe a
Nothing
applyPatches :: (MonadLogger m, MonadIO m)
=> Path Abs
-> Path Abs
-> Excepts '[PatchFailed] m ()
applyPatches :: Path Abs -> Path Abs -> Excepts '[PatchFailed] m ()
applyPatches Path Abs
pdir Path Abs
ddir = do
[Path Abs]
patches <- IO [Path Abs] -> Excepts '[PatchFailed] m [Path Abs]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Path Abs] -> Excepts '[PatchFailed] m [Path Abs])
-> IO [Path Abs] -> Excepts '[PatchFailed] m [Path Abs]
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO [Path Abs]
forall b. Path b -> IO [Path b]
getDirsFiles Path Abs
pdir
[Path Abs]
-> (Path Abs -> Excepts '[PatchFailed] m ())
-> Excepts '[PatchFailed] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Path Abs] -> [Path Abs]
forall a. Ord a => [a] -> [a]
sort [Path Abs]
patches) ((Path Abs -> Excepts '[PatchFailed] m ())
-> Excepts '[PatchFailed] m ())
-> (Path Abs -> Excepts '[PatchFailed] m ())
-> Excepts '[PatchFailed] m ()
forall a b. (a -> b) -> a -> b
$ \Path Abs
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
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) [i|Applying patch #{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)
(IO (Either ProcessError ()) -> m (Either ProcessError ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ProcessError ()) -> m (Either ProcessError ()))
-> IO (Either ProcessError ()) -> m (Either ProcessError ())
forall a b. (a -> b) -> a -> b
$ ByteString
-> Bool
-> [ByteString]
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> IO (Either ProcessError ())
exec
ByteString
"patch"
Bool
True
[ByteString
"-p1", ByteString
"-i", Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
patch']
(Path Abs -> Maybe (Path Abs)
forall a. a -> Maybe a
Just Path Abs
ddir)
Maybe [(ByteString, ByteString)]
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 :: Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization :: Platform -> Path Abs -> IO (Either ProcessError ())
darwinNotarization Platform
Darwin Path Abs
path = ByteString
-> Bool
-> [ByteString]
-> Maybe (Path Abs)
-> Maybe [(ByteString, ByteString)]
-> IO (Either ProcessError ())
exec
ByteString
"xattr"
Bool
True
[ByteString
"-r", ByteString
"-d", ByteString
"com.apple.quarantine", Path Abs -> ByteString
forall b. Path b -> ByteString
toFilePath Path Abs
path]
Maybe (Path Abs)
forall a. Maybe a
Nothing
Maybe [(ByteString, ByteString)]
forall a. Maybe a
Nothing
darwinNotarization Platform
_ Path Abs
_ = Either ProcessError () -> IO (Either ProcessError ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ProcessError () -> IO (Either ProcessError ()))
-> Either ProcessError () -> IO (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)
-> AffineFold (Map 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
% Tag -> AffineFold (Map Version VersionInfo) (Version, VersionInfo)
getTagged Tag
tag Optic' An_AffineFold '[] GHCupDownloads (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 :: (Show (V e), MonadReader AppState m, MonadIO m, MonadMask m)
=> Path Abs
-> Maybe (Path Abs)
-> Excepts e m a
-> Excepts '[BuildFailed] m a
runBuildAction :: Path Abs
-> Maybe (Path Abs) -> Excepts e m a -> Excepts '[BuildFailed] m a
runBuildAction Path Abs
bdir Maybe (Path Abs)
instdir Excepts e m a
action = do
AppState { settings :: AppState -> Settings
settings = Settings {Bool
Downloader
KeepDirs
URLSource
urlSource :: Settings -> URLSource
verbose :: Settings -> Bool
keepDirs :: Settings -> KeepDirs
noVerify :: Settings -> Bool
urlSource :: URLSource
verbose :: Bool
downloader :: Downloader
keepDirs :: KeepDirs
noVerify :: Bool
cache :: Bool
downloader :: Settings -> Downloader
cache :: Settings -> Bool
..} } <- m AppState -> Excepts '[BuildFailed] m AppState
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m AppState
forall r (m :: * -> *). MonadReader r m => m r
ask
let exAction :: Excepts '[BuildFailed] m ()
exAction = do
Maybe (Path Abs)
-> (Path Abs -> Excepts '[BuildFailed] m ())
-> Excepts '[BuildFailed] m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (Path Abs)
instdir ((Path Abs -> Excepts '[BuildFailed] m ())
-> Excepts '[BuildFailed] m ())
-> (Path Abs -> Excepts '[BuildFailed] m ())
-> Excepts '[BuildFailed] m ()
forall a b. (a -> b) -> a -> b
$ \Path Abs
dir ->
IO () -> Excepts '[BuildFailed] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[BuildFailed] m ())
-> IO () -> Excepts '[BuildFailed] m ()
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
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteDirRecursive Path Abs
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
$ IO () -> Excepts '[BuildFailed] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(IO () -> Excepts '[BuildFailed] m ())
-> IO () -> Excepts '[BuildFailed] m ()
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
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteDirRecursive Path Abs
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 (Path Abs -> V e -> BuildFailed
forall (es :: [*]). Show (V es) => Path Abs -> V es -> BuildFailed
BuildFailed Path Abs
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
$ IO () -> Excepts '[BuildFailed] m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Excepts '[BuildFailed] m ())
-> IO () -> Excepts '[BuildFailed] m ()
forall a b. (a -> b) -> a -> b
$ Path Abs -> IO ()
forall b. Path b -> IO ()
deleteDirRecursive
Path Abs
bdir
a -> Excepts '[BuildFailed] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
v
createDirRecursive' :: Path b -> IO ()
createDirRecursive' :: Path b -> IO ()
createDirRecursive' Path b
p =
(IOException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
e -> if IOException -> Bool
isAlreadyExistsError IOException
e then IOException -> IO ()
forall e. Exception e => e -> IO ()
isSymlinkDir IOException
e else IOException -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO IOException
e)
(IO () -> IO ()) -> (Path b -> IO ()) -> Path b -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileMode -> Path b -> IO ()
forall b. FileMode -> Path b -> IO ()
createDirRecursive FileMode
newDirPerms
(Path b -> IO ()) -> Path b -> IO ()
forall a b. (a -> b) -> a -> b
$ Path b
p
where
isSymlinkDir :: e -> IO ()
isSymlinkDir e
e = do
FileType
ft <- Path b -> IO FileType
forall b. Path b -> IO FileType
getFileType Path b
p
case FileType
ft of
FileType
SymbolicLink -> do
Path Abs
rp <- Path b -> IO (Path Abs)
forall b. Path b -> IO (Path Abs)
canonicalizePath Path b
p
FileType
rft <- Path Abs -> IO FileType
forall b. Path b -> IO FileType
getFileType Path Abs
rp
case FileType
rft of
FileType
Directory -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
FileType
_ -> e -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO e
e
FileType
_ -> e -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO e
e
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)
-> Getter (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)
-> Getter (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
)
traverseFold :: (Foldable t, Applicative m, Monoid b) => (a -> m b) -> t a -> m b
traverseFold :: (a -> m b) -> t a -> m b
traverseFold a -> m b
f = (m b -> a -> m b) -> m b -> t a -> m b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\m b
mb a
a -> b -> b -> b
forall a. Semigroup a => a -> a -> a
(<>) (b -> b -> b) -> m b -> m (b -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
mb m (b -> b) -> m b -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> m b
f a
a) (b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall a. Monoid a => a
mempty)
forFold :: (Foldable t, Applicative m, Monoid b) => t a -> (a -> m b) -> m b
forFold :: t a -> (a -> m b) -> m b
forFold = \t a
t -> ((a -> m b) -> t a -> m b
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Applicative m, Monoid b) =>
(a -> m b) -> t a -> m b
`traverseFold` t a
t)