Use yaml instead of pesky json

This commit is contained in:
Julian Ospald 2020-08-09 17:39:02 +02:00
parent 34e4ece8b5
commit 391676e90a
No known key found for this signature in database
GPG Key ID: 511B62C09D50CD28
11 changed files with 1371 additions and 5000 deletions

View File

@ -11,7 +11,7 @@ ecabal() {
} }
eghcup() { eghcup() {
ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.json "$@" ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml "$@"
} }
git describe --always git describe --always
@ -42,7 +42,7 @@ rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
### manual cli based testing ### manual cli based testing
ghcup-gen check -f ghcup-${JSON_VERSION}.json ghcup-gen check -f ghcup-${JSON_VERSION}.yaml
eghcup --numeric-version eghcup --numeric-version

View File

@ -1,19 +1,19 @@
# RELEASING # RELEASING
1. update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `_toolRequirements` type or the JSON representation of it. The version of the json represents the change increments. `ghcUpVer` is the current application version. 1. update `GHCup.Version` module. `ghcupURL` must only be updated if we change the `_toolRequirements` type or the YAML representation of it. The version of the YAML represents the change increments. `ghcUpVer` is the current application version.
2. Update version in ghcup.cabal 2. Update version in ghcup.cabal
3. Add ChangeLog entry 3. Add ChangeLog entry
4. Add/fix downloads to `GHCupDownloads` module, then run `ghcup-gen gen` to generate the new json and validate it via `ghcup-gen check`. 4. Add/fix downloads in `ghcup-<ver>.yaml`, then verify with `ghcup-gen check -f ghcup-<ver>.yaml`
5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build. 5. Commit and git push with tag. Wait for tests to succeed and release artifacts to build.
6. Download release artifacts and upload them `downloads.haskell.org/ghcup` 6. Download release artifacts and upload them `downloads.haskell.org/ghcup`
7. Add release artifacts to GHCupDownloads (see point 4.) 7. Add release artifacts to yaml file (see point 4.)
8. Upload the final `ghcup-<ver>.json` to `webhost.haskell.org/ghcup/data/`. 8. Upload the final `ghcup-<ver>.yaml` to `webhost.haskell.org/ghcup/data/`.
9. Update bootstrap-haskell and symlinks on `downloads.haskell.org/ghcup` 9. Update bootstrap-haskell and symlinks on `downloads.haskell.org/ghcup`

View File

