cabal-helper 0.2.0.0 → 0.3.0.0

raw patch · 6 files changed

+124/−112 lines, 6 filesdep +ghc-primdep ~Cabalbuild-type:CustomPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

Dependency ranges changed: Cabal

API changes (from Hackage documentation)

Files

• CabalHelper/Data.hs +1/−0
• CabalHelper/Main.hs +69/−61
• CabalHelper/Types.hs +18/−10
• CabalHelper/Wrapper.hs +5/−5
• Distribution/Helper.hs +21/−26
• cabal-helper.cabal +10/−10

@@ -15,6 +15,7 @@ -- along with this program.  If not, see <http://www.gnu.org/licenses/>.  {-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -fforce-recomp #-} module CabalHelper.Data where  import Control.Monad

@@ -43,6 +43,7 @@                                            componentBuildInfo,                                            externalPackageDeps,                                            withComponentsLBI,+                                           withLibLBI,                                            inplacePackageId)  import Distribution.Simple.GHC (componentGhcOptions)@@ -88,7 +89,7 @@      ++"DIST_DIR ( version\n"      ++"         | print-lbi\n"      ++"         | write-autogen-files\n"-     ++"         | ghc-options [--with-inplace]\n"+     ++"         | ghc-options     [--with-inplace]\n"      ++"         | ghc-src-options [--with-inplace]\n"      ++"         | ghc-pkg-options [--with-inplace]\n"      ++"         | entrypoints\n"@@ -124,11 +125,8 @@    let       -- a =<< b $$ c   ==  (a =<< b) $$ c-      -- a <$$> b $$ c  ==  a <$$> (b $$ c)       infixr 2 $$       ($$) = ($)-      infixr 1 <$$>-      (<$$>) = (<$>)        collectCmdOptions :: [String] -> [[String]]       collectCmdOptions =@@ -157,30 +155,31 @@       initialBuildSteps distdir pd lbi v       return Nothing -    "ghc-options":flags ->-      Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$-      \c clbi bi -> let+    "ghc-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 pd clbi+                               [] -> removeInplaceDeps v lbi pd clbi++            opts = componentGhcOptions v lbi bi clbi' outdir-           in-              renderGhcOptions' lbi v $ opts `mappend` adopts+         in renderGhcOptions' lbi v (opts `mappend` adopts)+      return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])]) -    "ghc-src-options":flags ->-      Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$-      \c clbi bi -> let+    "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 pd clbi+                               [] -> removeInplaceDeps v lbi pd clbi            opts = componentGhcOptions v lbi bi clbi' outdir            comp = compiler lbi             opts' = mempty {                -- Not really needed but "unexpected package db stack: []"                ghcOptPackageDBs      = [GlobalPackageDB],+                ghcOptCppOptions      = ghcOptCppOptions opts,                ghcOptCppIncludePath  = ghcOptCppIncludePath opts,                ghcOptCppIncludes     = ghcOptCppIncludes opts,@@ -188,17 +187,16 @@                ghcOptSourcePathClear = ghcOptSourcePathClear opts,                ghcOptSourcePath      = ghcOptSourcePath opts               }-            in-              renderGhcOptions' lbi v $ opts `mappend` adopts+         in renderGhcOptions' lbi v $ opts `mappend` adopts+      return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])]) -    "ghc-pkg-options":flags ->-      Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$-      \c clbi bi -> let+    "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 pd clbi+                               [] -> removeInplaceDeps v lbi pd clbi            opts = componentGhcOptions v lbi bi clbi' outdir             opts' = mempty {@@ -206,23 +204,23 @@                        ghcOptPackages   = ghcOptPackages opts,                        ghcOptHideAllPackages = ghcOptHideAllPackages opts                    }-           in-             renderGhcOptions' lbi v $ opts' `mappend` adopts+         in renderGhcOptions' lbi v $ opts' `mappend` adopts+      return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])      "entrypoints":[] -> do       eps <- componentsMap lbi v distdir $ \c clbi bi ->                return $ componentEntrypoints c       -- MUST append Setup component at the end otherwise CabalHelper gets       -- confused-      let eps' = eps ++ [(GmSetupHsName, Right [GmModuleName "Setup"])]-      return $ Just $ GmCabalHelperEntrypoints eps'+      let eps' = eps ++ [(ChSetupHsName, ChSetupEntrypoint)]+      return $ Just $ ChResponseEntrypoints eps' -    "source-dirs":[] ->-      Just . GmCabalHelperStrings <$$> componentsMap lbi v distdir $$-      \c clbi bi -> return $ hsSourceDirs bi+    "source-dirs":[] -> do+      res <- componentsMap lbi v distdir $$ \_ _ bi -> return $ hsSourceDirs bi+      return $ Just $ ChResponseStrings (res ++ [(ChSetupHsName, [])])      "print-lbi":[] ->-      return $ Just $ GmCabalHelperLbi $ show lbi+      return $ Just $ ChResponseLbi $ show lbi      cmd:_ | not (cmd `elem` commands) ->             errMsg ("Unknown command: " ++ cmd) >> usage >> exitFailure@@ -236,6 +234,15 @@   withLib pd (writeIORef lr)   readIORef lr +getLibraryClbi pd lbi = unsafePerformIO $ do+  lr <- newIORef (error "getLibraryClbi: empty IORef")++  withLibLBI pd lbi $ \ lib clbi ->+      writeIORef lr (lib,clbi)++  readIORef lr++ componentsMap :: LocalBuildInfo               -> Verbosity               -> FilePath@@ -243,7 +250,7 @@                   -> ComponentLocalBuildInfo                   -> BuildInfo                   -> IO a)-              -> IO [(GmComponentName, a)]+              -> IO [(ChComponentName, a)] componentsMap lbi v distdir f = do     let pd = localPkgDescr lbi @@ -255,13 +262,14 @@          l' <- readIORef lr         r <- f c clbi bi-        writeIORef lr $ (componentNameToGm name, r):l'+        writeIORef lr $ (componentNameToCh name, r):l'+     reverse <$> readIORef lr -componentNameToGm CLibName = GmLibName-componentNameToGm (CExeName n) = GmExeName n-componentNameToGm (CTestName n) = GmTestName n-componentNameToGm (CBenchName n) = GmBenchName n+componentNameToCh CLibName = ChLibName+componentNameToCh (CExeName n) = ChExeName n+componentNameToCh (CTestName n) = ChTestName n+componentNameToCh (CBenchName n) = ChBenchName n  componentNameFromComponent (CLib Library {}) = CLibName componentNameFromComponent (CExe Executable {..}) = CExeName exeName@@ -277,24 +285,26 @@ componentOutDir lbi (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _ _, ..})=     exeOutDir lbi benchmarkName -gmModuleName :: C.ModuleName -> GmModuleName-gmModuleName = GmModuleName . intercalate "." . components+gmModuleName :: C.ModuleName -> ChModuleName+gmModuleName = ChModuleName . intercalate "." . components -componentEntrypoints :: Component -> Either FilePath [GmModuleName]+componentEntrypoints :: Component -> ChEntrypoint componentEntrypoints (CLib Library {..})-    = Right $ map gmModuleName $ exposedModules ++ (otherModules libBuildInfo)+    = ChLibEntrypoint+        (map gmModuleName exposedModules)+        (map gmModuleName $ otherModules libBuildInfo) componentEntrypoints (CExe Executable {..})-    = Left modulePath-componentEntrypoints (CTest TestSuite { testInterface = TestSuiteExeV10 _ fp })-    = Left fp-componentEntrypoints (CTest TestSuite { testInterface = TestSuiteLibV09 _ mn })-    = Right [gmModuleName mn]+    = ChExeEntrypoint modulePath (map gmModuleName $ otherModules buildInfo)+componentEntrypoints (CTest TestSuite { testInterface = TestSuiteExeV10 _ fp, ..})+    = ChExeEntrypoint fp (map gmModuleName $ otherModules testBuildInfo)+componentEntrypoints (CTest TestSuite { testInterface = TestSuiteLibV09 _ mn, ..})+    = ChLibEntrypoint [gmModuleName mn] (map gmModuleName $ otherModules testBuildInfo) componentEntrypoints (CTest TestSuite {})-    = Right []-componentEntrypoints (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _  fp})-    = Left fp+    = ChLibEntrypoint [] []+componentEntrypoints (CBench Benchmark { benchmarkInterface = BenchmarkExeV10 _  fp, ..})+    = ChExeEntrypoint fp (map gmModuleName $ otherModules benchmarkBuildInfo) componentEntrypoints (CBench Benchmark {})-    = Left []+    = ChLibEntrypoint [] []  exeOutDir :: LocalBuildInfo -> String -> FilePath exeOutDir lbi exeName =@@ -309,26 +319,24 @@   in targetDir  -removeInplaceDeps :: PackageDescription+removeInplaceDeps :: Verbosity+                  -> LocalBuildInfo+                  -> PackageDescription                   -> ComponentLocalBuildInfo                   -> (ComponentLocalBuildInfo, GhcOptions)-removeInplaceDeps pd clbi = let+removeInplaceDeps v lbi pd clbi = let+    (lib, libclbi) = getLibraryClbi pd lbi+    libbi = libBuildInfo lib+    liboutdir = componentOutDir lbi (CLib lib)+    libopts = (componentGhcOptions v lbi libbi libclbi liboutdir) {+                                    ghcOptPackageDBs = []+                                  }+     (ideps, deps) = partition isInplaceDep (componentPackageDeps clbi)     hasIdeps = not $ null ideps     clbi' = clbi { componentPackageDeps = deps }-    lib = getLibrary pd-    src_dirs = hsSourceDirs (libBuildInfo lib)-    adopts = mempty {-               ghcOptSourcePath      =-#if CABAL_MAJOR == 1 && CABAL_MINOR >= 22-                   toNubListR src_dirs-#else-                   src_dirs-#endif -             }--  in (clbi', if hasIdeps then adopts else mempty)+  in (clbi', if hasIdeps then libopts else mempty)   where    isInplaceDep :: (InstalledPackageId, PackageId) -> Bool

