diff --git a/ghcup-gen/Generate.hs b/ghcup-gen/Generate.hs new file mode 100644 index 0000000..01ef0ac --- /dev/null +++ b/ghcup-gen/Generate.hs @@ -0,0 +1,101 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE OverloadedStrings #-} + +module Generate where + +import GHCup +import GHCup.Download +import GHCup.Errors +import GHCup.Types +import GHCup.Types.Optics +import GHCup.Utils +import GHCup.Utils.Logger +import GHCup.Utils.Version.QQ + +import Codec.Archive +import Control.Applicative +import Control.Exception.Safe +import Control.Monad +import Control.Monad.IO.Class +import Control.Monad.Reader.Class +import Control.Monad.Trans.Class ( lift ) +import Control.Monad.Trans.Reader ( runReaderT ) +import Control.Monad.Trans.Resource ( runResourceT + , MonadUnliftIO + ) +import Data.Containers.ListUtils ( nubOrd ) +import Data.ByteString ( ByteString ) +import Data.IORef +import Data.Either +import Data.Maybe +import Data.List +import Data.Map.Strict ( Map ) +import Data.Versions +import Haskus.Utils.Variant.Excepts +import Optics +import System.FilePath +import System.Exit +import Text.ParserCombinators.ReadP +import Text.PrettyPrint.HughesPJClass ( prettyShow ) +import Text.Regex.Posix +import GHCup.Utils.String.QQ + +import qualified Data.ByteString as BS +import qualified Data.Map.Strict as M +import qualified Data.Text as T +import qualified Data.Version as V +import qualified Data.Yaml.Pretty as YAML +import qualified Text.Megaparsec as MP + + + +data GhcHlsVersions = GhcHlsVersions { + +} + +type HlsGhcVersions = Map Version (Map Architecture (Map Platform Version)) + +generate :: ( MonadFail m + , MonadMask m + , Monad m + , MonadReader env m + , HasSettings env + , HasDirs env + , HasLog env + , MonadThrow m + , MonadIO m + , MonadUnliftIO m + ) + => GHCupDownloads + -> M.Map GlobalTool DownloadInfo + -> m ExitCode +generate dls _ = do + let hlses = dls M.! HLS + r <- forM hlses $ \(_viArch -> archs) -> + forM archs $ \plats -> + forM plats $ \(head . M.toList -> (_, dli)) -> do + VRight r <- runResourceT . runE + @'[DigestError + , GPGError + , DownloadFailed + , UnknownArchive + , ArchiveResult + ] $ do + fp <- liftE $ downloadCached dli Nothing + files <- liftE $ getArchiveFiles fp + let regex = makeRegexOpts compExtended execBlank ([s|^haskell-language-server-([0-9]+\.)*([0-9]+)$|] :: ByteString) + let ghcs = rights $ MP.parse version' "" + . T.pack + . fromJust + . stripPrefix "haskell-language-server-" + <$> filter (match regex) files + pure ghcs + pure r + liftIO $ BS.putStr $ YAML.encodePretty YAML.defConfig r + pure ExitSuccess diff --git a/ghcup-gen/Main.hs b/ghcup-gen/Main.hs index 4bae1cb..d0450c2 100644 --- a/ghcup-gen/Main.hs +++ b/ghcup-gen/Main.hs @@ -29,6 +29,7 @@ import System.Environment import System.Exit import System.IO ( stderr ) import Text.Regex.Posix +import Generate import Validate import Text.PrettyPrint.HughesPJClass ( prettyShow ) @@ -44,6 +45,7 @@ data Options = Options data Command = ValidateYAML ValidateYAMLOpts | ValidateTarballs ValidateYAMLOpts TarballFilter + | GenerateHlsGhc ValidateYAMLOpts data Input @@ -108,6 +110,12 @@ com = subparser ((ValidateTarballs <$> validateYAMLOpts <*> tarballFilterP) <**> helper) (progDesc "Validate all tarballs (download and checksum)") ) + <> command + "generate-hls-ghcs" + (info + ((GenerateHlsGhc <$> validateYAMLOpts) <**> helper) + (progDesc "Generate a list of HLS-GHC support") + ) ) @@ -137,6 +145,7 @@ main = do >>= \Options {..} -> case optCommand of ValidateYAML vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validate dl m) ValidateTarballs vopts tarballFilter -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ validateTarballs tarballFilter dl m) + GenerateHlsGhc vopts -> withValidateYamlOpts vopts (\dl m -> flip runReaderT appstate $ generate dl m) pure () where diff --git a/ghcup-gen/ghcup-gen.cabal b/ghcup-gen/ghcup-gen.cabal index 171a08f..d9d955a 100644 --- a/ghcup-gen/ghcup-gen.cabal +++ b/ghcup-gen/ghcup-gen.cabal @@ -23,6 +23,7 @@ source-repository head executable ghcup-gen main-is: Main.hs other-modules: Validate + Generate default-language: Haskell2010 default-extensions: DeriveGeneric @@ -51,6 +52,7 @@ executable ghcup-gen , ghcup ^>=0.1.17.3 , haskus-utils-variant ^>=3.2 , libarchive ^>=3.0.3.0 + , megaparsec ^>=9.0 , mtl ^>=2.2 , optics ^>=0.4 , optparse-applicative >=0.15.1.0 && <0.17