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


{-|
Module      : GHCup.Plaform
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.File
import           GHCup.Utils.Logger
import           GHCup.Utils.Prelude
import           GHCup.Utils.String.QQ

#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.Directory
import           System.OsRelease
import           Text.PrettyPrint.HughesPJClass ( prettyShow )
import           Text.Regex.Posix

import qualified Data.Text                     as T
import qualified Data.Text.IO                  as T



    --------------------------
    --[ 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 :: 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 (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 :: 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 (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 :: Platform -> Maybe Versioning -> PlatformResult
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 (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 :: Platform -> Maybe Versioning -> PlatformResult
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 (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 :: Platform -> Maybe Versioning -> PlatformResult
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 (f :: * -> *) a. Applicative f => a -> f a
pure PlatformResult :: Platform -> Maybe Versioning -> PlatformResult
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 (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 (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 (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 (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 (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 (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 :: 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 (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 (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 (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 (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 (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
        | Bool
otherwise                -> LinuxDistro
UnknownLinux
  (LinuxDistro, Maybe Versioning)
-> Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning)
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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
T.pack String
name, (String -> Text) -> Maybe String -> Maybe Text
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 :: m (Text, Maybe Text)
try_lsb_release_cmd = do
    (Just String
_) <- IO (Maybe String) -> m (Maybe String)
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 (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 (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure
      (String -> Maybe String
nameRe String
"CentOS" Maybe String -> Maybe String -> Maybe String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> Maybe String
nameRe String
"Fedora" Maybe String -> Maybe String -> Maybe String
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 (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Text
T.pack String
name, (String -> Text) -> Maybe String -> Maybe Text
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 (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)