@ -10,13 +10,10 @@
module Main where module Main where
import GHCup.Data.GHCupInfo
import GHCup.Types import GHCup.Types
import GHCup.Types.JSON ( ) import GHCup.Types.JSON ( )
import GHCup.Utils.Logger import GHCup.Utils.Logger
import Data.Aeson ( eitherDecode, encode )
import Data.Aeson.Encode.Pretty
#if !MIN_VERSION_base(4,13,0) #if !MIN_VERSION_base(4,13,0)
import Data.Semigroup ( (<>) ) import Data.Semigroup ( (<>) )
#endif #endif
@ -27,48 +24,15 @@ import System.IO ( stdout )
import Validate import Validate
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L import qualified Data.Yaml as Y
data Options = Options data Options = Options
{ optCommand :: Command { optCommand :: Command
} }
data Command = GenJSON GenJSONOpts data Command = ValidateYAML ValidateYAMLOpts
| ValidateJSON ValidateJSONOpts | ValidateTarballs ValidateYAMLOpts
| ValidateTarballs ValidateJSONOpts
data Output
= FileOutput FilePath -- optsparse-applicative doesn't handle ByteString correctly anyway
| StdOutput
fileOutput :: Parser Output
fileOutput =
FileOutput
<$> (strOption
(long "file" <> short 'f' <> metavar "FILENAME" <> help
"Output to a file"
)
)
stdOutput :: Parser Output
stdOutput = flag'
StdOutput
(short 'o' <> long "stdout" <> help "Print to stdout (default)")
outputP :: Parser Output
outputP = fileOutput <|> stdOutput
data GenJSONOpts = GenJSONOpts
{ output :: Maybe Output
, pretty :: Bool
}
genJSONOpts :: Parser GenJSONOpts
genJSONOpts = GenJSONOpts <$> optional outputP <*> switch
(short 'p' <> long "pretty" <> help "Make JSON output pretty (human readable)"
)
data Input data Input
@ -92,12 +56,12 @@ stdInput = flag'
inputP :: Parser Input inputP :: Parser Input
inputP = fileInput <|> stdInput inputP = fileInput <|> stdInput
data ValidateJSONOpts = ValidateJSONOpts data ValidateYAMLOpts = ValidateYAMLOpts
{ input :: Maybe Input { vInput :: Maybe Input
} }
validateJSONOpts :: Parser ValidateJSONOpts validateYAMLOpts :: Parser ValidateYAMLOpts
validateJSONOpts = ValidateJSONOpts <$> optional inputP validateYAMLOpts = ValidateYAMLOpts <$> optional inputP
opts :: Parser Options opts :: Parser Options
opts = Options <$> com opts = Options <$> com
@ -105,18 +69,10 @@ opts = Options <$> com
com :: Parser Command com :: Parser Command
com = subparser com = subparser
( (command ( (command
"gen"
( GenJSON
<$> (info (genJSONOpts <**> helper)
(progDesc "Generate the json downloads file")
)
)
)
<> (command
"check" "check"
( ValidateJSON ( ValidateYAML
<$> (info (validateJSONOpts <**> helper) <$> (info (validateYAMLOpts <**> helper)
(progDesc "Validate the JSON") (progDesc "Validate the YAML")
) )
) )
) )
@ -124,7 +80,7 @@ com = subparser
"check-tarballs" "check-tarballs"
( ValidateTarballs ( ValidateTarballs
<$> (info <$> (info
(validateJSONOpts <**> helper) (validateYAMLOpts <**> helper)
(progDesc "Validate all tarballs (download and checksum)") (progDesc "Validate all tarballs (download and checksum)")
) )
) )
@ -135,38 +91,27 @@ com = subparser
main :: IO () main :: IO ()
main = do main = do
customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm) _ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
>>= \Options {..} -> case optCommand of >>= \Options {..} -> case optCommand of
GenJSON gopts -> do ValidateYAML vopts -> case vopts of
let bs True = ValidateYAMLOpts { vInput = Nothing } ->
encodePretty' (defConfig { confIndent = Spaces 2 }) ghcupInfo B.getContents >>= valAndExit validate
bs False = encode ghcupInfo ValidateYAMLOpts { vInput = Just StdInput } ->
case gopts of B.getContents >>= valAndExit validate
GenJSONOpts { output = Nothing, pretty } -> ValidateYAMLOpts { vInput = Just (FileInput file) } ->
L.hPutStr stdout (bs pretty) B.readFile file >>= valAndExit validate
GenJSONOpts { output = Just StdOutput, pretty } ->
L.hPutStr stdout (bs pretty)
GenJSONOpts { output = Just (FileOutput file), pretty } ->
L.writeFile file (bs pretty)
ValidateJSON vopts -> case vopts of
ValidateJSONOpts { input = Nothing } ->
L.getContents >>= valAndExit validate
ValidateJSONOpts { input = Just StdInput } ->
L.getContents >>= valAndExit validate
ValidateJSONOpts { input = Just (FileInput file) } ->
L.readFile file >>= valAndExit validate
ValidateTarballs vopts -> case vopts of ValidateTarballs vopts -> case vopts of
ValidateJSONOpts { input = Nothing } -> ValidateYAMLOpts { vInput = Nothing } ->
L.getContents >>= valAndExit validateTarballs B.getContents >>= valAndExit validateTarballs
ValidateJSONOpts { input = Just StdInput } -> ValidateYAMLOpts { vInput = Just StdInput } ->
L.getContents >>= valAndExit validateTarballs B.getContents >>= valAndExit validateTarballs
ValidateJSONOpts { input = Just (FileInput file) } -> ValidateYAMLOpts { vInput = Just (FileInput file) } ->
L.readFile file >>= valAndExit validateTarballs B.readFile file >>= valAndExit validateTarballs
pure () pure ()
where where
valAndExit f contents = do valAndExit f contents = do
(GHCupInfo _ av) <- case eitherDecode contents of (GHCupInfo _ av) <- case Y.decodeEither' contents of
Right r -> pure r Right r -> pure r
Left e -> die (color Red $ show e) Left e -> die (color Red $ show e)
myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av) myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av)

File diff suppressed because it is too large Load Diff