@@ -14,27 +14,35 @@ -- 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 #-} module CabalHelper.Types where +import GHC.Generics+ newtype ChModuleName = ChModuleName String-    deriving (Eq, Ord, Read, Show)+    deriving (Eq, Ord, Read, Show, Generic)  data ChComponentName = ChSetupHsName                      | ChLibName                      | ChExeName String                      | ChTestName String                      | ChBenchName String-  deriving (Eq, Ord, Read, Show)+  deriving (Eq, Ord, Read, Show, Generic) -data Response-    = ResponseStrings    [(ChComponentName, [String])]-    | ResponseEntrypoints [(ChComponentName, ChEntrypoint)]-    | ResponseLbi String-  deriving (Eq, Ord, Read, Show)+data ChResponse+    = ChResponseStrings    [(ChComponentName, [String])]+    | ChResponseEntrypoints [(ChComponentName, ChEntrypoint)]+    | ChResponseLbi String+  deriving (Eq, Ord, Read, Show, Generic) -data ChEntrypoint = ChExeEntrypoint { chMainIs         :: FilePath+data ChEntrypoint = ChSetupEntrypoint -- ^ Almost like 'ChExeEntrypoint' but+                                      -- @main-is@ could either be @"Setup.hs"@+                                      -- or @"Setup.lhs"@. Since we don't know+                                      -- where the source directory is you have+                                      -- to find these files.+                  | ChLibEntrypoint { chExposedModules :: [ChModuleName]                                     , chOtherModules   :: [ChModuleName]                                     }-                  | ChLibentrypoint { chExposedModules :: [ChModuleName]+                  | ChExeEntrypoint { chMainIs         :: FilePath                                     , chOtherModules   :: [ChModuleName]-                                    } deriving (Eq, Ord, Read, Show)+                                    } deriving (Eq, Ord, Read, Show, Generic)

