Add hpack configuration option.

scott-fleischman · scott-fleischman · commit 06f6397bca72 · 2017-09-20T09:54:16.000-07:00
diff --git a/ChangeLog.md b/ChangeLog.md
@@ -51,6 +51,9 @@ Behavior changes:
 
 Other enhancements:
 
+* The `with-hpack` configuration option specifies an Hpack executable to use
+  instead of the Hpack bundled with Stack. Please
+  see [#3179](https://github.com/commercialhaskell/stack/issues/3179).
 * It's now possible to skip tests and benchmarks using `--skip`
   flag
 * `GitSHA1` is now `StaticSHA256` and is implemented using the `StaticSize 64 ByteString` for improved performance.
diff --git a/doc/faq.md b/doc/faq.md
@@ -528,3 +528,4 @@ Yes:
 
 * If a package directory contains an Hpack `package.yaml` file, then Stack will use it to generate a `.cabal` file when building the package.
 * You can run `stack init` to initialize a `stack.yaml` file regardless of whether your packages are declared with `.cabal` files or with Hpack `package.yaml` files.
+* You can use the `with-hpack` configuration option to specify an Hpack executable to use instead of the Hpack bundled with Stack.
diff --git a/doc/yaml_configuration.md b/doc/yaml_configuration.md
@@ -460,6 +460,14 @@ Specify a path to gcc explicitly, rather than relying on the normal path resolut
 with-gcc: /usr/local/bin/gcc-5
 ```
 
+### with-hpack
+
+Use an Hpack executable, rather than using the bundled Hpack.
+
+```yaml
+with-hpack: /usr/local/bin/hpack
+```
+
 ### compiler-check
 
 (Since 0.1.4)
diff --git a/src/Stack/Config.hs b/src/Stack/Config.hs
@@ -283,7 +283,8 @@ configFromConfigMonoid
          configExtraIncludeDirs = configMonoidExtraIncludeDirs
          configExtraLibDirs = configMonoidExtraLibDirs
          configOverrideGccPath = getFirst configMonoidOverrideGccPath
-
+         configOverrideHpack = maybe HpackBundled HpackCommand $ getFirst configMonoidOverrideHpack
+         
          -- Only place in the codebase where platform is hard-coded. In theory
          -- in the future, allow it to be configured.
          (Platform defArch defOS) = buildPlatform
diff --git a/src/Stack/Options/ConfigParser.hs b/src/Stack/Options/ConfigParser.hs
@@ -20,7 +20,7 @@ import qualified System.FilePath as FilePath
 -- | Command-line arguments parser for configuration.
 configOptsParser :: FilePath -> GlobalOptsContext -> Parser ConfigMonoid
 configOptsParser currentDir hide0 =
-    (\stackRoot workDir buildOpts dockerOpts nixOpts systemGHC installGHC arch ghcVariant ghcBuild jobs includes libs overrideGccPath skipGHCCheck skipMsys localBin modifyCodePage allowDifferentUser dumpLogs -> mempty
+    (\stackRoot workDir buildOpts dockerOpts nixOpts systemGHC installGHC arch ghcVariant ghcBuild jobs includes libs overrideGccPath overrideHpack skipGHCCheck skipMsys localBin modifyCodePage allowDifferentUser dumpLogs -> mempty
         { configMonoidStackRoot = stackRoot
         , configMonoidWorkDir = workDir
         , configMonoidBuildOpts = buildOpts
@@ -36,6 +36,7 @@ configOptsParser currentDir hide0 =
         , configMonoidExtraIncludeDirs = includes
         , configMonoidExtraLibDirs = libs
         , configMonoidOverrideGccPath = overrideGccPath
+        , configMonoidOverrideHpack = overrideHpack
         , configMonoidSkipMsys = skipMsys
         , configMonoidLocalBinPath = localBin
         , configMonoidModifyCodePage = modifyCodePage
@@ -103,6 +104,12 @@ configOptsParser currentDir hide0 =
             <> help "Use gcc found at PATH-TO-GCC"
             <> hide
              ))
+    <*> optionalFirst (strOption
+             ( long "with-hpack"
+            <> metavar "HPACK"
+            <> help "Use HPACK executable (overrides bundled Hpack)"
+            <> hide
+             ))
     <*> firstBoolFlags
             "skip-ghc-check"
             "skipping the GHC version and architecture check"
diff --git a/src/Stack/Package.hs b/src/Stack/Package.hs
@@ -99,6 +99,7 @@ import qualified System.Directory as D
 import           System.FilePath (splitExtensions, replaceExtension)
 import qualified System.FilePath as FilePath
 import           System.IO.Error
+import           System.Process.Run (runCmd, Cmd(..))
 
 data Ctx = Ctx { ctxFile :: !(Path Abs File)
                , ctxDir :: !(Path Abs Dir)
@@ -171,7 +172,7 @@ readPackageBS packageConfig loc bs =
 -- | Get 'GenericPackageDescription' and 'PackageDescription' reading info
 -- from given directory.
 readPackageDescriptionDir
-  :: (MonadLogger m, MonadIO m, MonadThrow m, HasRunner env,
+  :: (MonadLogger m, MonadIO m, MonadUnliftIO m, MonadThrow m, HasRunner env, HasConfig env,
       MonadReader env m)
   => PackageConfig
   -> Path Abs Dir
@@ -1280,7 +1281,7 @@ logPossibilities dirs mn = do
 -- generate a .cabal file from it.
 findOrGenerateCabalFile
     :: forall m env.
-          (MonadIO m, MonadLogger m, HasRunner env, MonadReader env m)
+          (MonadIO m, MonadUnliftIO m, MonadLogger m, HasRunner env, HasConfig env, MonadReader env m)
     => Path Abs Dir -- ^ package directory
     -> m (Path Abs File)
 findOrGenerateCabalFile pkgDir = do
@@ -1309,30 +1310,38 @@ findOrGenerateCabalFile pkgDir = do
       where hasExtension fp x = FilePath.takeExtension fp == "." ++ x
 
 -- | Generate .cabal file from package.yaml, if necessary.
-hpack :: (MonadIO m, MonadLogger m, HasRunner env, MonadReader env m)
+hpack :: (MonadIO m, MonadUnliftIO m, MonadLogger m, HasRunner env, HasConfig env, MonadReader env m)
       => Path Abs Dir -> m ()
 hpack pkgDir = do
     let hpackFile = pkgDir </> $(mkRelFile Hpack.packageConfig)
     exists <- liftIO $ doesFileExist hpackFile
     when exists $ do
         prettyDebugL [flow "Running hpack on", display hpackFile]
+
+        config <- view configL
+        case configOverrideHpack config of
+            HpackBundled -> do
 #if MIN_VERSION_hpack(0,18,0)
-        r <- liftIO $ Hpack.hpackResult (Just $ toFilePath pkgDir)
+                r <- liftIO $ Hpack.hpackResult (Just $ toFilePath pkgDir)
 #else
-        r <- liftIO $ Hpack.hpackResult (toFilePath pkgDir)
+                r <- liftIO $ Hpack.hpackResult (toFilePath pkgDir)
 #endif
-        forM_ (Hpack.resultWarnings r) prettyWarnS
-        let cabalFile = styleFile . fromString . Hpack.resultCabalFile $ r
-        case Hpack.resultStatus r of
-            Hpack.Generated -> prettyDebugL
-                [flow "hpack generated a modified version of", cabalFile]
-            Hpack.OutputUnchanged -> prettyDebugL
-                [flow "hpack output unchanged in", cabalFile]
-            Hpack.AlreadyGeneratedByNewerHpack -> prettyWarnL
-                [ cabalFile
-                , flow "was generated with a newer version of hpack,"
-                , flow "please upgrade and try again."
-                ]
+                forM_ (Hpack.resultWarnings r) prettyWarnS
+                let cabalFile = styleFile . fromString . Hpack.resultCabalFile $ r
+                case Hpack.resultStatus r of
+                    Hpack.Generated -> prettyDebugL
+                        [flow "hpack generated a modified version of", cabalFile]
+                    Hpack.OutputUnchanged -> prettyDebugL
+                        [flow "hpack output unchanged in", cabalFile]
+                    Hpack.AlreadyGeneratedByNewerHpack -> prettyWarnL
+                        [ cabalFile
+                        , flow "was generated with a newer version of hpack,"
+                        , flow "please upgrade and try again."
+                        ]
+            HpackCommand command -> do
+                envOverride <- getMinimalEnvOverride
+                let cmd = Cmd (Just pkgDir) command envOverride []
+                runCmd cmd Nothing
 
 -- | Path for the package's build log.
 buildLogPath :: (MonadReader env m, HasBuildConfig env, MonadThrow m)
diff --git a/src/Stack/Solver.hs b/src/Stack/Solver.hs
@@ -490,7 +490,7 @@ getResolverConstraints menv mcompilerVersion stackYaml sd = do
 -- file.
 -- Subdirectories can be included depending on the @recurse@ parameter.
 findCabalFiles
-  :: (MonadIO m, MonadLogger m, HasRunner env, MonadReader env m)
+  :: (MonadIO m, MonadUnliftIO m, MonadLogger m, HasRunner env, MonadReader env m, HasConfig env)
   => Bool -> Path Abs Dir -> m [Path Abs File]
 findCabalFiles recurse dir = do
     liftIO (findFiles dir isHpack subdirFilter) >>= mapM_ (hpack . parent)
@@ -586,8 +586,8 @@ formatGroup :: [String] -> String
 formatGroup = concatMap (\path -> "- " <> path <> "\n")
 
 reportMissingCabalFiles
-  :: (MonadIO m, MonadThrow m, MonadLogger m,
-      HasRunner env, MonadReader env m)
+  :: (MonadIO m, MonadUnliftIO m, MonadThrow m, MonadLogger m,
+      HasRunner env, MonadReader env m, HasConfig env)
   => [Path Abs File]   -- ^ Directories to scan
   -> Bool              -- ^ Whether to scan sub-directories
   -> m ()
diff --git a/src/Stack/Types/Build.hs b/src/Stack/Types/Build.hs
@@ -565,6 +565,7 @@ configureOptsNoDir econfig bco deps isLocal package = concat
     , map ("--extra-include-dirs=" ++) (Set.toList (configExtraIncludeDirs config))
     , map ("--extra-lib-dirs=" ++) (Set.toList (configExtraLibDirs config))
     , maybe [] (\customGcc -> ["--with-gcc=" ++ toFilePath customGcc]) (configOverrideGccPath config)
+    , hpackOptions (configOverrideHpack config)
     , ["--ghcjs" | wc == Ghcjs]
     , ["--exact-configuration" | useExactConf]
     ]
@@ -589,6 +590,9 @@ configureOptsNoDir econfig bco deps isLocal package = concat
       where
         toDepOption = if newerCabal then toDepOption1_22 else toDepOption1_18
 
+    hpackOptions HpackBundled = []
+    hpackOptions (HpackCommand cmd) = ["--with-hpack=" ++ cmd]
+
     toDepOption1_22 ident gid = concat
         [ "--dependency="
         , packageNameString $ packageIdentifierName ident
diff --git a/src/Stack/Types/Config.hs b/src/Stack/Types/Config.hs
@@ -58,6 +58,7 @@ module Stack.Types.Config
   -- ** ApplyGhcOptions
   ,ApplyGhcOptions(..)
   -- ** ConfigException
+  ,HpackExecutable(..)
   ,ConfigException(..)
   -- ** WhichSolverCmd
   ,WhichSolverCmd(..)
@@ -306,6 +307,8 @@ data Config =
          -- ^ How many concurrent jobs to run, defaults to number of capabilities
          ,configOverrideGccPath     :: !(Maybe (Path Abs File))
          -- ^ Optional gcc override path
+         ,configOverrideHpack       :: !HpackExecutable
+         -- ^ Use Hpack executable (overrides bundled Hpack)
          ,configExtraIncludeDirs    :: !(Set FilePath)
          -- ^ --extra-include-dirs arguments
          ,configExtraLibDirs        :: !(Set FilePath)
@@ -357,6 +360,11 @@ data Config =
          ,configRunner              :: !Runner
          }
 
+data HpackExecutable
+    = HpackBundled
+    | HpackCommand String
+    deriving (Show, Read, Eq, Ord)
+
 -- | Which packages do ghc-options on the command line apply to?
 data ApplyGhcOptions = AGOTargets -- ^ all local targets
                      | AGOLocals -- ^ all local packages, even non-targets
@@ -705,6 +713,8 @@ data ConfigMonoid =
     -- ^ See: 'configExtraLibDirs'
     , configMonoidOverrideGccPath    :: !(First (Path Abs File))
     -- ^ Allow users to override the path to gcc
+    ,configMonoidOverrideHpack       :: !(First FilePath)
+    -- ^ Use Hpack executable (overrides bundled Hpack)
     ,configMonoidConcurrentTests     :: !(First Bool)
     -- ^ See: 'configConcurrentTests'
     ,configMonoidLocalBinPath        :: !(First FilePath)
@@ -789,6 +799,7 @@ parseConfigMonoidObject rootDir obj = do
     configMonoidExtraLibDirs <- fmap (Set.map (toFilePath rootDir FilePath.</>)) $
         obj ..:?  configMonoidExtraLibDirsName ..!= Set.empty
     configMonoidOverrideGccPath <- First <$> obj ..:? configMonoidOverrideGccPathName
+    configMonoidOverrideHpack <- First <$> obj ..:? configMonoidOverrideHpackName
     configMonoidConcurrentTests <- First <$> obj ..:? configMonoidConcurrentTestsName
     configMonoidLocalBinPath <- First <$> obj ..:? configMonoidLocalBinPathName
     configMonoidImageOpts <- jsonSubWarnings (obj ..:?  configMonoidImageOptsName ..!= mempty)
@@ -914,6 +925,9 @@ configMonoidExtraLibDirsName = "extra-lib-dirs"
 configMonoidOverrideGccPathName :: Text
 configMonoidOverrideGccPathName = "with-gcc"
 
+configMonoidOverrideHpackName :: Text
+configMonoidOverrideHpackName = "with-hpack"
+
 configMonoidConcurrentTestsName :: Text
 configMonoidConcurrentTestsName = "concurrent-tests"
 
diff --git a/src/test/Stack/ConfigSpec.hs b/src/test/Stack/ConfigSpec.hs
@@ -48,6 +48,12 @@ buildOptsConfig =
   "  reconfigure: true\n" ++
   "  cabal-verbose: true\n"
 
+hpackConfig :: String
+hpackConfig =
+  "resolver: lts-2.10\n" ++
+  "with-hpack: /usr/local/bin/hpack\n" ++
+  "packages: ['.']\n"
+
 stackDotYaml :: Path Rel File
 stackDotYaml = $(mkRelFile "stack.yaml")
 
@@ -88,6 +94,18 @@ spec = beforeAll setup $ do
       -- TODO(danburton): more specific test for exception
       loadConfig' (const (return ())) `shouldThrow` anyException
 
+    it "parses config option with-hpack" $ inTempDir $ do
+      writeFile (toFilePath stackDotYaml) hpackConfig
+      loadConfig' $ \lc -> do
+        let Config{..} = lcConfig lc
+        configOverrideHpack `shouldBe` HpackCommand "/usr/local/bin/hpack"
+
+    it "parses config bundled hpack" $ inTempDir $ do
+      writeFile (toFilePath stackDotYaml) sampleConfig
+      loadConfig' $ \lc -> do
+        let Config{..} = lcConfig lc
+        configOverrideHpack `shouldBe` HpackBundled
+
     it "parses build config options" $ inTempDir $ do
      writeFile (toFilePath stackDotYaml) buildOptsConfig
      loadConfig' $ \lc -> do

Original file line number	Diff line number	Diff line change
`@@ -528,3 +528,4 @@ Yes:`
`528`	`528`
`529`	`529`	* If a package directory contains an Hpack `package.yaml` file, then Stack will use it to generate a `.cabal` file when building the package.
`530`	`530`	* You can run `stack init` to initialize a `stack.yaml` file regardless of whether your packages are declared with `.cabal` files or with Hpack `package.yaml` files.
	`531`	+* You can use the `with-hpack` configuration option to specify an Hpack executable to use instead of the Hpack bundled with Stack.