1322
ghcup-0.0.2.yaml Normal file

File diff suppressed because it is too large Load Diff

View File

@ -219,6 +219,9 @@ common vty
common word8 common word8
build-depends: word8 >=0.1.3 build-depends: word8 >=0.1.3
common yaml
build-depends: yaml >=0.11.4.0
common zlib common zlib
build-depends: zlib >=0.6.2.1 build-depends: zlib >=0.6.2.1
@ -291,13 +294,11 @@ library
, vector , vector
, versions , versions
, word8 , word8
, yaml
, zlib , zlib
exposed-modules: exposed-modules:
GHCup GHCup
GHCup.Data.GHCupDownloads
GHCup.Data.GHCupInfo
GHCup.Data.ToolRequirements
GHCup.Download GHCup.Download
GHCup.Download.Utils GHCup.Download.Utils
GHCup.Errors GHCup.Errors
@ -413,6 +414,7 @@ executable ghcup-gen
, uri-bytestring , uri-bytestring
, utf8-string , utf8-string
, versions , versions
, yaml
-- --
main-is: Main.hs main-is: Main.hs

File diff suppressed because it is too large Load Diff

View File

@ -1,20 +0,0 @@
{-|
Module : GHCup.Data.GHCupInfo
Description :
Copyright : (c) Julian Ospald, 2020
License : GPL-3
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : POSIX
-}
module GHCup.Data.GHCupInfo where
import GHCup.Data.GHCupDownloads
import GHCup.Data.ToolRequirements
import GHCup.Types
ghcupInfo :: GHCupInfo
ghcupInfo = GHCupInfo { _toolRequirements = toolRequirements
, _ghcupDownloads = ghcupDownloads
}

View File

@ -1,156 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-|
Module : GHCup.Data.ToolRequirements
Description : Tool requirements
Copyright : (c) Julian Ospald, 2020
License : GPL-3
Maintainer : hasufell@hasufell.de
Stability : experimental
Portability : POSIX
-}
module GHCup.Data.ToolRequirements where
import GHCup.Types
import GHCup.Utils.String.QQ
import GHCup.Utils.Version.QQ
import qualified Data.Map as M
-- | Currently 'GHC' is used for both GHC and cabal to simplify
-- this, until we need actual separation.
toolRequirements :: ToolRequirements
toolRequirements = M.fromList
[ ( GHC
, M.fromList
[ ( Nothing
, M.fromList
[ ( Linux UnknownLinux
, M.fromList
[ ( Nothing
, Requirements
[]
[s|You need the following packages: curl g++ gcc gmp make ncurses realpath xz-utils. Consult your distro documentation on the exact names of those packages.|]
)
]
)
, ( Linux Alpine
, M.fromList
[ ( Nothing
, Requirements
[ "curl"
, "gcc"
, "g++"
, "gmp-dev"
, "ncurses-dev"
, "libffi-dev"
, "make"
, "xz"
, "tar"
, "perl"
]
""
)
]
)
, ( Linux Ubuntu
, M.fromList
[ ( Nothing
, Requirements
[ "build-essential"
, "curl"
, "libffi-dev"
, "libffi6"
, "libgmp-dev"
, "libgmp10"
, "libncurses-dev"
, "libncurses5"
, "libtinfo5"
]
""
)
]
)
, ( Linux Debian
, M.fromList
[ ( Nothing
, Requirements
[ "build-essential"
, "curl"
, "libffi-dev"
, "libffi6"
, "libgmp-dev"
, "libgmp10"
, "libncurses-dev"
, "libncurses5"
, "libtinfo5"
]
""
)
]
)
, ( Linux CentOS
, M.fromList
[ ( Nothing
, Requirements
[ "gcc"
, "gcc-c++"
, "gmp"
, "gmp-devel"
, "make"
, "ncurses"
, "ncurses-compat-libs"
, "xz"
, "perl"
]
""
),
( Just [vers|7|]
, Requirements
[ "gcc"
, "gcc-c++"
, "gmp"
, "gmp-devel"
, "make"
, "ncurses"
, "xz"
, "perl"
]
""
)
]
)
, ( Darwin
, M.fromList
[ ( Nothing
, Requirements
[]
"On OS X, in the course of running ghcup you will be given a dialog box to install the command line tools. Accept and the requirements will be installed for you. You will then need to run the command again."
)
]
)
, ( FreeBSD
, M.fromList
[ ( Nothing
, Requirements
[ "curl"
, "gcc"
, "gmp"
, "gmake"
, "ncurses"
, "perl5"
, "libffi"
, "libiconv"
]
""
)
]
)
]
)
]
)
]

