mirror of
https://github.com/anoma/juvix.git
synced 2024-12-25 16:45:20 +03:00
807b3b1770
This PR adds some maintenance at different levels to the CI config, the Make file, and formatting. - Most of the actions used by the CI related to haskell, ormolu, hlint and pre-commit have been updated because Github requires NodeJS 16. This change removes all the old warnings related to nodeJs. In the case of ormolu, the new version makes us format some files that were not formatted before, similarly with hlint. - The CI has been updated to use the latest version of the Smoke testing framework, which introduced installation of the dependencies for Linux (libicu66) and macOS (icu4c) in the CI. In the case of macOS, the CI uses a binary for smoke. For Linux, we use stack to build smoke from the source. The source here is in a fork of [the official Smoke repo](https://github.com/SamirTalwar/smoke). Such includes some features/changes that are not yet in the official repo. - The Makefile runs the ormolu and hlint targets using as a path for the binaries the environment variables ORMOLU and HLINT. Thus, export those variables in your environment before running `make check,` `make format` or `make hlint`. Otherwise, the Makefile will use the binaries provided by `stack`. Co-authored-by: Paul Cadman <git@paulcadman.dev>
147 lines
5.5 KiB
Haskell
147 lines
5.5 KiB
Haskell
module Commands.Doctor where
|
|
|
|
import Commands.Doctor.Options
|
|
import Data.Aeson
|
|
import Data.Aeson.TH
|
|
import Juvix.Extra.Version qualified as V
|
|
import Juvix.Prelude
|
|
import Network.HTTP.Simple
|
|
import Safe (headMay)
|
|
import System.Environment qualified as E
|
|
import System.Process qualified as P
|
|
import Text.Read (readMaybe)
|
|
|
|
newtype GithubRelease = GithubRelease {_githubReleaseTagName :: Maybe Text}
|
|
deriving stock (Eq, Show, Generic)
|
|
|
|
$( deriveFromJSON
|
|
defaultOptions
|
|
{ fieldLabelModifier = camelTo2 '_' . dropPrefix "_githubRelease"
|
|
}
|
|
''GithubRelease
|
|
)
|
|
|
|
data DocumentedWarning
|
|
= NoClang
|
|
| OldClang
|
|
| NoWasmLd
|
|
| NoWasm32Target
|
|
| NoWasm32WasiTarget
|
|
| NoSysroot
|
|
| NoWasmer
|
|
|
|
data DocumentedMessage = DocumentedMessage
|
|
{ _documentedMessageUrl :: Text,
|
|
_documentedMessageMessage :: Text
|
|
}
|
|
|
|
makeLenses ''GithubRelease
|
|
makeLenses ''DoctorOptions
|
|
makeLenses ''DocumentedMessage
|
|
|
|
minimumClangVersion :: Integer
|
|
minimumClangVersion = 13
|
|
|
|
documentedMessage :: DocumentedWarning -> DocumentedMessage
|
|
documentedMessage w = uncurry DocumentedMessage (first (baseUrl <>) warningInfo)
|
|
where
|
|
warningInfo :: (Text, Text)
|
|
warningInfo = case w of
|
|
NoClang -> ("could-not-find-the-clang-command", "Could not find the clang command")
|
|
OldClang -> ("newer-clang-version-required", "Clang version " <> show minimumClangVersion <> " or newer required")
|
|
NoWasmLd -> ("could-not-find-the-wasm-ld-command", "Could not find the wasm-ld command")
|
|
NoWasm32Target -> ("clang-does-not-support-the-wasm32-target", "Clang does not support the wasm32 target")
|
|
NoWasm32WasiTarget -> ("clang-does-not-support-the-wasm32-wasi-target", "Clang does not support the wasm32-wasi target")
|
|
NoSysroot -> ("environment-variable-wasi_sysroot_path-is-not-set", "Environment variable WASI_SYSROOT_PATH is missing")
|
|
NoWasmer -> ("could-not-find-the-wasmer-command", "Could not find the wasmer command")
|
|
|
|
baseUrl :: Text
|
|
baseUrl = "https://docs.juvix.org/tooling/doctor.html#"
|
|
|
|
heading :: (Member Log r) => Text -> Sem r ()
|
|
heading = log . ("> " <>)
|
|
|
|
warning :: (Member Log r) => Text -> Sem r ()
|
|
warning = log . (" ! " <>)
|
|
|
|
type DoctorEff = '[Log, Embed IO]
|
|
|
|
checkCmdOnPath :: (Members DoctorEff r) => String -> [Text] -> Sem r ()
|
|
checkCmdOnPath cmd errMsg =
|
|
whenM (isNothing <$> findExecutable (relFile cmd)) (mapM_ warning errMsg)
|
|
|
|
checkClangTargetSupported :: (Members DoctorEff r) => String -> [Text] -> Sem r ()
|
|
checkClangTargetSupported target errMsg = do
|
|
(code, _, _) <-
|
|
embed
|
|
( P.readProcessWithExitCode
|
|
"clang"
|
|
["-target", target, "--print-supported-cpus"]
|
|
""
|
|
)
|
|
unless (code == ExitSuccess) (mapM_ warning errMsg)
|
|
|
|
checkClangVersion :: (Members DoctorEff r) => Integer -> [Text] -> Sem r ()
|
|
checkClangVersion expectedVersion errMsg = do
|
|
versionString <- embed (P.readProcess "clang" ["-dumpversion"] "")
|
|
case headMay (splitOn "." versionString) >>= readMaybe of
|
|
Just majorVersion -> unless (majorVersion >= expectedVersion) (mapM_ warning errMsg)
|
|
Nothing -> warning "Could not determine clang version"
|
|
|
|
checkEnvVarSet :: (Members DoctorEff r) => String -> [Text] -> Sem r ()
|
|
checkEnvVarSet var errMsg = do
|
|
whenM (isNothing <$> embed (E.lookupEnv var)) (mapM_ warning errMsg)
|
|
|
|
getLatestRelease :: (Members '[Embed IO, Fail] r) => Sem r GithubRelease
|
|
getLatestRelease = do
|
|
request' <- failFromException (parseRequest "https://api.github.com/repos/anoma/juvix/releases/latest")
|
|
let request = setRequestHeaders [("user-agent", "curl/7.79.1"), ("Accept", "application/vnd.github+json")] request'
|
|
response <- failFromException (httpJSON request)
|
|
return (getResponseBody response)
|
|
|
|
checkVersion :: (Members DoctorEff r) => Sem r ()
|
|
checkVersion = do
|
|
heading "Checking latest Juvix release on Github..."
|
|
let tagName = "v" <> V.versionDoc
|
|
response <- runFail getLatestRelease
|
|
case response of
|
|
Just release -> case release ^. githubReleaseTagName of
|
|
Just latestTagName -> unless (tagName == latestTagName) (warning ("Newer Juvix version is available from https://github.com/anoma/juvix/releases/tag/" <> latestTagName))
|
|
Nothing -> warning "Tag name is not present in release JSON from Github API"
|
|
Nothing -> warning "Network error when fetching data from Github API"
|
|
|
|
documentedCheck ::
|
|
([Text] -> Sem r ()) -> DocumentedWarning -> Sem r ()
|
|
documentedCheck check w = check msg
|
|
where
|
|
dmsg :: DocumentedMessage
|
|
dmsg = documentedMessage w
|
|
msg :: [Text]
|
|
msg = [dmsg ^. documentedMessageMessage, dmsg ^. documentedMessageUrl]
|
|
|
|
checkClang :: (Members DoctorEff r) => Sem r ()
|
|
checkClang = do
|
|
heading "Checking for clang..."
|
|
documentedCheck (checkCmdOnPath "clang") NoClang
|
|
heading "Checking clang version..."
|
|
documentedCheck (checkClangVersion minimumClangVersion) OldClang
|
|
heading "Checking for wasm-ld..."
|
|
documentedCheck (checkCmdOnPath "wasm-ld") NoWasmLd
|
|
heading "Checking that clang supports wasm32..."
|
|
documentedCheck (checkClangTargetSupported "wasm32") NoWasm32Target
|
|
heading "Checking that clang supports wasm32-wasi..."
|
|
documentedCheck (checkClangTargetSupported "wasm32-wasi") NoWasm32WasiTarget
|
|
heading "Checking that WASI_SYSROOT_PATH is set..."
|
|
documentedCheck (checkEnvVarSet "WASI_SYSROOT_PATH") NoSysroot
|
|
|
|
checkWasmer :: (Members DoctorEff r) => Sem r ()
|
|
checkWasmer = do
|
|
heading "Checking for wasmer..."
|
|
documentedCheck (checkCmdOnPath "wasmer") NoWasmer
|
|
|
|
runCommand :: (Members DoctorEff r) => DoctorOptions -> Sem r ()
|
|
runCommand opts = do
|
|
checkClang
|
|
checkWasmer
|
|
unless (opts ^. doctorOffline) checkVersion
|