Skip to content

Commit d04a9bb

Browse files
hasufellhasufell
committed
Merge branch 'opensuse'
2 parents d4cde3e + 23b8de1 commit d04a9bb

File tree

7 files changed

+5367
-19829
lines changed

7 files changed

+5367
-19829
lines changed

‎lib/GHCup/Platform.hs‎

Lines changed: 28 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,7 @@ import Prelude hiding ( abs
4949
, writeFile
5050
)
5151
import System.Info
52-
import System.OsRelease
52+
import System.OsRelease as OSR
5353
import System.Exit
5454
import System.FilePath
5555
import Text.PrettyPrint.HughesPJClass ( prettyShow )
@@ -134,33 +134,34 @@ getLinuxDistro :: (Alternative m, MonadCatch m, MonadIO m, MonadFail m)
134134
=> Excepts '[DistroNotFound] m (LinuxDistro, Maybe Versioning)
135135
getLinuxDistro = do
136136
-- TODO: don't do alternative on IO, because it hides bugs
137-
(name, ver) <- handleIO (\_ -> throwE DistroNotFound) $ lift $ asum
137+
(name, mid, ver) <- handleIO (\_ -> throwE DistroNotFound) $ lift $ asum
138138
[ liftIO try_os_release
139139
, try_lsb_release_cmd
140140
, liftIO try_redhat_release
141141
, liftIO try_debian_version
142142
]
143+
let hasWord xs = let f t = any (\x -> match (regex x) (T.unpack t)) xs
144+
in f name || maybe False f mid
143145
let parsedVer = ver >>= either (const Nothing) Just . versioning
144146
distro = if
145-
| hasWord name ["debian"] -> Debian
146-
| hasWord name ["ubuntu"] -> Ubuntu
147-
| hasWord name ["linuxmint", "Linux Mint"] -> Mint
148-
| hasWord name ["fedora"] -> Fedora
149-
| hasWord name ["centos"] -> CentOS
150-
| hasWord name ["Red Hat"] -> RedHat
151-
| hasWord name ["alpine"] -> Alpine
152-
| hasWord name ["exherbo"] -> Exherbo
153-
| hasWord name ["gentoo"] -> Gentoo
154-
| hasWord name ["amazonlinux", "Amazon Linux"] -> AmazonLinux
155-
| hasWord name ["rocky", "Rocky Linux"] -> Rocky
147+
| hasWord ["debian"] -> Debian
148+
| hasWord ["ubuntu"] -> Ubuntu
149+
| hasWord ["linuxmint", "Linux Mint"] -> Mint
150+
| hasWord ["fedora"] -> Fedora
151+
| hasWord ["centos"] -> CentOS
152+
| hasWord ["Red Hat"] -> RedHat
153+
| hasWord ["alpine"] -> Alpine
154+
| hasWord ["exherbo"] -> Exherbo
155+
| hasWord ["gentoo"] -> Gentoo
156+
| hasWord ["opensuse", "suse"] -> OpenSUSE
157+
| hasWord ["amazonlinux", "Amazon Linux"] -> AmazonLinux
158+
| hasWord ["rocky", "Rocky Linux"] -> Rocky
156159
-- https://github.com/void-linux/void-packages/blob/master/srcpkgs/base-files/files/os-release
157-
| hasWord name ["void", "Void Linux"] -> Void
158-
| otherwise -> UnknownLinux
160+
| hasWord ["void", "Void Linux"] -> Void
161+
| otherwise -> OtherLinux (T.unpack $ fromMaybe name mid)
159162
pure (distro, parsedVer)
160163
where
161-
hasWord t = any (\x -> match (regex x) (T.unpack t))
162-
where
163-
regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])
164+
regex x = makeRegexOpts compIgnoreCase execBlank ([s|\<|] ++ x ++ [s|\>|])
164165

165166
lsb_release_cmd :: FilePath
166167
lsb_release_cmd = "lsb-release"
@@ -169,21 +170,21 @@ getLinuxDistro = do
169170
debian_version :: FilePath
170171
debian_version = "/etc/debian_version"
171172