View File

@ -52,6 +52,7 @@ import Control.Monad.Reader
import Control.Monad.Trans.Resource import Control.Monad.Trans.Resource
hiding ( throwM ) hiding ( throwM )
import Data.Aeson import Data.Aeson
import Data.Bifunctor
import Data.ByteString ( ByteString ) import Data.ByteString ( ByteString )
#if defined(INTERNAL_DOWNLOADER) #if defined(INTERNAL_DOWNLOADER)
import Data.CaseInsensitive ( CI ) import Data.CaseInsensitive ( CI )
@ -88,6 +89,7 @@ import qualified Data.Map.Strict as M
import qualified Data.Text as T import qualified Data.Text as T
#endif #endif
import qualified Data.Text.Encoding as E import qualified Data.Text.Encoding as E
import qualified Data.Yaml as Y
import qualified System.Posix.Files.ByteString as PF import qualified System.Posix.Files.ByteString as PF
import qualified System.Posix.RawFilePath.Directory import qualified System.Posix.RawFilePath.Directory
as RD as RD
@ -103,7 +105,7 @@ import qualified System.Posix.RawFilePath.Directory
-- | Like 'getDownloads', but tries to fall back to -- | Like 'getDownloads', but tries to fall back to
-- cached ~/.ghcup/cache/ghcup-<format-ver>.json -- cached ~/.ghcup/cache/ghcup-<format-ver>.yaml
getDownloadsF :: ( FromJSONKey Tool getDownloadsF :: ( FromJSONKey Tool
, FromJSONKey Version , FromJSONKey Version
, FromJSON VersionInfo , FromJSON VersionInfo
@ -135,13 +137,13 @@ getDownloadsF urlSource = do
[i|Could not get download info, trying cached version (this may not be recent!)|] [i|Could not get download info, trying cached version (this may not be recent!)|]
let path = view pathL' ghcupURL let path = view pathL' ghcupURL
cacheDir <- liftIO $ ghcupCacheDir cacheDir <- liftIO $ ghcupCacheDir
json_file <- (cacheDir </>) <$> urlBaseName path yaml_file <- (cacheDir </>) <$> urlBaseName path
bs <- bs <-
handleIO' NoSuchThing handleIO' NoSuchThing
(\_ -> throwE $ FileDoesNotExistError (toFilePath json_file)) (\_ -> throwE $ FileDoesNotExistError (toFilePath yaml_file))
$ liftIO $ liftIO
$ readFile json_file $ readFile yaml_file
lE' JSONDecodeError $ eitherDecode' bs lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
-- | Downloads the download information! But only if we need to ;P -- | Downloads the download information! But only if we need to ;P
@ -162,10 +164,10 @@ getDownloads urlSource = do
case urlSource of case urlSource of
GHCupURL -> do GHCupURL -> do
bs <- reThrowAll DownloadFailed $ smartDl ghcupURL bs <- reThrowAll DownloadFailed $ smartDl ghcupURL
lE' JSONDecodeError $ eitherDecode' bs lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
(OwnSource url) -> do (OwnSource url) -> do
bs <- reThrowAll DownloadFailed $ downloadBS url bs <- reThrowAll DownloadFailed $ downloadBS url
lE' JSONDecodeError $ eitherDecode' bs lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
(OwnSpec av) -> pure $ av (OwnSpec av) -> pure $ av
where where

View File

@ -20,11 +20,11 @@ import URI.ByteString.QQ
import qualified Data.Text as T import qualified Data.Text as T
-- | This reflects the API version of the JSON. -- | This reflects the API version of the YAML.
ghcupURL :: URI ghcupURL :: URI
ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.json|] ghcupURL = [uri|https://www.haskell.org/ghcup/data/ghcup-0.0.2.yaml|]
-- | The curren ghcup version. -- | The current ghcup version.
ghcUpVer :: PVP ghcUpVer :: PVP
ghcUpVer = [pver|0.1.8|] ghcUpVer = [pver|0.1.8|]