Add script to install multiple versions at once. (#29)

Eg (given that my local bin path for the project is set to ./.bin in my stack.yaml):

$ ./install.hs
<lots out output>
$ ls .bin
haskell-code-indexer-8.0.2*  haskell-code-indexer-8.4.4*
haskell-code-indexer-8.2.2*  haskell-code-indexer-8.6.3*
haskell-code-indexer-8.4.3*  haskell-code-server*

Note that it works by installing and then moving the `haskell-code-indexer` executable in your project's bin to `haskell-code-indexer-X-Y-Z`. So if you already have a plain `haskell-code-indexer` executable before the run it will be deleted.

It uses plain IO instead of Shake because Shake runs actions in unpredictable order. One of the goals of the script is that it will install haskell-code-server and the latest haskell-code-indexer as soon as possible, so that it's useful even if you have to cancel the run for some reason. Shake was running the haskell-code-indexer command at the correct time, but then waiting to copy it to its -X-Y-Z final home until near the end of the run.

(Also this is really just a simple install script, we don't need another layer of caching from Shake for it.)

1 files changed, 162 insertions, 0 deletions

diff --git a/install.hs b/install.hs
new file mode 100755
index 0000000..d8c36c1
--- /dev/null
+++ b/install.hs
@@ -0,0 +1,162 @@
+#!/usr/bin/env stack
+{- stack script
+  --resolver lts-13.12
+  --ghc-options -Wall
+-}
+
+-- = About
+--
+-- Install multiple versions of haskell-code-indexer, each with the version of
+-- GHC it was built with appended to the executable name.
+--
+-- = Original
+--
+-- Modified from the BSD3 licensed script at:
+-- https://github.com/haskell/haskell-ide-engine/blob/ec5e34ca52d389b713df918f02ff63920aede4be/install.hs
+--
+-- Thanks haskell-ide-engine folks!
+--
+-- = Changes from the original
+--
+-- + Switched from Shake to IO script
+-- + Added optparse-applicative
+-- + Switched to Stack only (PRs welcome to support other tools)
+module Main (main) where
+
+import Control.Monad
+import Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LBS
+import Data.Char (isSpace)
+import Data.Foldable
+import Data.List (dropWhileEnd)
+import qualified Data.Text as T
+import Data.Text.Encoding
+import Development.Shake.FilePath
+import Options.Applicative
+import System.Directory (copyFile, removeFile)
+import System.Process.Typed
+
+-- | Keep this in sync with the stack.yamls at the top level of the project.
+supportedGhcVersions :: [Version]
+supportedGhcVersions =
+  map Version ["8.0.2", "8.2.2", "8.4.3", "8.4.4", "8.6.3"]
+
+newtype Version = Version { unVersion :: String } deriving Eq
+
+-- * CLI args
+
+data Args = Args
+  { argBuildVersions :: [Version]
+  , argBuildServer :: Bool
+  }
+
+cliArgs :: IO Args
+cliArgs =
+  customExecParser (prefs showHelpOnError) argsParser
+
+argsParser :: ParserInfo Args
+argsParser =
+  fmap defaultToAll $
+    info (helper <*> parser) (fullDesc <> progDesc desc)
+  where
+    parser :: Parser Args
+    parser =
+      Args
+        <$> (some indexVersion <|> pure mempty)
+        <*> switch
+              (  long "server"
+              <> help "Build haskell-code-server"
+              )
+
+    indexVersion :: Parser Version
+    indexVersion =
+      argument (eitherReader checkVersion)
+        ( metavar "INDEX_VERSION"
+        <> help "haskell-code-indexer-X-Y-Z version to build"
+        )
+
+    checkVersion :: String -> Either String Version
+    checkVersion s =
+        case find ((==) (Version s)) supportedGhcVersions of
+          Nothing ->
+            Left . unwords $
+                "Not a supported GHC version. Currently supported versions are:"
+              : map unVersion supportedGhcVersions
+
+          Just v ->
+            Right v
+
+    defaultToAll :: Args -> Args
+    defaultToAll args =
+      if argBuildVersions args == mempty && argBuildServer args == False
+        then Args (reverse supportedGhcVersions) True -- reverse to build latest first
+        else args
+
+    desc :: String
+    desc =
+      "Install haskell-code-indexer executables with the GHC version they were"
+      <> " compiled with appended to their name. Builds everything if you don't"
+      <> " specify options. Not that if you already have an indexer executable"
+      <> " without the GHC version appended in your Stack's local bin"
+      <> " it will be deleted."
+
+-- * Build
+
+main :: IO ()
+main =
+  run =<< cliArgs
+
+run :: Args -> IO ()
+run args = do
+  putStrLn (startupNotice args)
+  when (argBuildServer args) buildServer
+  for_ (argBuildVersions args) buildVersion
+
+startupNotice :: Args -> String
+startupNotice args =
+  unlines
+     $ "Building:"
+     : (if argBuildServer args
+         then ["  + haskell-code-explorer"]
+         else mempty)
+    <> map versionEntry (argBuildVersions args)
+  where
+    versionEntry :: Version -> String
+    versionEntry v =
+      "  + haskell-code-indexer-" <> unVersion v
+
+buildServer :: IO ()
+buildServer =
+  void $ execStack ["build", "--copy-bins", "haskell-code-explorer:haskell-code-server"]
+
+buildVersion :: Version -> IO ()
+buildVersion v = do
+  execStackWithVersion_ v ["build", "--copy-bins", "haskell-code-explorer:haskell-code-indexer"]
+  localBinDir <- getLocalBin
+
+  let
+    -- exe is "exe" on Windows and "" otherwise
+    fromFile = localBinDir </> "haskell-code-indexer" <.> exe
+    toFile = localBinDir </> "haskell-code-indexer-" ++ unVersion v <.> exe
+
+  copyFile fromFile toFile
+  removeFile fromFile
+
+-- | E.g. @"/home/user/bin"@.
+getLocalBin :: IO FilePath
+getLocalBin = do
+  stackLocalDir' <- decodeUtf8 <$> execStack ["path", "--stack-yaml=stack.yaml", "--local-bin"]
+  pure $ trimEnd (T.unpack stackLocalDir')
+
+-- | Uses the stack.yaml for the given @Version@.
+execStackWithVersion_ :: Version -> [String] -> IO ()
+execStackWithVersion_ v args = do
+  let stackFile = "stack-" ++ unVersion v ++ ".yaml"
+  void $ execStack (("--stack-yaml=" ++ stackFile) : args)
+
+execStack :: [String] -> IO ByteString
+execStack =
+  fmap LBS.toStrict . readProcessStdout_ . proc "stack"
+
+trimEnd :: String -> String
+trimEnd = dropWhileEnd isSpace