@@ -236,15 +236,15 @@           , "-optP-DCABAL_MAJOR=" ++ show mj           , "-optP-DCABAL_MINOR=" ++ show mi           ],-          maybeToList $ ("-package-db="++) <$> packageDb,-          map ("-i"++) $ cabalHelperSourceDir:maybeToList cabalSourceDir,+          maybeToList $ ("-package-conf="++) <$> packageDb,+          map ("-i"++) $ ".":maybeToList cabalSourceDir,           concatMap (\p -> ["-package", p]) packageDeps,-          [ "--make",  cabalHelperSourceDir </> "CabalHelper/Main.hs" ]+          [ "--make",  "CabalHelper/Main.hs" ]          ]      -- TODO: touch exe after, ghc doesn't do that if the input files didn't     -- actually change-    rv <- callProcessStderr' Nothing ghcProgram ghc_opts+    rv <- callProcessStderr' (Just cabalHelperSourceDir) ghcProgram ghc_opts     return $ case rv of                ExitSuccess -> Right exe                e@(ExitFailure _) -> Left e@@ -353,7 +353,7 @@ -- TODO: Include sandbox? Probably only relevant for build-type:custom projects. listCabalVersions' :: Options -> Maybe FilePath -> IO [Version] listCabalVersions' Options {..} mdb = do-  let mdbopt = ("--package-db="++) <$> mdb+  let mdbopt = ("--package-conf="++) <$> mdb       opts = ["list", "--simple-output", "Cabal"] ++ maybeToList mdbopt    catMaybes . map (fmap snd . parsePkgId . fromString) . words

