digital-asset · neil-da · Jun 26, 2019 · Jun 26, 2019 · Jun 26, 2019 · Jun 26, 2019
diff --git a/.hlint.yaml b/.hlint.yaml
@@ -100,7 +100,7 @@
   - {name: unsafePerformIO, within: [DA.Daml.GHC.Compiler.UtilGHC]}
   - {name: unsafeInterleaveIO, within: []}
   - {name: unsafeDupablePerformIO, within: []}
-  - {name: setCurrentDirectory, within: [DAML.Assistant.Tests]}
+  - {name: setCurrentDirectory, within: [DAML.Assistant.Tests, Main]}
   - {name: unsafeCoerce, within: []}
 
 # Add custom hints for this project

diff --git a/compiler/hie-core/BUILD.bazel b/compiler/hie-core/BUILD.bazel
@@ -66,22 +66,23 @@ da_haskell_library(
 )
 
 da_haskell_binary(
-    name = "hie-core-demo",
-    srcs = glob(["test/**/*.hs"]),
+    name = "hie-core-exe",
+    srcs = glob(["exe/**/*.hs"]),
     hazel_deps = [
         "base",
         "containers",
         "data-default",
         "directory",
         "extra",
+        "filepath",
         "ghc-paths",
         "ghc",
         "haskell-lsp",
         "hie-bios",
+        "optparse-applicative",
         "shake",
         "text",
     ],
-    main_function = "Demo.main",
     src_strip_prefix = "test",
     visibility = ["//visibility:public"],
     deps = [

diff --git a/compiler/hie-core/README.md b/compiler/hie-core/README.md
@@ -10,7 +10,9 @@ Our vision is that you should build an IDE by combining:
 
 There are more details about our approach [in this blog post](https://4ta.uk/p/shaking-up-the-ide).
 
-## How to use it
+## Using it
+
+### Install `hie-core`
 
 First install the `hie-core` binary using `stack` or `cabal`, e.g.
 
@@ -20,9 +22,27 @@ First install the `hie-core` binary using `stack` or `cabal`, e.g.
 
 It's important that `hie-core` is compiled with the same compiler you use to build your projects.
 
-Next, check that `hie-bios` is able to load your project. This step is currently a bit difficult.
+### Test `hie-core`
+
+Next, check that `hie-core` is capable of loading your code. Change to the project directory and run `hie-core`, which will try and load everything using the same code as the IDE, but in a way that's much easier to understand. For example, taking the example of [`shake`](https://github.com/ndmitchell/shake), running `hie-core` gives some error messages and warnings before reporting at the end:
+
+```
+Files that worked: 152
+Files that failed: 6
+ * .\model\Main.hs
+ * .\model\Model.hs
+ * .\model\Test.hs
+ * .\model\Util.hs
+ * .\output\docs\Main.hs
+ * .\output\docs\Part_Architecture_md.hs
+Done
+```
+
+Of the 158 files in Shake, as of this moment, 152 can be loaded by the IDE, but 6 can't (error messages for the reasons they can't be loaded are given earlier). The failing files are all prototype work or test output, meaning I can confidently use Shake.
+
+The `hie-core` executable mostly relies on [`hie-bios`](https://github.com/mpickering/hie-bios) to do the difficult work of setting up your GHC environment. If it doesn't work, see [the `hie-bios` manual](https://github.com/mpickering/hie-bios#readme) to get it working. My default fallback is to figure it out by hand and create a `direct` style [`hie.yaml`](https://github.com/ndmitchell/shake/blob/master/hie.yaml) listing the command line arguments to load the project.
 
-Next, set up an extension for your editor.
+Once you have got `hie-core` working outside the editor, the next step is to pick which editor to integrate with.
 
 ### Using with VS Code
 
@@ -36,7 +56,7 @@ Install the VS code extension
 
 Now openning a `.hs` file should work with `hie-core`.
 
-### Emacs
+### Using with Emacs
 
 The frst step is to install required Emacs packages. If you don't already have [Melpa](https://melpa.org/#/) package installation configured in your `.emacs`, put this stanza at the top.
 
@@ -63,7 +83,7 @@ There are two things you can do about this warning:
 ;; Remember : to avoid package-not-found errors, refresh the package
 ;; database now and then with M-x package-refresh-contents.
 ```
-   
+
 When this is in your `.emacs` and evaluated, `M-x package-refresh-contents` to get the package database downloaded and then `M-x package-list-packages` to display the available packages. Click on a package to install it. You'll need to install the following packages:
 
 * `lsp-haskell`
@@ -93,13 +113,3 @@ Optionally, you may wish to add the following conveniences:
 (define-key flymake-mode-map (kbd "M-n") 'flymake-goto-next-error)
 (define-key flymake-mode-map (kbd "M-p") 'flymake-goto-prev-error)
 ```
-
-### Testing
-
-For testing, I've been using the `ghc-lib-gen` target of the [`ghc-lib` project](https://github.com/digital-asset/ghc-lib). Navigate to the root of `ghc-lib` and create an `hie.yaml` file with contents
-
-```yaml
-cradle: {cabal: {component: "exe:ghc-lib-gen"}}
-```
-
-Invoke `cabal new-configure -w ~/.stack/programs/~/.stack/programs/x86_64-osx/ghc-8.6.5/bin/ghc` (this is the `ghc` used by `stack` to build `hie-core` - consult `//compiler/hie-core/stack.yaml` to help work out what you should write here). This last step will create a file `cabal.project.local` with contents pointing `cabal` to use the desired `ghc`. You can build `ghc-lib-gen` from the `ghc-lib` directory with the command `cabal new-build` as you like. After creating `cabal.project.local`, you should be all set. Open `ghc-lib/ghc-lib-gen/src/Main.hs` in a buffer and, for example, hover should bring up type/definition info.
diff --git a/compiler/hie-core/exe/Arguments.hs b/compiler/hie-core/exe/Arguments.hs
@@ -0,0 +1,27 @@
+-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+module Arguments(Arguments(..), getArguments) where
+
+import Options.Applicative
+
+
+data Arguments = Arguments
+    {argLSP :: Bool
+    ,argsCwd :: Maybe FilePath
+    ,argFiles :: [FilePath]
+    }
+
+getArguments :: IO Arguments
+getArguments = execParser opts
+  where
+    opts = info (arguments <**> helper)
+      ( fullDesc
+     <> progDesc "Used as a test bed to check your IDE will work"
+     <> header "hie-core - the core of a Haskell IDE")
+
+arguments :: Parser Arguments
+arguments = Arguments
+      <$> switch (long "lsp" <> help "Start talking to an LSP server")
+      <*> optional (strOption $ long "cwd" <> metavar "DIR" <> help "Change to this directory")
+      <*> many (argument str (metavar "FILES/DIRS..."))
diff --git a/compiler/hie-core/test/Demo.hs → compiler/hie-core/exe/Main.hs b/compiler/hie-core/test/Demo.hs → compiler/hie-core/exe/Main.hs
@@ -1,11 +1,14 @@
 -- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
 -- SPDX-License-Identifier: Apache-2.0
 
-module Demo(main) where
+module Main(main) where
 
+import Arguments
 import Data.Maybe
+import Data.List.Extra
+import System.FilePath
 import Control.Concurrent.Extra
-import Control.Monad
+import Control.Monad.Extra
 import Data.Default
 import System.Time.Extra
 import Development.IDE.Core.FileStore
@@ -22,7 +25,7 @@ import Development.IDE.Types.Logger
 import qualified Data.Text.IO as T
 import Language.Haskell.LSP.Messages
 import Development.IDE.LSP.LanguageServer
-import System.Directory
+import System.Directory.Extra as IO
 import System.Environment
 import System.IO
 import Development.Shake hiding (Env)
@@ -44,36 +47,68 @@ main :: IO ()
 main = do
     -- WARNING: If you write to stdout before runLanguageServer
     --          then the language server will not work
-    hPutStrLn stderr "Starting hie-core Demo"
-    args <- getArgs
+    hPutStrLn stderr "Starting hie-core"
+    Arguments{..} <- getArguments
+
     -- lock to avoid overlapping output on stdout
     lock <- newLock
     let logger = makeOneLogger $ withLock lock . T.putStrLn
 
+    whenJust argsCwd setCurrentDirectory
+
     dir <- getCurrentDirectory
     hPutStrLn stderr dir
 
-    cradle <- findCradle (dir <> "/")
-
-    let options = defaultIdeOptions $ liftIO $ newSession' cradle
-
-    if "--lsp" `elem` args then do
-        hPutStrLn stderr "Starting IDE server"
+    if argLSP then do
+        t <- offsetTime
+        hPutStrLn stderr "Starting LSP server..."
         runLanguageServer def def $ \event vfs -> do
-            hPutStrLn stderr "Server started"
+            t <- t
+            hPutStrLn stderr $ "Started LSP server in " ++ showDuration t
+            let options = defaultIdeOptions $ liftIO $ newSession' =<< findCradle (dir <> "/")
             initialise (mainRule >> action kick) event logger options vfs
     else do
-        let files = map toNormalizedFilePath $ filter (/= "--lsp") args
+        putStrLn "[1/6] Finding hie-bios cradle"
+        cradle <- findCradle (dir <> "/")
+        print cradle
+
+        putStrLn "\n[2/6] Converting Cradle to GHC session"
+        env <- newSession' cradle
+
+        putStrLn "\n[3/6] Initialising IDE session"
         vfs <- makeVFSHandle
-        ide <- initialise mainRule (showEvent lock) logger options vfs
-        setFilesOfInterest ide $ Set.fromList files
-        runAction ide kick
-        -- shake now writes an async message that it is completed with timing info,
-        -- so we sleep briefly to wait for it to have been written
-        sleep 0.01
+        ide <- initialise mainRule (showEvent lock) logger (defaultIdeOptions $ return env) vfs
+
+        putStrLn "\n[4/6] Finding interesting files"
+        files <- nubOrd <$> expandFiles (argFiles ++ ["." | null argFiles])
+        putStrLn $ "Found " ++ show (length files) ++ " files"
+
+        putStrLn "\n[5/6] Setting interesting files"
+        setFilesOfInterest ide $ Set.fromList $ map toNormalizedFilePath files
+
+        putStrLn "\n[6/6] Loading interesting files"
+        results <- runActionSync ide $ uses TypeCheck $ map toNormalizedFilePath files
+        let (worked, failed) = partition fst $ zip (map isJust results) files
+        putStrLn $ "Files that worked: " ++ show (length worked)
+        putStrLn $ "Files that failed: " ++ show (length failed)
+        putStr $ unlines $ map ((++) " * " . snd) failed
+
         putStrLn "Done"
 
 
+expandFiles :: [FilePath] -> IO [FilePath]
+expandFiles = concatMapM $ \x -> do
+    b <- IO.doesFileExist x
+    if b then return [x] else do
+        let recurse "." = True
+            recurse x | "." `isPrefixOf` takeFileName x = False -- skip .git etc
+            recurse x = takeFileName x `notElem` ["dist","dist-newstyle"] -- cabal directories
+        files <- filter (\x -> takeExtension x `elem` [".hs",".lhs"]) <$> listFilesInside (return . recurse) x
+        when (null files) $
+            fail $ "Couldn't find any .hs/.lhs files inside directory: " ++ x
+        return files
+
+
 kick :: Action ()
 kick = do
     files <- getFilesOfInterest

diff --git a/compiler/hie-core/hie-core.cabal b/compiler/hie-core/hie-core.cabal
@@ -103,25 +103,27 @@ library
 
 executable hie-core
     default-language:   Haskell2010
-    main-is: Demo.hs
-    ghc-options: -main-is Demo.main
+    hs-source-dirs:     exe
+    main-is: Main.hs
     build-depends:
         base == 4.*,
         containers,
         directory,
+        optparse-applicative,
         hie-bios,
         shake,
         data-default,
         ghc-paths,
         ghc,
         extra,
+        filepath,
         haskell-lsp,
         text,
         hie-core
+    other-modules:
+        Arguments
 
     default-extensions:
         TupleSections
         RecordWildCards
         ViewPatterns
-
-    hs-source-dirs:     test