{-# LANGUAGE CPP                   #-}
{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE QuasiQuotes           #-}
{-# LANGUAGE TemplateHaskellQuotes #-}


{-|
Module      : GHCup.Platform
Description : Retrieving platform information
Copyright   : (c) Julian Ospald, 2020
License     : LGPL-3.0
Maintainer  : hasufell@hasufell.de
Stability   : experimental
Portability : portable
-}
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




    --------------------------
    --[ Platform detection ]--
    --------------------------


-- | Get the full platform request, consisting of architecture, distro, ...
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
          -- TODO: maybe do this somewhere else
          (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
  -- TODO: don't do alternative on IO, because it hides bugs
  (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
        -- https://github.com/void-linux/void-packages/blob/master/srcpkgs/base-files/files/os-release
        | 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
        -- Some systems don't have ldconfig in the PATH, so make sure to look in
        -- /sbin and /usr/sbin as well
        [(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
_ ->
                          -- throwE $ NonZeroExit c "ldconfig" ["-p" ]
                          [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 =
                  -- Cannot parse /usr/lib on Windows
                  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
              -- This is a workaround for the fact that libtinfo.so.x doesn't
              -- appear in the 'ldconfig -p' output on Arch or Slackware even
              -- when it exists. There doesn't seem to be an easy way to get the
              -- true list of directories to scan for shared libs, but this
              -- works for our particular cases.
             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" ]

            -- Assumes the first line of ldd has the format:
            --
            -- ldd (...) nn.nn
            --
            -- where nn.nn corresponds to the version of libc6.
            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'