@@ -14,15 +14,16 @@ -- 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 CPP, FlexibleContexts, ConstraintKinds, DeriveDataTypeable #-}+{-# LANGUAGE CPP, FlexibleContexts, ConstraintKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, DeriveGeneric #-}+ module Distribution.Helper (     Programs(..)    -- * Running Queries   , Query   , runQuery-  , runKQuery-  , runKQuery_+  , runQuery'    -- * Queries against Cabal\'s on disk state @@ -62,6 +63,7 @@ import System.Directory import System.Process import Text.Printf+import GHC.Generics  import Paths_cabal_helper (getLibexecDir) import CabalHelper.Types@@ -71,7 +73,7 @@       cabalProgram  :: FilePath,       ghcProgram    :: FilePath,       ghcPkgProgram :: FilePath-    }+    } deriving (Eq, Ord, Show, Read, Generic, Typeable)  instance Default Programs where     def = Programs "cabal" "ghc" "ghc-pkg"@@ -89,6 +91,7 @@ -- running all possible queries against it at once is cheap. newtype Query m a = Query { unQuery :: StateT (Maybe SomeLocalBuildInfo)                                          (ReaderT (Programs, FilePath) m) a }+    deriving (Functor, Applicative, Monad)  type MonadQuery m = ( MonadIO m                     , MonadState (Maybe SomeLocalBuildInfo) m@@ -99,25 +102,17 @@ -- | @runQuery query distdir@. Run a 'Query'. @distdir@ is where Cabal's -- @setup-config@ file is located. runQuery :: Monad m-         => Query m a-         -> FilePath -- ^ Path to @dist/@+         => FilePath -- ^ Path to @dist/@+         -> Query m a          -> m a-runQuery action fp = run (def, fp) Nothing action---- | Run a 'Query' as an Arrow by wrapping it in a 'Kleisli' constructor.-runKQuery :: Monad m-          => Kleisli (Query m) a b-          -> FilePath -- ^ Path to @dist/@-          -> a-          -> m b-runKQuery (Kleisli action) fp a = run (def, fp) Nothing (action a)+runQuery fp action = run (def, fp) Nothing action --- | Same as 'runKQuery' but pass unit as input to the arrow.-runKQuery_ :: Monad m-           => Kleisli (Query m) () b-           -> FilePath -- ^ Path to @dist/@-           -> m b-runKQuery_ (Kleisli action) fp = run (def, fp) Nothing (action ())+runQuery' :: Monad m+         => Programs+         -> FilePath -- ^ Path to @dist/@+         -> Query m a+         -> m a+runQuery' progs fp action = run (progs, fp) Nothing action  getSlbi :: MonadQuery m => m SomeLocalBuildInfo getSlbi = do@@ -192,11 +187,11 @@                      , intercalate " " (map show $ distdir:args)                      , " (read failed)"] -  let [ Just (ResponseEntrypoints eps),-        Just (ResponseStrings srcDirs),-        Just (ResponseStrings ghcOpts),-        Just (ResponseStrings ghcSrcOpts),-        Just (ResponseStrings ghcPkgOpts) ] = res+  let [ Just (ChResponseEntrypoints eps),+        Just (ChResponseStrings srcDirs),+        Just (ChResponseStrings ghcOpts),+        Just (ChResponseStrings ghcSrcOpts),+        Just (ChResponseStrings ghcPkgOpts) ] = res    return $ SomeLocalBuildInfo eps srcDirs ghcOpts ghcSrcOpts ghcPkgOpts 

@@ -1,35 +1,33 @@ name:                cabal-helper-version:             0.2.0.0+version:             0.3.0.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     to lift the restrictions imposed by linking against versions of GHC before     @7.10@.-+    .     @cabal-helper@ uses a wrapper executable to compile the actual cabal-helper     executable at runtime while linking against an arbitrary version of     Cabal. This runtime-compiled helper executable is then used to extract     various bits and peices from Cabal\'s on disk state (dist/setup-config)     written by it's configure command.-+    .     In addition to this the wrapper executable also supports installing any     version of Cabal from hackage in case it cannot be found in any available     package database. The wrapper installs these instances of the Cabal library     into a private package database so as to not interfere with the user's     packages.-+    .     Furthermore the wrapper supports one special case namely reading a state     file for Cabal itself. This is needed as Cabal compiles it's Setup.hs using     itself and not using any version of Cabal installed in any package database. -    Currently @cabal-helper@ supports @Cabal >= 1.16@.- license:             AGPL-3 license-file:        LICENSE author:              Daniel Gröber <dxld@darkboxed.org> maintainer:          dxld@darkboxed.org category:            Distribution-build-type:          Simple+build-type:          Custom cabal-version:       >=1.10 extra-source-files:  CabalHelper/Main.hs @@ -39,15 +37,17 @@  library   exposed-modules:     Distribution.Helper-  build-depends:       base >= 4.5 && < 5+  Other-Modules:       Paths_cabal_helper+                     , CabalHelper.Types   default-language:    Haskell2010-  Build-Depends:       base+  Build-Depends:       base >= 4.5 && < 5                      , data-default                      , directory                      , filepath                      , transformers                      , mtl                      , process+                     , ghc-prim  Executable cabal-helper-wrapper   Default-Language:    Haskell2010@@ -62,7 +62,7 @@   X-Install-Target:    $libexecdir   Build-Depends:       base >= 4.5 && < 5                      , bytestring-                     , Cabal+                     , Cabal >= 1.16 && <= 1.22                      , directory                      , filepath                      , process