diff --git a/scripts/default.nix b/scripts/default.nix index a275b7ec..17a2e839 100644 --- a/scripts/default.nix +++ b/scripts/default.nix @@ -59,4 +59,5 @@ in { package-transferrer = build-script "registry-package-transferrer" "PackageTransferrer"; solver = build-script "registry-solver" "Solver"; verify-integrity = build-script "registry-verify-integrity" "VerifyIntegrity"; + compiler-versions = build-script "registry-compiler-versions" "CompilerVersions"; } diff --git a/scripts/src/CompilerVersions.purs b/scripts/src/CompilerVersions.purs new file mode 100644 index 00000000..a6dbcb26 --- /dev/null +++ b/scripts/src/CompilerVersions.purs @@ -0,0 +1,191 @@ +module Registry.Scripts.CompilerVersions where + +import Registry.App.Prelude + +import ArgParse.Basic (ArgParser) +import ArgParse.Basic as Arg +import Data.Array as Array +import Data.Array.NonEmpty as NEA +import Data.Formatter.DateTime as Formatter.DateTime +import Data.List (filterM) +import Data.Map as Map +import Data.String as String +import Data.Tuple (uncurry) +import Effect.Class.Console as Console +import Node.FS.Aff as FS.Aff +import Node.Path as Path +import Node.Process as Process +import Registry.App.CLI.Git as Git +import Registry.App.CLI.Purs as Purs +import Registry.App.CLI.PursVersions as PursVersions +import Registry.App.CLI.Tar as Tar +import Registry.App.Effect.Cache as Cache +import Registry.App.Effect.Env as Env +import Registry.App.Effect.GitHub as GitHub +import Registry.App.Effect.Log (LOG) +import Registry.App.Effect.Log as Log +import Registry.App.Effect.Registry (REGISTRY) +import Registry.App.Effect.Registry as Registry +import Registry.App.Effect.Storage (STORAGE) +import Registry.App.Effect.Storage as Storage +import Registry.Foreign.FSExtra as FS.Extra +import Registry.Foreign.Octokit as Octokit +import Registry.Foreign.Tmp as Tmp +import Registry.Internal.Format as Internal.Format +import Registry.Manifest (Manifest(..)) +import Registry.ManifestIndex as ManifestIndex +import Registry.PackageName as PackageName +import Registry.Range as Range +import Registry.Version as Version +import Run (AFF, EFFECT, Run) +import Run as Run +import Run.Except (EXCEPT) +import Run.Except as Except + +data InputMode + = File FilePath + | Package PackageName Version + | AllPackages + +parser :: ArgParser InputMode +parser = Arg.choose "input (--file or --package or --all)" + [ Arg.argument [ "--file" ] + """Compute supported compiler versions for packages from a JSON file like: [ "prelude", "console" ]""" + # Arg.unformat "FILE_PATH" pure + # map File + , Arg.argument [ "--package" ] + "Compute supported compiler versions for the indicated package" + # Arg.unformat "NAME@VERSION" parsePackage + # map (uncurry Package) + , Arg.flag [ "--all" ] "Compute supported compiler versions for all packages" $> AllPackages + ] + where + parsePackage :: String -> Either String (Tuple PackageName Version) + parsePackage input = do + let split = String.split (String.Pattern "@") input + case Array.length split of + 0 -> Left "Expected package@version but received nothing." + 2 -> do + rawPackage <- note "Unexpected error" (Array.index split 0) + package <- lmap (append ("Failed to parse package name '" <> rawPackage <> "': ")) (PackageName.parse rawPackage) + rawVersion <- note "Unexpected error" (Array.index split 1) + version <- lmap (append ("Failed to parse version '" <> rawVersion <> "': ")) (Version.parse rawVersion) + pure $ Tuple package version + _ -> Left $ "Expected package@version but received an invalid format: " <> input + +main :: Effect Unit +main = launchAff_ do + args <- Array.drop 2 <$> liftEffect Process.argv + let description = "A script for determining the supported compiler versions for packages." + arguments <- case Arg.parseArgs "compiler-versions" description parser args of + Left err -> Console.log (Arg.printArgError err) *> liftEffect (Process.exit 1) + Right command -> pure command + + -- Environment + _ <- Env.loadEnvFile ".env" + token <- Env.lookupRequired Env.githubToken + + -- Caching + let cache = Path.concat [ scratchDir, ".cache" ] + FS.Extra.ensureDirectory cache + githubCacheRef <- Cache.newCacheRef + registryCacheRef <- Cache.newCacheRef + + -- GitHub + octokit <- Octokit.newOctokit token + + -- Registry + debouncer <- Registry.newDebouncer + let + registryEnv :: Registry.RegistryEnv + registryEnv = + { write: Registry.ReadOnly + , pull: Git.Autostash + , repos: Registry.defaultRepos + , workdir: scratchDir + , debouncer + , cacheRef: registryCacheRef + } + + -- Logging + now <- nowUTC + let logDir = Path.concat [ scratchDir, "logs" ] + FS.Extra.ensureDirectory logDir + let logFile = "compiler-versions-" <> String.take 19 (Formatter.DateTime.format Internal.Format.iso8601DateTime now) <> ".log" + let logPath = Path.concat [ logDir, logFile ] + Console.log $ "Logs available at " <> logPath + + let + interpret :: Run _ ~> Aff + interpret = + Except.catch (\error -> Run.liftEffect (Console.log error *> Process.exit 1)) + >>> Registry.interpret (Registry.handle registryEnv) + >>> Storage.interpret (Storage.handleReadOnly cache) + >>> GitHub.interpret (GitHub.handle { octokit, cache, ref: githubCacheRef }) + >>> Log.interpret (\log -> Log.handleTerminal Normal log *> Log.handleFs Verbose logPath log) + >>> Run.runBaseAff' + + case arguments of + File _ -> Console.log "Unsupported at this time." *> liftEffect (Process.exit 1) + Package package version -> interpret $ determineCompilerVersionsForPackage package version + AllPackages -> Console.log "Unsupported at this time." *> liftEffect (Process.exit 1) + +determineCompilerVersionsForPackage :: forall r. PackageName -> Version -> Run (AFF + EFFECT + REGISTRY + EXCEPT String + LOG + STORAGE + r) Unit +determineCompilerVersionsForPackage package version = do + allManifests <- map ManifestIndex.toMap Registry.readAllManifests + compilerVersions <- PursVersions.pursVersions + Log.debug $ "Checking Manifest Index for " <> formatPackageVersion package version + Manifest { dependencies } <- Except.rethrow $ (note "Invalid Version" <<< Map.lookup version <=< note "Invalid PackageName" <<< Map.lookup package) allManifests + unless (Map.isEmpty dependencies) do + Log.error "Cannot check package that has dependencies." + Except.throw "Cannot check package that has dependencies." + tmp <- Run.liftAff Tmp.mkTmpDir + let formattedName = formatPackageVersion package version + let extractedName = PackageName.print package <> "-" <> Version.print version + let tarballName = extractedName <> ".tar.gz" + let tarballPath = Path.concat [ tmp, tarballName ] + let extractedPath = Path.concat [ tmp, extractedName ] + let installPath = Path.concat [ tmp, formattedName ] + Log.debug $ "Installing " <> formattedName + Storage.download package version tarballPath + Run.liftAff do + Tar.extract { cwd: tmp, archive: tarballName } + FS.Extra.remove tarballPath + FS.Aff.rename extractedPath installPath + Log.debug $ "Installed " <> formatPackageVersion package version + Log.debug $ "Finding supported compiler versions for " <> formatPackageVersion package version + + let + checkCompiler compiler = do + Log.debug $ "Trying to compile " <> formatPackageVersion package version <> " with purs@" <> Version.print compiler + + result <- Run.liftAff $ Purs.callCompiler + { command: Purs.Compile { globs: [ Path.concat [ formattedName, "src/**/*.purs" ] ] } + , version: Just (Version.print compiler) + , cwd: Just tmp + } + + case result of + Left _ -> do + Log.debug $ "Failed to compile " <> formatPackageVersion package version <> " with purs@" <> Version.print compiler + pure false + Right _ -> do + Log.debug $ "Compiled " <> formatPackageVersion package version <> " with purs@" <> Version.print compiler + pure true + + goCompilerVersions supported compilers = case Array.uncons compilers of + Nothing -> pure supported + Just { head, tail } -> do + success <- checkCompiler head + if success then + goCompilerVersions (supported <> [ head ]) tail + else + goCompilerVersions supported tail + + supported <- goCompilerVersions [] (Array.sort (NEA.toArray compilerVersions)) + + if Array.null supported then do + Log.error $ "Could not find supported compiler versions for " <> formatPackageVersion package version + Run.liftEffect $ Process.exit 1 + else + Log.info $ "Found supported compiler versions for " <> formatPackageVersion package version <> ": " <> Array.intercalate ", " (map Version.print supported)