172-
try_os_release :: IO (Text, Maybe Text)
173+
try_os_release :: IO (Text, Maybe Text, Maybe Text)
173174
try_os_release = do
174-
Just OsRelease{ name = name, version_id = version_id } <-
175+
Just OsRelease{ name = name, version_id = version_id, OSR.id = id' } <-
175176
fmap osRelease <$> parseOsRelease
176-
pure (T.pack name, fmap T.pack version_id)
177+
pure (T.pack name, Just (T.pack id'), fmap T.pack version_id)
177178

178179
try_lsb_release_cmd :: (MonadFail m, MonadIO m)
179-
=> m (Text, Maybe Text)
180+
=> m (Text, Maybe Text, Maybe Text)
180181
try_lsb_release_cmd = do
181182
(Just _) <- liftIO $ findExecutable lsb_release_cmd
182183
name <- fmap _stdOut $ executeOut lsb_release_cmd ["-si"] Nothing
183184
ver <- fmap _stdOut $ executeOut lsb_release_cmd ["-sr"] Nothing
184-
pure (decUTF8Safe' name, Just $ decUTF8Safe' ver)
185+
pure (decUTF8Safe' name, Nothing, Just $ decUTF8Safe' ver)
185186

186-
try_redhat_release :: IO (Text, Maybe Text)
187+
try_redhat_release :: IO (Text, Maybe Text, Maybe Text)
187188
try_redhat_release = do
188189
t <- T.readFile redhat_release
189190
let nameRegex n =
@@ -199,16 +200,16 @@ getLinuxDistro = do
199200
verRe = fromEmpty . match verRegex $ T.unpack t :: Maybe String
200201
(Just name) <- pure
201202
(nameRe "CentOS" <|> nameRe "Fedora" <|> nameRe "Red Hat")
202-
pure (T.pack name, fmap T.pack verRe)
203+
pure (T.pack name, Nothing, fmap T.pack verRe)
203204
where
204205
fromEmpty :: String -> Maybe String
205206
fromEmpty "" = Nothing
206207
fromEmpty s' = Just s'
207208

208-
try_debian_version :: IO (Text, Maybe Text)
209+
try_debian_version :: IO (Text, Maybe Text, Maybe Text)
209210
try_debian_version = do
210211
ver <- T.readFile debian_version
211-
pure (T.pack "debian", Just ver)
212+
pure (T.pack "debian", Just (T.pack "debian"), Just ver)
212213

213214

214215
getStackGhcBuilds :: (MonadReader env m, HasLog env, MonadIO m)

‎lib/GHCup/Types.hs‎

Lines changed: 42 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -257,10 +257,49 @@ data LinuxDistro = Debian
257257
-- rolling
258258
| Gentoo
259259
| Exherbo
260+
| OpenSUSE
260261
-- not known
261262
| UnknownLinux
262263
-- ^ must exit
263-
deriving (Eq, GHC.Generic, Ord, Show, Enum, Bounded)
264+
| OtherLinux String
265+
deriving (Eq, GHC.Generic, Ord, Show)
266+
267+
instance Enum LinuxDistro where
268+
toEnum 0 = Debian
269+
toEnum 1 = Ubuntu
270+
toEnum 2 = Mint
271+
toEnum 3 = Fedora
272+
toEnum 4 = CentOS
273+
toEnum 5 = RedHat
274+
toEnum 6 = Alpine
275+
toEnum 7 = AmazonLinux
276+
toEnum 8 = Rocky
277+
toEnum 9 = Void
278+
toEnum 10 = Gentoo
279+
toEnum 11 = Exherbo
280+
toEnum 12 = OpenSUSE
281+
toEnum 13 = UnknownLinux
282+
toEnum _ = error "toEnum: out of bounds"
283+
284+
fromEnum Debian = 0
285+
fromEnum Ubuntu = 1
286+
fromEnum Mint = 2
287+
fromEnum Fedora = 3
288+
fromEnum CentOS = 4
289+
fromEnum RedHat = 5
290+
fromEnum Alpine = 6
291+
fromEnum AmazonLinux = 7
292+
fromEnum Rocky = 8
293+
fromEnum Void = 9
294+
fromEnum Gentoo = 10
295+
fromEnum Exherbo = 11
296+
fromEnum OpenSUSE = 12
297+
fromEnum UnknownLinux = 13
298+
fromEnum (OtherLinux _) = error "fromEnum: OtherLinux"
299+
300+
instance Bounded LinuxDistro where
301+
minBound = Debian
302+
maxBound = UnknownLinux
264303

265304
allDistros :: [LinuxDistro]
266305
allDistros = enumFromTo minBound maxBound
@@ -280,7 +319,9 @@ distroToString Rocky = "rocky"
280319
distroToString Void = "void"
281320
distroToString Gentoo = "gentoo"
282321
distroToString Exherbo = "exherbo"
322+
distroToString OpenSUSE = "opensuse"
283323
distroToString UnknownLinux = "unknown"
324+
distroToString (OtherLinux str) = str
284325

285326
instance Pretty LinuxDistro where
286327
pPrint = text . distroToString

‎lib/GHCup/Types/JSON.hs‎

Lines changed: 22 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,10 +48,30 @@ import qualified Data.Text.Encoding.Error as E
4848
import qualified Text.Megaparsec as MP
4949
import qualified Text.Megaparsec.Char as MPC
5050

51+
instance ToJSON LinuxDistro where
52+
toJSON (OtherLinux x) = String (T.pack x)
53+
toJSON x = String . T.pack . show $ x
54+
55+
instance FromJSON LinuxDistro where
56+
parseJSON = withText "LinuxDistro" $ \t -> case T.unpack (T.toLower t) of
57+
"debian" -> pure Debian
58+
"ubuntu" -> pure Ubuntu
59+
"mint" -> pure Mint
60+
"fedora" -> pure Fedora
61+
"centos" -> pure CentOS
62+
"redhat" -> pure RedHat
63+
"alpine" -> pure Alpine
64+
"amazonlinux" -> pure AmazonLinux
65+
"rocky" -> pure Rocky
66+
"void" -> pure Void
67+
"gentoo" -> pure Gentoo
68+
"exherbo" -> pure Exherbo
69+
"opensuse" -> pure OpenSUSE
70+
"unknownlinux" -> pure UnknownLinux
71+
_ -> pure (OtherLinux $ T.unpack t)
5172

5273
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MetaMode
5374
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Architecture
54-
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''LinuxDistro
5575
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''VSep
5676
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''MChunk
5777
deriveJSON defaultOptions { fieldLabelModifier = removeLensFieldLabel } ''Platform
@@ -121,6 +141,7 @@ instance ToJSONKey Platform where
121141
toJSONKey = toJSONKeyText $ \case
122142
Darwin -> T.pack "Darwin"
123143
FreeBSD -> T.pack "FreeBSD"
144+
Linux (OtherLinux s) -> T.pack ("Linux_" <> s)
124145
Linux d -> T.pack ("Linux_" <> show d)
125146
Windows -> T.pack "Windows"
126147

‎test/ghcup-test/GHCup/ArbitraryTypes.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -136,8 +136,9 @@ instance Arbitrary DownloadInfo where
136136
shrink = genericShrink
137137

138138
instance Arbitrary LinuxDistro where
139-
arbitrary = genericArbitrary
140-
shrink = genericShrink
139+
arbitrary = do
140+
let other = OtherLinux <$> listOf (elements ['a' .. 'z'])
141+
oneof (other:(pure <$> allDistros))
141142

142143
instance Arbitrary Platform where
143144
arbitrary = genericArbitrary

‎test/ghcup-test/GHCup/Types/JSONSpec.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -14,7 +14,8 @@ import Test.Hspec
1414

1515
spec :: Spec
1616
spec = do
17-
roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir }) (Proxy @GHCupInfo)
17+
roundtripSpecs (Proxy @LinuxDistro)
18+
roundtripAndGoldenSpecsWithSettings (defaultSettings { goldenDirectoryOption = CustomDirectoryName goldenDir, sampleSize = 2 }) (Proxy @GHCupInfo)
1819
where
1920
goldenDir
2021
| isWindows = "test/ghcup-test/golden/windows"

0 commit comments

Comments
 (0)