Merge branch 'yaml'

2020-08-10 08:58:55 +02:00 · 2020-08-10 08:58:55 +02:00 · 86a4b10de6
commit 86a4b10de6
parent cfa7049ab9 391676e90a
11 changed files with 1371 additions and 5000 deletions
--- a/.gitlab/script/ghcup_version.sh
+++ b/.gitlab/script/ghcup_version.sh
@ -11,7 +11,7 @@ ecabal() {
 }

 eghcup() {
-	ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.json "$@"
+	ghcup -v -c -s file://$(pwd)/ghcup-${JSON_VERSION}.yaml "$@"
 }

 git describe --always
@ -42,7 +42,7 @@ rm -rf "${GHCUP_INSTALL_BASE_PREFIX}"/.ghcup
 ### manual cli based testing


-ghcup-gen check -f ghcup-${JSON_VERSION}.json
+ghcup-gen check -f ghcup-${JSON_VERSION}.yaml

 eghcup --numeric-version

--- a/RELEASING.md
+++ b/RELEASING.md
@ -1,19 +1,19 @@
 # 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

 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.

 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`
--- a/app/ghcup-gen/Main.hs
+++ b/app/ghcup-gen/Main.hs
@ -10,13 +10,10 @@

 module Main where

-import           GHCup.Data.GHCupInfo
 import           GHCup.Types
 import           GHCup.Types.JSON               ( )
 import           GHCup.Utils.Logger

-import           Data.Aeson                     ( eitherDecode, encode )
-import           Data.Aeson.Encode.Pretty
 #if !MIN_VERSION_base(4,13,0)
 import           Data.Semigroup                 ( (<>) )
 #endif
@ -27,48 +24,15 @@ import           System.IO                      ( stdout )
 import           Validate

 import qualified Data.ByteString               as B
-import qualified Data.ByteString.Lazy          as L
+import qualified Data.Yaml                     as Y


 data Options = Options
  { optCommand :: Command
  }

-data Command = GenJSON GenJSONOpts
-             | ValidateJSON ValidateJSONOpts
-             | 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 Command = ValidateYAML ValidateYAMLOpts
+             | ValidateTarballs ValidateYAMLOpts


 data Input
@ -92,12 +56,12 @@ stdInput = flag'
 inputP :: Parser Input
 inputP = fileInput <|> stdInput

-data ValidateJSONOpts = ValidateJSONOpts
-  { input :: Maybe Input
+data ValidateYAMLOpts = ValidateYAMLOpts
+  { vInput :: Maybe Input
  }

-validateJSONOpts :: Parser ValidateJSONOpts
-validateJSONOpts = ValidateJSONOpts <$> optional inputP
+validateYAMLOpts :: Parser ValidateYAMLOpts
+validateYAMLOpts = ValidateYAMLOpts <$> optional inputP

 opts :: Parser Options
 opts = Options <$> com
@ -105,18 +69,10 @@ opts = Options <$> com
 com :: Parser Command
 com = subparser
  (  (command
-       "gen"
-       (   GenJSON
-       <$> (info (genJSONOpts <**> helper)
-                 (progDesc "Generate the json downloads file")
-           )
-       )
-     )
-  <> (command
       "check"
-       (   ValidateJSON
-       <$> (info (validateJSONOpts <**> helper)
-                 (progDesc "Validate the JSON")
+       (   ValidateYAML
+       <$> (info (validateYAMLOpts <**> helper)
+                 (progDesc "Validate the YAML")
           )
       )
     )
@ -124,7 +80,7 @@ com = subparser
       "check-tarballs"
       (   ValidateTarballs
       <$> (info
-             (validateJSONOpts <**> helper)
+             (validateYAMLOpts <**> helper)
             (progDesc "Validate all tarballs (download and checksum)")
           )
       )
@ -135,38 +91,27 @@ com = subparser

 main :: IO ()
 main = do
-  customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
+  _ <- customExecParser (prefs showHelpOnError) (info (opts <**> helper) idm)
    >>= \Options {..} -> case optCommand of
-          GenJSON gopts -> do
-            let bs True =
-                  encodePretty' (defConfig { confIndent = Spaces 2 }) ghcupInfo
-                bs False = encode ghcupInfo
-            case gopts of
-              GenJSONOpts { output = Nothing, pretty } ->
-                L.hPutStr stdout (bs pretty)
-              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
+          ValidateYAML vopts -> case vopts of
+            ValidateYAMLOpts { vInput = Nothing } ->
+              B.getContents >>= valAndExit validate
+            ValidateYAMLOpts { vInput = Just StdInput } ->
+              B.getContents >>= valAndExit validate
+            ValidateYAMLOpts { vInput = Just (FileInput file) } ->
+              B.readFile file >>= valAndExit validate
          ValidateTarballs vopts -> case vopts of
-            ValidateJSONOpts { input = Nothing } ->
-              L.getContents >>= valAndExit validateTarballs
-            ValidateJSONOpts { input = Just StdInput } ->
-              L.getContents >>= valAndExit validateTarballs
-            ValidateJSONOpts { input = Just (FileInput file) } ->
-              L.readFile file >>= valAndExit validateTarballs
+            ValidateYAMLOpts { vInput = Nothing } ->
+              B.getContents >>= valAndExit validateTarballs
+            ValidateYAMLOpts { vInput = Just StdInput } ->
+              B.getContents >>= valAndExit validateTarballs
+            ValidateYAMLOpts { vInput = Just (FileInput file) } ->
+              B.readFile file >>= valAndExit validateTarballs
  pure ()

 where
  valAndExit f contents = do
-    (GHCupInfo _ av) <- case eitherDecode contents of
+    (GHCupInfo _ av) <- case Y.decodeEither' contents of
      Right r -> pure r
      Left  e -> die (color Red $ show e)
    myLoggerT (LoggerConfig True (B.hPut stdout) (\_ -> pure ())) (f av)
--- a/ghcup-0.0.2.json
+++ b/ghcup-0.0.2.json
--- a/ghcup-0.0.2.yaml
+++ b/ghcup-0.0.2.yaml
--- a/ghcup.cabal
+++ b/ghcup.cabal
@ -219,6 +219,9 @@ common vty
 common word8
  build-depends: word8 >=0.1.3

+common yaml
+  build-depends: yaml >=0.11.4.0
+
 common zlib
  build-depends: zlib >=0.6.2.1

@ -291,13 +294,11 @@ library
    , vector
    , versions
    , word8
+    , yaml
    , zlib

  exposed-modules:
    GHCup
-    GHCup.Data.GHCupDownloads
-    GHCup.Data.GHCupInfo
-    GHCup.Data.ToolRequirements
    GHCup.Download
    GHCup.Download.Utils
    GHCup.Errors
@ -413,6 +414,7 @@ executable ghcup-gen
    , uri-bytestring
    , utf8-string
    , versions
+    , yaml

  --
  main-is:          Main.hs
--- a/lib/GHCup/Data/GHCupDownloads.hs
+++ b/lib/GHCup/Data/GHCupDownloads.hs
--- a/lib/GHCup/Data/GHCupInfo.hs
+++ b/lib/GHCup/Data/GHCupInfo.hs
@ -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
-                      }
--- a/lib/GHCup/Data/ToolRequirements.hs
+++ b/lib/GHCup/Data/ToolRequirements.hs
@ -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"
-                  ]
-                  ""
-                )
-              ]
-            )
-          ]
-        )
-      ]
-    )
-  ]
--- a/lib/GHCup/Download.hs
+++ b/lib/GHCup/Download.hs
@ -52,6 +52,7 @@ import           Control.Monad.Reader
 import           Control.Monad.Trans.Resource
                                         hiding ( throwM )
 import           Data.Aeson
+import           Data.Bifunctor
 import           Data.ByteString                ( ByteString )
 #if defined(INTERNAL_DOWNLOADER)
 import           Data.CaseInsensitive           ( CI )
@ -88,6 +89,7 @@ import qualified Data.Map.Strict               as M
 import qualified Data.Text                     as T
 #endif
 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.RawFilePath.Directory
                                               as RD
@ -103,7 +105,7 @@ import qualified System.Posix.RawFilePath.Directory


 -- | 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
                 , FromJSONKey Version
                 , FromJSON VersionInfo
@ -135,13 +137,13 @@ getDownloadsF urlSource = do
      [i|Could not get download info, trying cached version (this may not be recent!)|]
    let path = view pathL' ghcupURL
    cacheDir  <- liftIO $ ghcupCacheDir
-    json_file <- (cacheDir </>) <$> urlBaseName path
+    yaml_file <- (cacheDir </>) <$> urlBaseName path
    bs        <-
      handleIO' NoSuchThing
-                (\_ -> throwE $ FileDoesNotExistError (toFilePath json_file))
+                (\_ -> throwE $ FileDoesNotExistError (toFilePath yaml_file))
      $ liftIO
-      $ readFile json_file
-    lE' JSONDecodeError $ eitherDecode' bs
+      $ readFile yaml_file
+    lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)


 -- | Downloads the download information! But only if we need to ;P
@ -162,10 +164,10 @@ getDownloads urlSource = do
  case urlSource of
    GHCupURL -> do
      bs <- reThrowAll DownloadFailed $ smartDl ghcupURL
-      lE' JSONDecodeError $ eitherDecode' bs
+      lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
    (OwnSource url) -> do
      bs <- reThrowAll DownloadFailed $ downloadBS url
-      lE' JSONDecodeError $ eitherDecode' bs
+      lE' JSONDecodeError $ bimap show id $ Y.decodeEither' (L.toStrict bs)
    (OwnSpec av) -> pure $ av

 where
--- a/lib/GHCup/Version.hs
+++ b/lib/GHCup/Version.hs
@ -20,11 +20,11 @@ import           URI.ByteString.QQ

 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|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 = [pver|0.1.8|]