Add doctor subcommand (#1436)

app/CLI.hs

@@ -16,6 +16,7 @@ data CLI
   = DisplayVersion
   | DisplayHelp
   | Command CommandGlobalOptions
+  | Doctor DoctorOptions
 
 parseDisplayVersion :: Parser CLI
 parseDisplayVersion =
@@ -29,6 +30,21 @@ parseDisplayHelp =
     DisplayHelp
     (long "help" <> short 'h' <> help "Show the help text" <> noGlobal)
 
+parseDoctor :: Parser CLI
+parseDoctor =
+  hsubparser
+    ( mconcat
+        [ commandGroup "Utility commands:",
+          metavar "UTILITY_CMD",
+          command
+            "doctor"
+            ( info
+                (CLI.Doctor <$> parseDoctorOptions)
+                (progDesc "Perform checks on your Juvix development environment")
+            )
+        ]
+    )
+
 parseCommand :: Parser CLI
 parseCommand = Command <$> parseCommandGlobalOptions
 
@@ -37,6 +53,7 @@ parseCLI =
   parseDisplayVersion
     <|> parseDisplayHelp
     <|> parseCommand
+    <|> parseDoctor
 
 commandFirstFile :: CommandGlobalOptions -> Maybe FilePath
 commandFirstFile CommandGlobalOptions {_cliGlobalOptions = GlobalOptions {..}} =

app/Command.hs

@@ -4,11 +4,13 @@ module Command
     module Commands.Html,
     module Commands.Compile,
     module Commands.Dev,
+    module Commands.Doctor,
   )
 where
 
 import Commands.Compile
 import Commands.Dev
+import Commands.Doctor
 import Commands.Extra
 import Commands.Html
 import GlobalOptions
