cabal-helper 0.3.4.0 → 0.3.5.0

raw patch · 6 files changed

+85/−58 lines, 6 filesdep +extradep +unixPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: extra, unix

API changes (from Hackage documentation)

Files

• CabalHelper/Main.hs +41/−34
• CabalHelper/Types.hs +3/−2
• CabalHelper/Wrapper.hs +6/−3
• Distribution/Helper.hs +26/−18
• cabal-helper.cabal +3/−1
• tests/Spec.hs +6/−0

@@ -94,6 +94,7 @@      ++"         | ghc-options     [--with-inplace]\n"      ++"         | ghc-src-options [--with-inplace]\n"      ++"         | ghc-pkg-options [--with-inplace]\n"+     ++"         | ghc-merged-pkg-options [--with-inplace]\n"      ++"         | ghc-lang-options [--with-inplace]\n"      ++"         | entrypoints\n"      ++"         | source-dirs\n"@@ -126,6 +127,7 @@   v <- maybe silent (const deafening) . lookup  "GHC_MOD_DEBUG" <$> getEnvironment   lbi <- unsafeInterleaveIO $ getPersistBuildConfig distdir   let pd = localPkgDescr lbi+  let lvd = (lbi, v, distdir)    let       -- a =<< b $$ c   ==  (a =<< b) $$ c@@ -173,18 +175,10 @@             opts = componentGhcOptions normal lbi bi clbi' outdir          in renderGhcOptions' lbi v (opts `mappend` adopts)-      return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])+      return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])      "ghc-src-options":flags -> do-      res <- componentsMap lbi v distdir $ \c clbi bi -> let-           outdir = componentOutDir lbi c-           (clbi', adopts) = case flags of-                               ["--with-inplace"] -> (clbi, mempty)-                               [] -> removeInplaceDeps v lbi pd clbi-           opts = componentGhcOptions normal lbi bi clbi' outdir-           comp = compiler lbi--           opts' = mempty {+      res <- componentOptions lvd flags $ \opts -> mempty {                -- Not really needed but "unexpected package db stack: []"                ghcOptPackageDBs      = [GlobalPackageDB, UserPackageDB], @@ -195,44 +189,43 @@                ghcOptSourcePathClear = ghcOptSourcePathClear opts,                ghcOptSourcePath      = ghcOptSourcePath opts               }-         in renderGhcOptions' lbi v $ opts `mappend` adopts-      return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])+      return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])      "ghc-pkg-options":flags -> do-      res <- componentsMap lbi v distdir $ \c clbi bi -> let-           comp = compiler lbi-           outdir = componentOutDir lbi c-           (clbi', adopts) = case flags of-                               ["--with-inplace"] -> (clbi, mempty)-                               [] -> removeInplaceDeps v lbi pd clbi-           opts = componentGhcOptions normal lbi bi clbi' outdir+      res <- componentOptions lvd flags $ \opts -> mempty {+                       ghcOptPackageDBs = ghcOptPackageDBs opts,+                       ghcOptPackages   = ghcOptPackages opts,+                       ghcOptHideAllPackages = ghcOptHideAllPackages opts+                   }+      return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])]) -           opts' = mempty {+    "ghc-merged-pkg-options":flags -> do+      let pd = localPkgDescr lbi+      res <- mconcat . map snd <$> (componentsMap lbi v distdir $ \c clbi bi -> let+        outdir = componentOutDir lbi c+        opts = componentGhcOptions normal lbi bi clbi outdir+        comp = compiler lbi+        opts' = mempty {                        ghcOptPackageDBs = ghcOptPackageDBs opts,                        ghcOptPackages   = ghcOptPackages opts,                        ghcOptHideAllPackages = ghcOptHideAllPackages opts                    }-         in renderGhcOptions' lbi v $ opts' `mappend` adopts-      return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])]) -    "ghc-lang-options":flags -> do-      res <- componentsMap lbi v distdir $ \c clbi bi -> let-           comp = compiler lbi-           outdir = componentOutDir lbi c-           (clbi', adopts) = case flags of-                               ["--with-inplace"] -> (clbi, mempty)-                               [] -> removeInplaceDeps v lbi pd clbi-           opts = componentGhcOptions normal lbi bi clbi' outdir+         in return opts') -           opts' = mempty {+      let res' = res { ghcOptPackageDBs = nub $ ghcOptPackageDBs res }++      Just . ChResponseList <$> renderGhcOptions' lbi v res'++    "ghc-lang-options":flags -> do+      res <- componentOptions lvd flags $ \opts -> mempty {                        ghcOptPackageDBs      = [GlobalPackageDB, UserPackageDB],                         ghcOptLanguage = ghcOptLanguage opts,                        ghcOptExtensions = ghcOptExtensions opts,                        ghcOptExtensionMap = ghcOptExtensionMap opts                    }-         in renderGhcOptions' lbi v $ opts' `mappend` adopts-      return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])+      return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])      "entrypoints":[] -> do       eps <- componentsMap lbi v distdir $ \c clbi bi ->@@ -244,7 +237,7 @@      "source-dirs":[] -> do       res <- componentsMap lbi v distdir $$ \_ _ bi -> return $ hsSourceDirs bi-      return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])+      return $ Just $ ChResponseCompList (res ++ [(ChSetupHsName, [])])      "print-lbi":[] ->       return $ Just $ ChResponseLbi $ show lbi@@ -292,6 +285,20 @@         writeIORef lr $ (componentNameToCh name, r):l'      reverse <$> readIORef lr++componentOptions (lbi, v, distdir) flags f = do+  let pd = localPkgDescr lbi+  componentsMap lbi v distdir $ \c clbi bi -> let+           outdir = componentOutDir lbi c+           (clbi', adopts) = case flags of+                               ["--with-inplace"] -> (clbi, mempty)+                               [] -> removeInplaceDeps v lbi pd clbi+           opts = componentGhcOptions normal lbi bi clbi' outdir+           comp = compiler lbi+           opts' = f opts++         in renderGhcOptions' lbi v $ opts' `mappend` adopts+  componentNameToCh CLibName = ChLibName componentNameToCh (CExeName n) = ChExeName n

@@ -14,7 +14,7 @@ -- You should have received a copy of the GNU Affero General Public License -- along with this program.  If not, see <http://www.gnu.org/licenses/>. -{-# LANGUAGE DeriveGeneric, DefaultSignatures #-}+{-# LANGUAGE DeriveGeneric, DeriveDataTypeable, DefaultSignatures #-} module CabalHelper.Types where  import GHC.Generics@@ -31,8 +31,9 @@   deriving (Eq, Ord, Read, Show, Generic)  data ChResponse-    = ChResponseStrings    [(ChComponentName, [String])]+    = ChResponseCompList    [(ChComponentName, [String])]     | ChResponseEntrypoints [(ChComponentName, ChEntrypoint)]+    | ChResponseList        [String]     | ChResponseLbi String     | ChResponseVersion String Version   deriving (Eq, Ord, Read, Show, Generic)

@@ -148,6 +148,8 @@    -- | Check if this version is globally available    compileGlobal :: FilePath -> MaybeT IO (Either ExitCode FilePath)    compileGlobal chdir = do+      -- TODO: add option to let user specify custom package-db, relevant when+      -- using a Cabal compiled from git!        _ <- MaybeT $ find (== cabalVer) <$> listCabalVersions opts        liftIO $ compileWithPkg chdir Nothing @@ -190,7 +192,7 @@    cabalPkgId v = "Cabal-" ++ showVersion v  errorInstallCabal :: Version -> FilePath -> a-errorInstallCabal cabalVer distdir = panic $ printf "\+errorInstallCabal cabalVer _distdir = panic $ printf "\ \Installing Cabal version %s failed.\n\ \\n\ \You have the following choices to fix this:\n\@@ -295,8 +297,9 @@   appdir <- appDataDir   let sver = showVersion ver   hPutStr stderr $ printf "\-\cabal-helper-wrapper: Installing a private copy of Cabal, this might take a\n\-\while but will only happen once per Cabal version.\n\+\cabal-helper-wrapper: Installing a private copy of Cabal because we couldn't\n\+\find the right version in your global/user package-db, this might take a\n\+\while but will only happen once per Cabal version you're using.\n\ \\n\ \If anything goes horribly wrong just delete this directory and try again:\n\ \    %s\n\

@@ -32,6 +32,7 @@   , ghcOptions   , ghcSrcOptions   , ghcPkgOptions+  , ghcMergedPkgOptions   , ghcLangOptions    -- * Result types@@ -85,12 +86,13 @@     def = Programs "cabal" "ghc" "ghc-pkg"  data SomeLocalBuildInfo = SomeLocalBuildInfo {-      slbiEntrypoints   :: [(ChComponentName, ChEntrypoint)],-      slbiSourceDirs    :: [(ChComponentName, [String])],-      slbiGhcOptions    :: [(ChComponentName, [String])],-      slbiGhcSrcOptions :: [(ChComponentName, [String])],-      slbiGhcPkgOptions :: [(ChComponentName, [String])],-      slbiGhcLangOptions :: [(ChComponentName, [String])]+      slbiEntrypoints         :: [(ChComponentName, ChEntrypoint)],+      slbiSourceDirs          :: [(ChComponentName, [String])],+      slbiGhcOptions          :: [(ChComponentName, [String])],+      slbiGhcSrcOptions       :: [(ChComponentName, [String])],+      slbiGhcPkgOptions       :: [(ChComponentName, [String])],+      slbiGhcMergedPkgOptions :: [String],+      slbiGhcLangOptions      :: [(ChComponentName, [String])]     } deriving (Eq, Ord, Read, Show)  -- | Caches helper executable result so it doesn't have to be run more than once@@ -149,15 +151,19 @@ -- access any home modules. ghcPkgOptions :: MonadIO m => Query m [(ChComponentName, [String])] +-- | Like @ghcPkgOptions@ but for the whole package not just one component+ghcMergedPkgOptions :: MonadIO m => Query m [String]+ -- | Only language related options, i.e. @-XSomeExtension@ ghcLangOptions :: MonadIO m => Query m [(ChComponentName, [String])] -entrypoints   = Query $ slbiEntrypoints   `liftM` getSlbi-sourceDirs    = Query $ slbiSourceDirs    `liftM` getSlbi-ghcOptions    = Query $ slbiGhcOptions    `liftM` getSlbi-ghcSrcOptions = Query $ slbiGhcSrcOptions `liftM` getSlbi-ghcPkgOptions = Query $ slbiGhcPkgOptions `liftM` getSlbi-ghcLangOptions = Query $ slbiGhcLangOptions `liftM` getSlbi+entrypoints         = Query $ slbiEntrypoints         `liftM` getSlbi+sourceDirs          = Query $ slbiSourceDirs          `liftM` getSlbi+ghcOptions          = Query $ slbiGhcOptions          `liftM` getSlbi+ghcSrcOptions       = Query $ slbiGhcSrcOptions       `liftM` getSlbi+ghcPkgOptions       = Query $ slbiGhcPkgOptions       `liftM` getSlbi+ghcMergedPkgOptions = Query $ slbiGhcMergedPkgOptions `liftM` getSlbi+ghcLangOptions      = Query $ slbiGhcLangOptions      `liftM` getSlbi  -- | Run @cabal configure@ reconfigure :: MonadIO m@@ -188,6 +194,7 @@              , "ghc-options"              , "ghc-src-options"              , "ghc-pkg-options"+             , "ghc-merged-pkg-options"              , "ghc-lang-options"              ] ++ progArgs @@ -200,14 +207,15 @@                      , " (read failed)"]    let [ Just (ChResponseEntrypoints eps),-        Just (ChResponseStrings srcDirs),-        Just (ChResponseStrings ghcOpts),-        Just (ChResponseStrings ghcSrcOpts),-        Just (ChResponseStrings ghcPkgOpts),-        Just (ChResponseStrings ghcLangOpts) ] = res+        Just (ChResponseCompList srcDirs),+        Just (ChResponseCompList ghcOpts),+        Just (ChResponseCompList ghcSrcOpts),+        Just (ChResponseCompList ghcPkgOpts),+        Just (ChResponseList     ghcMergedPkgOpts),+        Just (ChResponseCompList ghcLangOpts) ] = res    return $ SomeLocalBuildInfo-             eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts ghcLangOpts+    eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts ghcMergedPkgOpts ghcLangOpts  -- | Create @cabal_macros.h@ and @Paths_\<pkg\>@ possibly other generated files -- in the usual place.

@@ -1,5 +1,5 @@ name:                cabal-helper-version:             0.3.4.0+version:             0.3.5.0 synopsis:            Simple interface to Cabal's configuration state used by ghc-mod description:     @cabal-helper@ provides a library which wraps the internal use of executables@@ -83,3 +83,5 @@   GHC-Options:         -Wall   Build-Depends:       base >= 4.5 && < 5                      , cabal-helper+                     , extra+                     , unix

@@ -1,4 +1,10 @@ import Distribution.Helper+import System.Environment.Extra (lookupEnv)+import System.Posix.Env (setEnv)+import Data.Maybe+import Data.Functor +main :: IO () main = do+  flip (setEnv "HOME") True =<< fromMaybe "/tmp" <$> lookupEnv "TMPDIR"   writeAutogenFiles "./dist"