{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskellQuotes #-}
module GHCup.Platform where
import GHCup.Errors
import GHCup.Types
import GHCup.Types.Optics
import GHCup.Types.JSON ( )
import GHCup.Utils.Dirs
import GHCup.Prelude
import GHCup.Prelude.Logger
import GHCup.Prelude.Process
import GHCup.Prelude.String.QQ
import GHCup.Prelude.Version.QQ
import GHCup.Prelude.MegaParsec
#if !MIN_VERSION_base(4,13,0)
import Control.Monad.Fail ( MonadFail )
#endif
import Control.Applicative
import Control.Exception.Safe
import Control.Monad
import Control.Monad.Reader
import Data.ByteString ( ByteString )
import Data.Foldable
import Data.Maybe
import Data.Text ( Text )
import Data.Versions
import Haskus.Utils.Variant.Excepts
import Prelude hiding ( abs
, readFile
, writeFile
)
import System.Info
import System.OsRelease
import System.Exit
import System.FilePath
import Text.PrettyPrint.HughesPJClass ( prettyShow )
import Text.Regex.Posix
import qualified Text.Megaparsec as MP
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Data.Void
import qualified Data.List as L
platformRequest :: (MonadReader env m, Alternative m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
=> Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
PlatformRequest
platformRequest :: forall env (m :: * -> *).
(MonadReader env m, Alternative m, MonadFail m, HasLog env,
MonadCatch m, MonadIO m) =>
Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
PlatformRequest
platformRequest = do
(PlatformResult Platform
rp Maybe Versioning
rv) <- Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
-> Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
PlatformResult
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall (m :: * -> *) env.
(Alternative m, MonadReader env m, HasLog env, MonadCatch m,
MonadIO m, MonadFail m) =>
Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
getPlatform
Architecture
ar <- Either NoCompatibleArch Architecture
-> Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
Architecture
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
Either e a -> Excepts es m a
lE Either NoCompatibleArch Architecture
getArchitecture
PlatformRequest
-> Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
PlatformRequest
forall a.
a
-> Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlatformRequest
-> Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
PlatformRequest)
-> PlatformRequest
-> Excepts
'[NoCompatiblePlatform, NoCompatibleArch, DistroNotFound]
m
PlatformRequest
forall a b. (a -> b) -> a -> b
$ Architecture -> Platform -> Maybe Versioning -> PlatformRequest
PlatformRequest Architecture
ar Platform
rp Maybe Versioning
rv
getArchitecture :: Either NoCompatibleArch Architecture
getArchitecture :: Either NoCompatibleArch Architecture
getArchitecture = case String
arch of
String
"x86_64" -> Architecture -> Either NoCompatibleArch Architecture
forall a b. b -> Either a b
Right Architecture
A_64
String
"i386" -> Architecture -> Either NoCompatibleArch Architecture
forall a b. b -> Either a b
Right Architecture
A_32
String
"powerpc" -> Architecture -> Either NoCompatibleArch Architecture
forall a b. b -> Either a b
Right Architecture
A_PowerPC
String
"powerpc64" -> Architecture -> Either NoCompatibleArch Architecture
forall a b. b -> Either a b
Right Architecture
A_PowerPC64
String
"powerpc64le" -> Architecture -> Either NoCompatibleArch Architecture
forall a b. b -> Either a b
Right Architecture
A_PowerPC64
String
"sparc" -> Architecture -> Either NoCompatibleArch Architecture
forall a b. b -> Either a b
Right Architecture
A_Sparc
String
"sparc64" -> Architecture -> Either NoCompatibleArch Architecture
forall a b. b -> Either a b
Right Architecture
A_Sparc64
String
"arm" -> Architecture -> Either NoCompatibleArch Architecture
forall a b. b -> Either a b
Right Architecture
A_ARM
String
"aarch64" -> Architecture -> Either NoCompatibleArch Architecture
forall a b. b -> Either a b
Right Architecture
A_ARM64
String
what -> NoCompatibleArch -> Either NoCompatibleArch Architecture
forall a b. a -> Either a b
Left (String -> NoCompatibleArch
NoCompatibleArch String
what)
getPlatform :: (Alternative m, MonadReader env m, HasLog env, MonadCatch m, MonadIO m, MonadFail m)
=> Excepts
'[NoCompatiblePlatform, DistroNotFound]
m
PlatformResult
getPlatform :: forall (m :: * -> *) env.
(Alternative m, MonadReader env m, HasLog env, MonadCatch m,
MonadIO m, MonadFail m) =>
Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
getPlatform = do
PlatformResult
pfr <- case String
os of
String
"linux" -> do
(LinuxDistro
distro, Maybe Versioning
ver) <- Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning)
-> Excepts
'[NoCompatiblePlatform, DistroNotFound]
m
(LinuxDistro, Maybe Versioning)
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning)
forall (m :: * -> *).
(Alternative m, MonadCatch m, MonadIO m, MonadFail m) =>
Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning)
getLinuxDistro
PlatformResult
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall a. a -> Excepts '[NoCompatiblePlatform, DistroNotFound] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlatformResult
-> Excepts
'[NoCompatiblePlatform, DistroNotFound] m PlatformResult)
-> PlatformResult
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall a b. (a -> b) -> a -> b
$ PlatformResult { $sel:_platform:PlatformResult :: Platform
_platform = LinuxDistro -> Platform
Linux LinuxDistro
distro, $sel:_distroVersion:PlatformResult :: Maybe Versioning
_distroVersion = Maybe Versioning
ver }
String
"darwin" -> do
Maybe Versioning
ver <-
(ParsingError -> Maybe Versioning)
-> (Versioning -> Maybe Versioning)
-> Either ParsingError Versioning
-> Maybe Versioning
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Versioning -> ParsingError -> Maybe Versioning
forall a b. a -> b -> a
const Maybe Versioning
forall a. Maybe a
Nothing) Versioning -> Maybe Versioning
forall a. a -> Maybe a
Just
(Either ParsingError Versioning -> Maybe Versioning)
-> (ByteString -> Either ParsingError Versioning)
-> ByteString
-> Maybe Versioning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Versioning
versioning
(Text -> Either ParsingError Versioning)
-> (ByteString -> Text)
-> ByteString
-> Either ParsingError Versioning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe'
(ByteString -> Maybe Versioning)
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString
-> Excepts
'[NoCompatiblePlatform, DistroNotFound] m (Maybe Versioning)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString
getDarwinVersion
PlatformResult
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall a. a -> Excepts '[NoCompatiblePlatform, DistroNotFound] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlatformResult
-> Excepts
'[NoCompatiblePlatform, DistroNotFound] m PlatformResult)
-> PlatformResult
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall a b. (a -> b) -> a -> b
$ PlatformResult { $sel:_platform:PlatformResult :: Platform
_platform = Platform
Darwin, $sel:_distroVersion:PlatformResult :: Maybe Versioning
_distroVersion = Maybe Versioning
ver }
String
"freebsd" -> do
Maybe Versioning
ver <-
(ParsingError -> Maybe Versioning)
-> (Versioning -> Maybe Versioning)
-> Either ParsingError Versioning
-> Maybe Versioning
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Versioning -> ParsingError -> Maybe Versioning
forall a b. a -> b -> a
const Maybe Versioning
forall a. Maybe a
Nothing) Versioning -> Maybe Versioning
forall a. a -> Maybe a
Just (Either ParsingError Versioning -> Maybe Versioning)
-> (ByteString -> Either ParsingError Versioning)
-> ByteString
-> Maybe Versioning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Versioning
versioning (Text -> Either ParsingError Versioning)
-> (ByteString -> Text)
-> ByteString
-> Either ParsingError Versioning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe'
(ByteString -> Maybe Versioning)
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString
-> Excepts
'[NoCompatiblePlatform, DistroNotFound] m (Maybe Versioning)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString
getFreeBSDVersion
PlatformResult
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall a. a -> Excepts '[NoCompatiblePlatform, DistroNotFound] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PlatformResult
-> Excepts
'[NoCompatiblePlatform, DistroNotFound] m PlatformResult)
-> PlatformResult
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall a b. (a -> b) -> a -> b
$ PlatformResult { $sel:_platform:PlatformResult :: Platform
_platform = Platform
FreeBSD, $sel:_distroVersion:PlatformResult :: Maybe Versioning
_distroVersion = Maybe Versioning
ver }
String
"mingw32" -> PlatformResult
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall a. a -> Excepts '[NoCompatiblePlatform, DistroNotFound] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlatformResult { $sel:_platform:PlatformResult :: Platform
_platform = Platform
Windows, $sel:_distroVersion:PlatformResult :: Maybe Versioning
_distroVersion = Maybe Versioning
forall a. Maybe a
Nothing }
String
what -> NoCompatiblePlatform
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (NoCompatiblePlatform
-> Excepts
'[NoCompatiblePlatform, DistroNotFound] m PlatformResult)
-> NoCompatiblePlatform
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall a b. (a -> b) -> a -> b
$ String -> NoCompatiblePlatform
NoCompatiblePlatform String
what
m () -> Excepts '[NoCompatiblePlatform, DistroNotFound] m ()
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NoCompatiblePlatform, DistroNotFound] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> Excepts '[NoCompatiblePlatform, DistroNotFound] m ())
-> m () -> Excepts '[NoCompatiblePlatform, DistroNotFound] m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Identified Platform as: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (PlatformResult -> String
forall a. Pretty a => a -> String
prettyShow PlatformResult
pfr)
PlatformResult
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m PlatformResult
forall a. a -> Excepts '[NoCompatiblePlatform, DistroNotFound] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PlatformResult
pfr
where
getFreeBSDVersion :: Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString
getFreeBSDVersion = m ByteString
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NoCompatiblePlatform, DistroNotFound] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString)
-> m ByteString
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString
forall a b. (a -> b) -> a -> b
$ (CapturedProcess -> ByteString)
-> m CapturedProcess -> m ByteString
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CapturedProcess -> ByteString
_stdOut (m CapturedProcess -> m ByteString)
-> m CapturedProcess -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Maybe String -> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> Maybe String -> m CapturedProcess
executeOut String
"freebsd-version" [] Maybe String
forall a. Maybe a
Nothing
getDarwinVersion :: Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString
getDarwinVersion = m ByteString
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[NoCompatiblePlatform, DistroNotFound] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString)
-> m ByteString
-> Excepts '[NoCompatiblePlatform, DistroNotFound] m ByteString
forall a b. (a -> b) -> a -> b
$ (CapturedProcess -> ByteString)
-> m CapturedProcess -> m ByteString
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CapturedProcess -> ByteString
_stdOut (m CapturedProcess -> m ByteString)
-> m CapturedProcess -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Maybe String -> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> Maybe String -> m CapturedProcess
executeOut String
"sw_vers"
[String
"-productVersion"]
Maybe String
forall a. Maybe a
Nothing
getLinuxDistro :: (Alternative m, MonadCatch m, MonadIO m, MonadFail m)
=> Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning)
getLinuxDistro :: forall (m :: * -> *).
(Alternative m, MonadCatch m, MonadIO m, MonadFail m) =>
Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning)
getLinuxDistro = do
(Text
name, Maybe Text
ver) <- (IOException -> Excepts '[DistroNotFound] m (Text, Maybe Text))
-> Excepts '[DistroNotFound] m (Text, Maybe Text)
-> Excepts '[DistroNotFound] m (Text, Maybe Text)
forall (m :: * -> *) a.
MonadCatch m =>
(IOException -> m a) -> m a -> m a
handleIO (\IOException
_ -> DistroNotFound -> Excepts '[DistroNotFound] m (Text, Maybe Text)
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE DistroNotFound
DistroNotFound) (Excepts '[DistroNotFound] m (Text, Maybe Text)
-> Excepts '[DistroNotFound] m (Text, Maybe Text))
-> Excepts '[DistroNotFound] m (Text, Maybe Text)
-> Excepts '[DistroNotFound] m (Text, Maybe Text)
forall a b. (a -> b) -> a -> b
$ m (Text, Maybe Text)
-> Excepts '[DistroNotFound] m (Text, Maybe Text)
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[DistroNotFound] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Text, Maybe Text)
-> Excepts '[DistroNotFound] m (Text, Maybe Text))
-> m (Text, Maybe Text)
-> Excepts '[DistroNotFound] m (Text, Maybe Text)
forall a b. (a -> b) -> a -> b
$ [m (Text, Maybe Text)] -> m (Text, Maybe Text)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
[ IO (Text, Maybe Text) -> m (Text, Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Text, Maybe Text)
try_os_release
, m (Text, Maybe Text)
forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
m (Text, Maybe Text)
try_lsb_release_cmd
, IO (Text, Maybe Text) -> m (Text, Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Text, Maybe Text)
try_redhat_release
, IO (Text, Maybe Text) -> m (Text, Maybe Text)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Text, Maybe Text)
try_debian_version
]
let parsedVer :: Maybe Versioning
parsedVer = Maybe Text
ver Maybe Text -> (Text -> Maybe Versioning) -> Maybe Versioning
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ParsingError -> Maybe Versioning)
-> (Versioning -> Maybe Versioning)
-> Either ParsingError Versioning
-> Maybe Versioning
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe Versioning -> ParsingError -> Maybe Versioning
forall a b. a -> b -> a
const Maybe Versioning
forall a. Maybe a
Nothing) Versioning -> Maybe Versioning
forall a. a -> Maybe a
Just (Either ParsingError Versioning -> Maybe Versioning)
-> (Text -> Either ParsingError Versioning)
-> Text
-> Maybe Versioning
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParsingError Versioning
versioning
distro :: LinuxDistro
distro = if
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"debian"] -> LinuxDistro
Debian
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"ubuntu"] -> LinuxDistro
Ubuntu
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"linuxmint", String
"Linux Mint"] -> LinuxDistro
Mint
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"fedora"] -> LinuxDistro
Fedora
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"centos"] -> LinuxDistro
CentOS
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"Red Hat"] -> LinuxDistro
RedHat
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"alpine"] -> LinuxDistro
Alpine
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"exherbo"] -> LinuxDistro
Exherbo
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"gentoo"] -> LinuxDistro
Gentoo
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"amazonlinux", String
"Amazon Linux"] -> LinuxDistro
AmazonLinux
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"rocky", String
"Rocky Linux"] -> LinuxDistro
Rocky
| Text -> [String] -> Bool
forall {t :: * -> *}. Foldable t => Text -> t String -> Bool
hasWord Text
name [String
"void", String
"Void Linux"] -> LinuxDistro
Void
| Bool
otherwise -> LinuxDistro
UnknownLinux
(LinuxDistro, Maybe Versioning)
-> Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning)
forall a. a -> Excepts '[DistroNotFound] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LinuxDistro
distro, Maybe Versioning
parsedVer)
where
hasWord :: Text -> t String -> Bool
hasWord Text
t = (String -> Bool) -> t String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\String
x -> Regex -> String -> Bool
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match (String -> Regex
regex String
x) (Text -> String
T.unpack Text
t))
where
regex :: String -> Regex
regex String
x = CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compIgnoreCase ExecOption
execBlank ([s|\<|] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ [s|\>|])
lsb_release_cmd :: FilePath
lsb_release_cmd :: String
lsb_release_cmd = String
"lsb-release"
redhat_release :: FilePath
redhat_release :: String
redhat_release = String
"/etc/redhat-release"
debian_version :: FilePath
debian_version :: String
debian_version = String
"/etc/debian_version"
try_os_release :: IO (Text, Maybe Text)
try_os_release :: IO (Text, Maybe Text)
try_os_release = do
Just OsRelease{ name :: OsRelease -> String
name = String
name, version_id :: OsRelease -> Maybe String
version_id = Maybe String
version_id } <-
(OsReleaseResult -> OsRelease)
-> Maybe OsReleaseResult -> Maybe OsRelease
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OsReleaseResult -> OsRelease
osRelease (Maybe OsReleaseResult -> Maybe OsRelease)
-> IO (Maybe OsReleaseResult) -> IO (Maybe OsRelease)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe OsReleaseResult)
parseOsRelease
(Text, Maybe Text) -> IO (Text, Maybe Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
T.pack String
name, (String -> Text) -> Maybe String -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Maybe String
version_id)
try_lsb_release_cmd :: (MonadFail m, MonadIO m)
=> m (Text, Maybe Text)
try_lsb_release_cmd :: forall (m :: * -> *).
(MonadFail m, MonadIO m) =>
m (Text, Maybe Text)
try_lsb_release_cmd = do
(Just String
_) <- IO (Maybe String) -> m (Maybe String)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> m (Maybe String))
-> IO (Maybe String) -> m (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
findExecutable String
lsb_release_cmd
ByteString
name <- (CapturedProcess -> ByteString)
-> m CapturedProcess -> m ByteString
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CapturedProcess -> ByteString
_stdOut (m CapturedProcess -> m ByteString)
-> m CapturedProcess -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Maybe String -> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> Maybe String -> m CapturedProcess
executeOut String
lsb_release_cmd [String
"-si"] Maybe String
forall a. Maybe a
Nothing
ByteString
ver <- (CapturedProcess -> ByteString)
-> m CapturedProcess -> m ByteString
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CapturedProcess -> ByteString
_stdOut (m CapturedProcess -> m ByteString)
-> m CapturedProcess -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Maybe String -> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> Maybe String -> m CapturedProcess
executeOut String
lsb_release_cmd [String
"-sr"] Maybe String
forall a. Maybe a
Nothing
(Text, Maybe Text) -> m (Text, Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Text
decUTF8Safe' ByteString
name, Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decUTF8Safe' ByteString
ver)
try_redhat_release :: IO (Text, Maybe Text)
try_redhat_release :: IO (Text, Maybe Text)
try_redhat_release = do
Text
t <- String -> IO Text
T.readFile String
redhat_release
let nameRegex :: String -> Regex
nameRegex String
n =
CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compIgnoreCase
ExecOption
execBlank
([s|\<|] ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
forall a. IsString a => String -> a
fS String
n ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> [s|\>|] :: ByteString) :: Regex
let verRegex :: Regex
verRegex =
CompOption -> ExecOption -> ByteString -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
compIgnoreCase
ExecOption
execBlank
([s|\<([0-9])+(.([0-9])+)*\>|] :: ByteString) :: Regex
let nameRe :: String -> Maybe String
nameRe String
n =
String -> Maybe String
fromEmpty (String -> Maybe String)
-> (String -> String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> String -> String
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match (String -> Regex
nameRegex String
n) (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t :: Maybe String
verRe :: Maybe String
verRe = String -> Maybe String
fromEmpty (String -> Maybe String)
-> (String -> String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> String -> String
forall regex source target.
RegexContext regex source target =>
regex -> source -> target
match Regex
verRegex (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t :: Maybe String
(Just String
name) <- Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(String -> Maybe String
nameRe String
"CentOS" Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe String
nameRe String
"Fedora" Maybe String -> Maybe String -> Maybe String
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe String
nameRe String
"Red Hat")
(Text, Maybe Text) -> IO (Text, Maybe Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
T.pack String
name, (String -> Text) -> Maybe String -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack Maybe String
verRe)
where
fromEmpty :: String -> Maybe String
fromEmpty :: String -> Maybe String
fromEmpty String
"" = Maybe String
forall a. Maybe a
Nothing
fromEmpty String
s' = String -> Maybe String
forall a. a -> Maybe a
Just String
s'
try_debian_version :: IO (Text, Maybe Text)
try_debian_version :: IO (Text, Maybe Text)
try_debian_version = do
Text
ver <- String -> IO Text
T.readFile String
debian_version
(Text, Maybe Text) -> IO (Text, Maybe Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
T.pack String
"debian", Text -> Maybe Text
forall a. a -> Maybe a
Just Text
ver)
getStackGhcBuilds :: (MonadReader env m, HasLog env, MonadIO m)
=> PlatformResult
-> Excepts '[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError] m [String]
getStackGhcBuilds :: forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
PlatformResult
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
getStackGhcBuilds PlatformResult{Maybe Versioning
Platform
$sel:_platform:PlatformResult :: PlatformResult -> Platform
$sel:_distroVersion:PlatformResult :: PlatformResult -> Maybe Versioning
_platform :: Platform
_distroVersion :: Maybe Versioning
..} = do
case Platform
_platform of
Linux LinuxDistro
_ -> do
[(String, String)]
sbinEnv <- IO [(String, String)]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[(String, String)]
forall a.
IO a
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(String, String)]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[(String, String)])
-> IO [(String, String)]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[(String, String)]
forall a b. (a -> b) -> a -> b
$ [String] -> Bool -> IO [(String, String)]
addToPath [String]
sbinDirs Bool
False
CapturedProcess
ldConfig <- m CapturedProcess
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
CapturedProcess
forall (m :: * -> *) a.
Monad m =>
m a
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m CapturedProcess
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
CapturedProcess)
-> m CapturedProcess
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
CapturedProcess
forall a b. (a -> b) -> a -> b
$ String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
String
-> [String]
-> Maybe String
-> Maybe [(String, String)]
-> m CapturedProcess
executeOut' String
"ldconfig" [String
"-p"] Maybe String
forall a. Maybe a
Nothing ([(String, String)] -> Maybe [(String, String)]
forall a. a -> Maybe a
Just [(String, String)]
sbinEnv)
[Text]
firstWords <- case CapturedProcess
ldConfig of
CapturedProcess ExitCode
ExitSuccess ByteString
so ByteString
_ ->
[Text]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[Text]
forall a.
a
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[Text])
-> (ByteString -> [Text])
-> ByteString
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Text) -> [Text] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe ([Text] -> Maybe Text) -> (Text -> [Text]) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.words) ([Text] -> [Text])
-> (ByteString -> [Text]) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines (Text -> [Text]) -> (ByteString -> Text) -> ByteString -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stripNewlineEnd (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe' (ByteString
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[Text])
-> ByteString
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[Text]
forall a b. (a -> b) -> a -> b
$ ByteString
so
CapturedProcess (ExitFailure Int
_) ByteString
_ ByteString
_ ->
[Text]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[Text]
forall a.
a
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
let checkLib :: (MonadReader env m, HasLog env, MonadIO m) => String -> m Bool
checkLib :: forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
String -> m Bool
checkLib String
lib
| Text
libT Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
firstWords = do
Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Found shared library " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
libT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in 'ldconfig -p' output"
Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
| Bool
isWindows =
Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
| Bool
otherwise = String -> [String] -> m Bool
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
String -> [String] -> m Bool
hasMatches String
lib [String]
usrLibDirs
where
libT :: Text
libT = String -> Text
T.pack String
lib
hasMatches :: (MonadReader env m, HasLog env, MonadIO m) => String -> [FilePath] -> m Bool
hasMatches :: forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
String -> [String] -> m Bool
hasMatches String
lib [String]
dirs = do
[String]
matches <- (String -> m Bool) -> [String] -> m [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (IO Bool -> m Bool
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> (String -> IO Bool) -> String -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist (String -> IO Bool) -> (String -> String) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
</> String
lib)) [String]
dirs
case [String]
matches of
[] -> Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
"Did not find shared library " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
libT) m () -> m Bool -> m Bool
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
(String
path:[String]
_) -> Text -> m ()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
"Found shared library " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
libT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
path) m () -> m Bool -> m Bool
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
where
libT :: Text
libT = String -> Text
T.pack String
lib
getLibc6Version :: MonadIO m
=> Excepts '[ParseError, ProcessError] m Version
getLibc6Version :: forall (m :: * -> *).
MonadIO m =>
Excepts '[ParseError, ProcessError] m Version
getLibc6Version = do
CapturedProcess{ExitCode
ByteString
$sel:_stdOut:CapturedProcess :: CapturedProcess -> ByteString
_exitCode :: ExitCode
_stdOut :: ByteString
_stdErr :: ByteString
$sel:_exitCode:CapturedProcess :: CapturedProcess -> ExitCode
$sel:_stdErr:CapturedProcess :: CapturedProcess -> ByteString
..} <- m CapturedProcess
-> Excepts '[ParseError, ProcessError] m CapturedProcess
forall (m :: * -> *) a.
Monad m =>
m a -> Excepts '[ParseError, ProcessError] m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m CapturedProcess
-> Excepts '[ParseError, ProcessError] m CapturedProcess)
-> m CapturedProcess
-> Excepts '[ParseError, ProcessError] m CapturedProcess
forall a b. (a -> b) -> a -> b
$ String -> [String] -> Maybe String -> m CapturedProcess
forall (m :: * -> *).
MonadIO m =>
String -> [String] -> Maybe String -> m CapturedProcess
executeOut String
"ldd" [String
"--version"] Maybe String
forall a. Maybe a
Nothing
case ExitCode
_exitCode of
ExitCode
ExitSuccess -> (ParsingError -> Excepts '[ParseError, ProcessError] m Version)
-> (Version -> Excepts '[ParseError, ProcessError] m Version)
-> Either ParsingError Version
-> Excepts '[ParseError, ProcessError] m Version
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ParseError -> Excepts '[ParseError, ProcessError] m Version
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (ParseError -> Excepts '[ParseError, ProcessError] m Version)
-> (ParsingError -> ParseError)
-> ParsingError
-> Excepts '[ParseError, ProcessError] m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ParseError
ParseError (String -> ParseError)
-> (ParsingError -> String) -> ParsingError -> ParseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsingError -> String
forall a. Show a => a -> String
show) Version -> Excepts '[ParseError, ProcessError] m Version
forall a. a -> Excepts '[ParseError, ProcessError] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Either ParsingError Version
-> Excepts '[ParseError, ProcessError] m Version)
-> (ByteString -> Either ParsingError Version)
-> ByteString
-> Excepts '[ParseError, ProcessError] m Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text Version
-> String -> Text -> Either ParsingError Version
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.parse Parsec Void Text Version
lddVersion String
"" (Text -> Either ParsingError Version)
-> (ByteString -> Text)
-> ByteString
-> Either ParsingError Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (ByteString -> String) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
stripNewlineEnd (String -> String)
-> (ByteString -> String) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decUTF8Safe' (ByteString -> Excepts '[ParseError, ProcessError] m Version)
-> ByteString -> Excepts '[ParseError, ProcessError] m Version
forall a b. (a -> b) -> a -> b
$ ByteString
_stdOut
ExitFailure Int
c -> ProcessError -> Excepts '[ParseError, ProcessError] m Version
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (ProcessError -> Excepts '[ParseError, ProcessError] m Version)
-> ProcessError -> Excepts '[ParseError, ProcessError] m Version
forall a b. (a -> b) -> a -> b
$ Int -> String -> [String] -> ProcessError
NonZeroExit Int
c String
"ldd" [String
"--version" ]
lddVersion :: MP.Parsec Void Text Version
lddVersion :: Parsec Void Text Version
lddVersion = do
(Char -> Bool) -> Parsec Void Text ()
skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
')')
(Char -> Bool) -> Parsec Void Text ()
skip (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
')')
Parsec Void Text ()
skipSpace
Parsec Void Text Version
version'
Bool
hasMusl <- String
-> [String]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
Bool
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
String -> [String] -> m Bool
hasMatches String
relFileLibcMuslx86_64So1 [String]
libDirs
Either (V '[ParseError, ProcessError]) Version
mLibc6Version <- VEither '[ParseError, ProcessError] Version
-> Either (V '[ParseError, ProcessError]) Version
forall (es :: [*]) a. VEither es a -> Either (V es) a
veitherToEither (VEither '[ParseError, ProcessError] Version
-> Either (V '[ParseError, ProcessError]) Version)
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
(VEither '[ParseError, ProcessError] Version)
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
(Either (V '[ParseError, ProcessError]) Version)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Excepts
'[ParseError, ProcessError]
(Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m)
Version
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
(VEither '[ParseError, ProcessError] Version)
forall (es :: [*]) a (m :: * -> *).
Excepts es m a -> m (VEither es a)
runE Excepts
'[ParseError, ProcessError]
(Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m)
Version
forall (m :: * -> *).
MonadIO m =>
Excepts '[ParseError, ProcessError] m Version
getLibc6Version
case Either (V '[ParseError, ProcessError]) Version
mLibc6Version of
Right Version
libc6Version -> Text
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
())
-> Text
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ Text
"Found shared library libc6 in version: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Version -> Text
prettyVer Version
libc6Version
Left V '[ParseError, ProcessError]
_ -> Text
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug Text
"Did not find a version of shared library libc6."
let hasLibc6_2_32 :: Bool
hasLibc6_2_32 = (V '[ParseError, ProcessError] -> Bool)
-> (Version -> Bool)
-> Either (V '[ParseError, ProcessError]) Version
-> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> V '[ParseError, ProcessError] -> Bool
forall a b. a -> b -> a
const Bool
False) (Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [vver|2.32|]) Either (V '[ParseError, ProcessError]) Version
mLibc6Version
Bool
hastinfo5 <- String
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
Bool
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
String -> m Bool
checkLib String
relFileLibtinfoSo5
Bool
hastinfo6 <- String
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
Bool
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
String -> m Bool
checkLib String
relFileLibtinfoSo6
Bool
hasncurses6 <- String
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
Bool
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
String -> m Bool
checkLib String
relFileLibncurseswSo6
Bool
hasgmp5 <- String
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
Bool
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
String -> m Bool
checkLib String
relFileLibgmpSo10
Bool
hasgmp4 <- String
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
Bool
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
String -> m Bool
checkLib String
relFileLibgmpSo3
let libComponents :: [[String]]
libComponents = if Bool
hasMusl
then
[ [String
"musl"] ]
else
[[[String]]] -> [[String]]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ if Bool
hastinfo6 Bool -> Bool -> Bool
&& Bool
hasgmp5
then
if Bool
hasLibc6_2_32
then [[String
"tinfo6"]]
else [[String
"tinfo6-libc6-pre232"]]
else [[]]
, [ [] | Bool
hastinfo5 Bool -> Bool -> Bool
&& Bool
hasgmp5 ]
, [ [String
"ncurses6"] | Bool
hasncurses6 Bool -> Bool -> Bool
&& Bool
hasgmp5 ]
, [ [String
"gmp4"] | Bool
hasgmp4 ]
]
[String]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
forall a.
a
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String])
-> [String]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
forall a b. (a -> b) -> a -> b
$ ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map
(\[String]
c -> case [String]
c of
[] -> []
[String]
_ -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"-" [String]
c)
[[String]]
libComponents
Platform
FreeBSD ->
case Maybe Versioning
_distroVersion of
Just Versioning
fVer
| Versioning
fVer Versioning -> Versioning -> Bool
forall a. Ord a => a -> a -> Bool
>= [vers|12|] -> [String]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
forall a.
a
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Maybe Versioning
_ -> [String]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
forall a.
a
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"ino64"]
Platform
Darwin -> [String]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
forall a.
a
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Platform
Windows -> [String]
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
forall a.
a
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
where
relFileLibcMuslx86_64So1 :: FilePath
relFileLibcMuslx86_64So1 :: String
relFileLibcMuslx86_64So1 = String
"libc.musl-x86_64.so.1"
libDirs :: [FilePath]
libDirs :: [String]
libDirs = [String
"/lib", String
"/lib64"]
usrLibDirs :: [FilePath]
usrLibDirs :: [String]
usrLibDirs = [String
"/usr/lib", String
"/usr/lib64"]
sbinDirs :: [FilePath]
sbinDirs :: [String]
sbinDirs = [String
"/sbin", String
"/usr/sbin"]
relFileLibtinfoSo5 :: FilePath
relFileLibtinfoSo5 :: String
relFileLibtinfoSo5 = String
"libtinfo.so.5"
relFileLibtinfoSo6 :: FilePath
relFileLibtinfoSo6 :: String
relFileLibtinfoSo6 = String
"libtinfo.so.6"
relFileLibncurseswSo6 :: FilePath
relFileLibncurseswSo6 :: String
relFileLibncurseswSo6 = String
"libncursesw.so.6"
relFileLibgmpSo10 :: FilePath
relFileLibgmpSo10 :: String
relFileLibgmpSo10 = String
"libgmp.so.10"
relFileLibgmpSo3 :: FilePath
relFileLibgmpSo3 :: String
relFileLibgmpSo3 = String
"libgmp.so.3"
getStackOSKey :: Monad m => PlatformRequest -> Excepts '[UnsupportedSetupCombo] m String
getStackOSKey :: forall (m :: * -> *).
Monad m =>
PlatformRequest -> Excepts '[UnsupportedSetupCombo] m String
getStackOSKey PlatformRequest { Maybe Versioning
Platform
Architecture
_rArch :: Architecture
_rPlatform :: Platform
_rVersion :: Maybe Versioning
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
.. } =
case (Architecture
_rArch, Platform
_rPlatform) of
(Architecture
A_32 , Linux LinuxDistro
_) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"linux32"
(Architecture
A_64 , Linux LinuxDistro
_) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"linux64"
(Architecture
A_32 , Platform
Darwin ) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"macosx"
(Architecture
A_64 , Platform
Darwin ) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"macosx"
(Architecture
A_32 , Platform
FreeBSD) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"freebsd32"
(Architecture
A_64 , Platform
FreeBSD) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"freebsd64"
(Architecture
A_32 , Platform
Windows) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"windows32"
(Architecture
A_64 , Platform
Windows) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"windows64"
(Architecture
A_ARM , Linux LinuxDistro
_) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"linux-armv7"
(Architecture
A_ARM64, Linux LinuxDistro
_) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"linux-aarch64"
(Architecture
A_Sparc, Linux LinuxDistro
_) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"linux-sparc"
(Architecture
A_ARM64, Platform
Darwin ) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"macosx-aarch64"
(Architecture
A_ARM64, Platform
FreeBSD) -> String -> Excepts '[UnsupportedSetupCombo] m String
forall a. a -> Excepts '[UnsupportedSetupCombo] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"freebsd-aarch64"
(Architecture
arch', Platform
os') -> UnsupportedSetupCombo -> Excepts '[UnsupportedSetupCombo] m String
forall e (es :: [*]) a (m :: * -> *).
(Monad m, e :< es) =>
e -> Excepts es m a
throwE (UnsupportedSetupCombo
-> Excepts '[UnsupportedSetupCombo] m String)
-> UnsupportedSetupCombo
-> Excepts '[UnsupportedSetupCombo] m String
forall a b. (a -> b) -> a -> b
$ Architecture -> Platform -> UnsupportedSetupCombo
UnsupportedSetupCombo Architecture
arch' Platform
os'
getStackPlatformKey :: (MonadReader env m, MonadFail m, HasLog env, MonadCatch m, MonadIO m)
=> PlatformRequest
-> Excepts '[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform, NoCompatibleArch, DistroNotFound, ProcessError] m [String]
getStackPlatformKey :: forall env (m :: * -> *).
(MonadReader env m, MonadFail m, HasLog env, MonadCatch m,
MonadIO m) =>
PlatformRequest
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
[String]
getStackPlatformKey pfreq :: PlatformRequest
pfreq@PlatformRequest{Maybe Versioning
Platform
Architecture
$sel:_rArch:PlatformRequest :: PlatformRequest -> Architecture
$sel:_rPlatform:PlatformRequest :: PlatformRequest -> Platform
$sel:_rVersion:PlatformRequest :: PlatformRequest -> Maybe Versioning
_rArch :: Architecture
_rPlatform :: Platform
_rVersion :: Maybe Versioning
..} = do
String
osKey <- Excepts '[UnsupportedSetupCombo] m String
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
String
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts '[UnsupportedSetupCombo] m String
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
String)
-> Excepts '[UnsupportedSetupCombo] m String
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
String
forall a b. (a -> b) -> a -> b
$ PlatformRequest -> Excepts '[UnsupportedSetupCombo] m String
forall (m :: * -> *).
Monad m =>
PlatformRequest -> Excepts '[UnsupportedSetupCombo] m String
getStackOSKey PlatformRequest
pfreq
[String]
builds <- Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
[String]
forall (es' :: [*]) (es :: [*]) a (m :: * -> *).
(Monad m, VEitherLift es es') =>
Excepts es m a -> Excepts es' m a
liftE (Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
[String])
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
[String]
forall a b. (a -> b) -> a -> b
$ PlatformResult
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
forall env (m :: * -> *).
(MonadReader env m, HasLog env, MonadIO m) =>
PlatformResult
-> Excepts
'[ParseError, NoCompatiblePlatform, DistroNotFound, ProcessError]
m
[String]
getStackGhcBuilds (Platform -> Maybe Versioning -> PlatformResult
PlatformResult Platform
_rPlatform Maybe Versioning
_rVersion)
let builds' :: [String]
builds' = (\String
build -> if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
build then String
osKey else String
osKey String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
build) (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
builds
Text
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
()
forall env (m :: * -> *).
(MonadReader env m,
LabelOptic' "loggerConfig" A_Lens env LoggerConfig, MonadIO m) =>
Text -> m ()
logDebug (Text
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
())
-> Text
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
()
forall a b. (a -> b) -> a -> b
$ Text
"Potential GHC builds: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat (Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
L.intersperse Text
", " ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack [String]
builds')
[String]
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
[String]
forall a.
a
-> Excepts
'[UnsupportedSetupCombo, ParseError, NoCompatiblePlatform,
NoCompatibleArch, DistroNotFound, ProcessError]
m
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
builds'