@@ -34,7 +36,9 @@ parseCommandGlobalOptions = do
   cmd <-
     hsubparser
       ( mconcat
-          [ commandCheck,
+          [ commandGroup "Compiler commands:",
+            metavar "COMPILER_CMD",
+            commandCheck,
             commandCompile,
             commandHtml,
             commandDev

app/Commands/Doctor.hs

@@ -0,0 +1,159 @@
+module Commands.Doctor where
+
+import Data.Aeson
+import Data.Aeson.TH
+import Juvix.Extra.Version qualified as V
+import Juvix.Prelude
+import Network.HTTP.Simple
+import Options.Applicative
+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
+ )
+
+newtype DoctorOptions = DoctorOptions
+  { _doctorOffline :: Bool
+  }
+
+data DocumentedWarning
+  = NoClang
+  | OldClang
+  | NoWasmLd
+  | NoWasm32Target
+  | NoWasm32WasiTarget
+  | NoSysroot
+  | NoWasmer
+
+data DocumentedMessage = DocumentedMessage
+  { _documentedMessageUrl :: Text,
+    _documentedMessageMessage :: Text
+  }
+
+makeLenses ''GithubRelease
+makeLenses ''DoctorOptions
+makeLenses ''DocumentedMessage
+
+parseDoctorOptions :: Parser DoctorOptions
+parseDoctorOptions = do
+  _doctorOffline <-
+    switch
+      ( long "offline"
+          <> help "Run the doctor offline"
+      )
+  pure DoctorOptions {..}
+
+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 <$> embed (findExecutable 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
+
+doctor :: Members DoctorEff r => DoctorOptions -> Sem r ()
+doctor opts = do
+  checkClang
+  checkWasmer
+  unless (opts ^. doctorOffline) checkVersion

app/Main.hs

@@ -270,3 +270,4 @@ main = do
     DisplayVersion -> runDisplayVersion
     DisplayHelp -> showHelpText p
     Command cmd -> runM (runAppIO (cmd ^. cliGlobalOptions) (runCommand cmd))
+    Doctor opts -> runM (runLogIO (doctor opts))

docs/org/SUMMARY.org

@@ -23,6 +23,7 @@
   - [[./tooling/CLI.md][Command line interface]]
   - [[./tooling/emacs-mode.md][Emacs mode]]
   - [[./tooling/testing.md][Haskell test suite]]
+  - [[./tooling/doctor.md][Doctor]]
 
 - [[./notes/README.md][Notes]]
   - [[./examples/validity-predicates/README.md][Validity predicates]]

docs/org/tooling/README.org

@@ -1,3 +1,4 @@
-- [[./tools/CLI.md][Command line Interface]]
-- [[./tools/emacs-mode.md][Writting Juvix programs with Emacs Mode]]
-- [[./tools/testing.md][Test Suite]]
+- [[./CLI.md][Command line Interface]]
+- [[./emacs-mode.md][Writting Juvix programs with Emacs Mode]]
+- [[./testing.md][Test Suite]]
+- [[./doctor.md][Doctor]]

docs/org/tooling/doctor.org

@@ -0,0 +1,93 @@
+* Juvix Doctor
+
+The =juvix doctor= command can help you to troubleshoot problems with your development environment. For each problem the doctor finds they'll be a link to a section on this page to help you fix it.
+
+** Could not find the clang command
+
+The Juvix compiler uses the [[https://clang.llvm.org][Clang compiler]] version 13 or later to generate binaries. You need to have Clang available on your system =$PATH=.
+
+Recommended installation method:
+
+*** MacOS
+
+Use [[https://brew.sh][Homebrew]]:
+
+#+begin_src shell
+brew install llvm
+#+end_src
+
+NB: The distribution of Clang that comes with XCode does not support the =Wasm= target so you must install the standard Clang distribution.
+
+*** Debian / Ubuntu Linux
+
+#+begin_src shell
+sudo apt install clang lldb lld
+#+end_src
+
+*** Arch Linux
+
+#+begin_src shell
+sudo pacman -S llvm lld
+#+end_src
+
+** Could not find the wasm-ld command
+
+The Juvix compiler required =wasm-ld= (the Wasm linker) to produce =Wasm= binaries.
+
+Recommened installation method:
+
+*** MacOS
+
+=wasm-ld= is included in the [[https://brew.sh][Homebrew]] llvm distribution:
+
+#+begin_src shell
+brew install llvm
+#+end_src
+
+*** Debian / Ubuntu Linux
+
+#+begin_src shell
+sudo apt install lldb lld
+#+end_src
+
+*** Arch Linux
+
+#+begin_src shell
+sudo pacman -S lld
+#+end_src
+
+** Newer Clang version required
+
+Juvix requires Clang version 13 or above. See the documentation on [[./doctor.md#could-not-find-the-clang-command][installing Clang]].
+
+** Clang does not support the wasm32 target
+
+Juvix requires Clang version 13 or above. See the documentation on [[./doctor.md#could-not-find-the-clang-command][installing Clang]].
+
+** Clang does not support the wasm32-wasi target
+
+Juvix uses [[https://wasi.dev][WASI - The Wasm System Interface]] to produce binaries that can be executed using a Wasm runtime. The files necessary to setup Clang with =wasm32-wasi= support are available at [[https://github.com/WebAssembly/wasi-sdk/releases][wasi-sdk]].
+
+To install the =wasm32-wasi= target for Clang you need to do two things:
+
+*** Install =libclang_rt.builtins-wasm32.a= into your Clang distribution
+
+1. Obtain =libclang_rt.builtins-wasm32-wasi-16.0.tar.gz= from the [[https://github.com/WebAssembly/wasi-sdk/releases][wasi-sdk releases]] page.
+2. Untar the file and place the file =lib/wasi/libclang_rt.builtins-wasm32.a= into your Clang distribution directory.
+
+   On MacOS, if you installed llvm using homebrew you can find the Clang distribution directory using =brew --prefix llvm=. You should then place the builtins file at =`brew --prefix llvm`/lib/wasi/libclang_rt.builtins-wasm32.a=.
+
+   On Linux the Clang distribution directory will be something like =/usr/lib/clang/13.0.1= where =13.0.1= is the version of Clang that you have installed. You should then place the builtins file at =/usr/lib/clang/13.0.1/lib/wasi/libclang_rt.builtins-wasm32=.
+
+*** Download the WASI sysroot and set =WASI_SYSROOT_PATH=
+
+1. Obtain =wasi-sysroot-16.0.tar.gz= from the [[https://github.com/WebAssembly/wasi-sdk/releases][wasi-sdk releases]] page.
+2. Untar the file and set the environment variable =WASI_SYSROOT_PATH= to that location.
+
+**  Environment variable =WASI_SYSROOT_PATH= is not set
+
+Set the =WASI_SYSROOT_PATH= to the directory where you installed the =wasi-sdk= sysroot files. See [[./doctor.md#download-the-wasi-sysroot-and-set-wasi_sysroot_path][installing the WASI sysroot]].
+
+**  Could not find the wasmer command
+
+The Juvix test suite uses [[https://wasmer.io][Wasmer]] as a Wasm runtime to execute compiled Wasm binaries. See [[https://docs.wasmer.io/ecosystem/wasmer/getting-started][the Wasmer documentation]] to see how to install it.

package.yaml

@@ -105,6 +105,7 @@ executables:
     dependencies:
     - juvix
     - optparse-applicative == 0.17.*
+    - http-conduit == 2.3.*
     verbatim:
       default-language: GHC2021
 

src/Juvix/Data/Effect.hs

@@ -2,9 +2,11 @@ module Juvix.Data.Effect
   ( module Juvix.Data.Effect.Fail,
     module Juvix.Data.Effect.Files,
     module Juvix.Data.Effect.NameIdGen,
+    module Juvix.Data.Effect.Log,
   )
 where
 
 import Juvix.Data.Effect.Fail
 import Juvix.Data.Effect.Files
+import Juvix.Data.Effect.Log
 import Juvix.Data.Effect.NameIdGen hiding (toState)

src/Juvix/Data/Effect/Fail.hs

@@ -1,6 +1,7 @@
 -- | An effect similar to Polysemy Fail but wihout an error message
 module Juvix.Data.Effect.Fail where
 
+import Control.Exception qualified as X
 import Juvix.Prelude.Base
 
 data Fail m a = Fail
@@ -18,3 +19,13 @@ failMaybe :: Member Fail r => Maybe a -> Sem r a
 failMaybe = \case
   Nothing -> fail
   Just x -> return x
+
+failFromException ::
+  Members '[Fail, Embed IO] r =>
+  IO a ->
+  Sem r a
+failFromException m = do
+  r <- embed (X.try @X.SomeException m)
+  case r of
+    Left {} -> fail
+    Right a -> return a

src/Juvix/Data/Effect/Log.hs

@@ -0,0 +1,20 @@
+module Juvix.Data.Effect.Log where
+
+import Data.Text.IO qualified as Text
+import Juvix.Prelude.Base
+
+data Log m a where
+  Log :: Text -> Log m ()
+
+makeSem ''Log
+
+runLogIO ::
+  Member (Embed IO) r =>
+  InterpreterFor Log r
+runLogIO sem = do
+  embed (hSetBuffering stdout LineBuffering)
+  interpret
+    ( \case
+        Log txt -> embed (Text.hPutStrLn stdout txt)
+    )
+    sem

tests/CLI/doctor.test

@@ -0,0 +1,3 @@
+$ juvix doctor --offline
+> /> Checking for.*/
+>= 0

tests/CLI/help.test

@@ -1,7 +1,8 @@
 $ juvix --help
 > /Usage: juvix \(\(\-v\|\-\-version\) \| \(\-h\|\-\-help\) \| \[\-\-no\-colors\] \[\-\-show\-name\-ids\] 
                \[\-\-only\-errors\] \[\-\-no\-termination\] \[\-\-no\-positivity\] 
-               \[\-\-no\-stdlib\] COMMAND\).*/
+               \[\-\-no\-stdlib\] COMPILER_CMD \|
+               UTILITY_CMD.*/
 >= 0