diff --git a/CabalHelper/Compile.hs b/CabalHelper/Compile.hs --- a/CabalHelper/Compile.hs +++ b/CabalHelper/Compile.hs @@ -308,10 +308,17 @@ ( [ Version [1,18,1] [] ] , fixArrayConstraint ), + + ( [ Version [1,18,0] [] ] , \dir -> do fixArrayConstraint dir fixOrphanInstance dir + ), + + -- just want the pristine version + ( [ Version [1,24,1,0] [] ] + , \_ -> return () ) ] where @@ -359,7 +366,8 @@ unpackCabal opts cabalVer tmpdir = do let cabal = "Cabal-" ++ showVersion cabalVer dir = tmpdir cabal - callProcessStderr (Just tmpdir) (cabalProgram opts) [ "get", cabal ] + callProcessStderr (Just tmpdir) (cabalProgram opts) + [ "get", "--pristine", cabal ] return dir unpackCabalHEAD :: FilePath -> IO (FilePath, String) diff --git a/CabalHelper/Main.hs b/CabalHelper/Main.hs --- a/CabalHelper/Main.hs +++ b/CabalHelper/Main.hs @@ -120,7 +120,7 @@ ++" ) ...\n" commands :: [String] -commands = [ "print-bli" +commands = [ "print-lbi" , "package-id" , "flags" , "config-flags" diff --git a/Distribution/Helper.hs b/Distribution/Helper.hs --- a/Distribution/Helper.hs +++ b/Distribution/Helper.hs @@ -415,8 +415,7 @@ findLibexecExe :: IO FilePath findLibexecExe = do libexecdir <- getLibexecDir - let Version (mj:mi:_) _ = version - exeName = "cabal-helper-wrapper-v" ++ show mj ++ "." ++ show mi + let exeName = "cabal-helper-wrapper" exe = libexecdir exeName <.> exeExtension' exists <- doesFileExist exe diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,38 @@ +# cabal-helper + +`cabal-helper` provides a library which wraps the internal use of +anexecutable to lift the restrictions imposed by linking against versions of +GHC before `7.10`. This has the pleasant side effect of isolating the user +from having to deal with Cabal version changes manually as `cabal-helper` +can simply recompile it's helper program automatically as needed. + +`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. + +`cabal-helper` can compile with `Cabal >= 1.14` but requires `Cabal >= 1.16` +at runtime. + +## IRC + +If you have any problems, suggestions, comments swing by +[\#ghc-mod (web client)](https://kiwiirc.com/client/irc.freenode.org/ghc-mod) on +Freenode. If you're reporting a bug please also create an issue +[here](https://github.com/DanielG/cabal-helper/issues) so we have a way to +contact you if you don't have time to stay. + +Do hang around for a while if no one answers and repeat your question if you +still haven't gotten any answer after a day or so. You're most likely to get an +answer during the day in GMT+1. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,27 +1,47 @@ #!/usr/bin/env runhaskell -{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE RecordWildCards, NamedFieldPuns #-} import Distribution.Simple +import Distribution.Simple.Utils import Distribution.Simple.Setup import Distribution.Simple.Install import Distribution.Simple.Register -import Distribution.Simple.InstallDirs as ID +import Distribution.Simple.BuildPaths +import qualified Distribution.Simple.InstallDirs as ID import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program import Distribution.PackageDescription +import qualified Data.Map as M +import Data.Map (Map) + +import Control.Arrow import Control.Applicative import Control.Monad import Data.List import Data.Maybe +import Data.Version +import Data.Monoid +import System.Process +import System.Exit import System.FilePath +import System.Directory (renameFile) main :: IO () main = defaultMainWithHooks $ simpleUserHooks { - instHook = inst, - copyHook = copy, - hookedPrograms = [ simpleProgram "cabal" ] - } + instHook = inst, + copyHook = copy, + buildHook = \pd lbi hooks flags -> (buildHook simpleUserHooks) pd (patchLibexecdir lbi) hooks flags, + hookedPrograms = [ simpleProgram "cabal" ] + } +patchLibexecdir :: LocalBuildInfo -> LocalBuildInfo +patchLibexecdir lbi = let + idirtpl = installDirTemplates lbi + libexecdir' = toPathTemplate $ fromPathTemplate (libexecdir idirtpl) "$abi/$pkgid" + lbi' = lbi { installDirTemplates = idirtpl { libexecdir = libexecdir' } } + in + lbi' + -- mostly copypasta from 'defaultInstallHook' inst :: PackageDescription -> LocalBuildInfo -> UserHooks -> InstallFlags -> IO () @@ -31,7 +51,7 @@ copyDest = toFlag NoCopyDest, copyVerbosity = installVerbosity ifl } - xInstallTarget pd lbi (\pd' lbi' -> install pd' lbi' copyFlags) + xInstallTarget pd lbi copyFlags (\pd' lbi' -> install pd' lbi' copyFlags) let registerFlags = defaultRegisterFlags { regDistPref = installDistPref ifl, regInPlace = installInPlace ifl, @@ -42,58 +62,44 @@ copy :: PackageDescription -> LocalBuildInfo -> UserHooks -> CopyFlags -> IO () copy pd lbi _uh cf = - xInstallTarget pd lbi (\pd' lbi' -> install pd' lbi' cf) - - + xInstallTarget pd lbi cf (\pd' lbi' -> install pd' lbi' cf) xInstallTarget :: PackageDescription -> LocalBuildInfo + -> CopyFlags -> (PackageDescription -> LocalBuildInfo -> IO ()) -> IO () -xInstallTarget pd lbi fn = do - let (extended, regular) = partition (isJust . installTarget) (executables pd) +xInstallTarget pd lbi cf fn = do + let (extended, regular) = partition isInternal (executables pd) let pd_regular = pd { executables = regular } _ <- flip mapM extended $ \exe -> do - putStrLn $ "extended " ++ show (exeName exe) - let - idirtpl = installDirTemplates lbi - env = installDirsTemplateEnv idirtpl - libexecdir' = fromPathTemplate (libexecdir idirtpl) - - pd_extended = onlyExePackageDesc [exe] pd - install_target = fromJust $ installTarget exe - install_target' = ID.substPathTemplate env install_target - -- $libexec isn't a real thing :/ so we have to simulate it - install_target'' = substLibExec' libexecdir' install_target' - - let lbi' = lbi { - installDirTemplates = - (installDirTemplates lbi) { - bindir = install_target'' - } - } - fn pd_extended lbi' + let pd_extended = onlyExePackageDesc [exe] pd - fn pd_regular lbi + fn pd_extended lbi - where - installTarget :: Executable -> Maybe PathTemplate - installTarget exe = - toPathTemplate <$> lookup "x-install-target" (customFieldsBI $ buildInfo exe) + let lbi' = patchLibexecdir lbi + copydest = fromFlag (copyDest cf) + verbosity = fromFlag (copyVerbosity cf) + InstallDirs { bindir, libexecdir } = absoluteInstallDirs pd lbi' copydest + progprefix = substPathTemplate (packageId pd) lbi (progPrefix lbi) + progsuffix = substPathTemplate (packageId pd) lbi (progSuffix lbi) + fixedExeBaseName = progprefix ++ exeName exe ++ progsuffix - substLibExec libexecdir "$libexecdir" = libexecdir - substLibExec _ comp = comp + fixedExeFileName = bindir fixedExeBaseName <.> exeExtension + newExeFileName = libexecdir fixedExeBaseName <.> exeExtension - substLibExec' dir = - withPT $ - withSP $ map (substLibExec dir . dropTrailingPathSeparator) + createDirectoryIfMissingVerbose verbosity True libexecdir + renameFile fixedExeFileName newExeFileName + fn pd_regular lbi - withPT f pt = toPathTemplate $ f (fromPathTemplate pt) - withSP f p = joinPath $ f (splitPath p) + where + isInternal :: Executable -> Bool + isInternal exe = + fromMaybe False $ (=="True") <$> lookup "x-internal" (customFieldsBI $ buildInfo exe) onlyExePackageDesc :: [Executable] -> PackageDescription -> PackageDescription onlyExePackageDesc exes pd = emptyPackageDescription { diff --git a/cabal-helper.cabal b/cabal-helper.cabal --- a/cabal-helper.cabal +++ b/cabal-helper.cabal @@ -1,5 +1,5 @@ name: cabal-helper -version: 0.7.2.0 +version: 0.7.3.0 synopsis: Simple interface to some of Cabal's configuration state used by ghc-mod description: @cabal-helper@ provides a library which wraps the internal use of an @@ -34,34 +34,45 @@ category: Distribution build-type: Custom cabal-version: >=1.10 -extra-source-files: CabalHelper/Main.hs +extra-source-files: README.md + CabalHelper/Main.hs CabalHelper/Licenses.hs source-repository head type: git location: https://github.com/DanielG/cabal-helper.git +Custom-Setup + Setup-Depends: base + , Cabal >= 1.14 && < 1.25 + , containers + , filepath + , directory + , process + , template-haskell + , transformers + library exposed-modules: Distribution.Helper - Other-Modules: Paths_cabal_helper + other-modules: Paths_cabal_helper , CabalHelper.Types , CabalHelper.Sandbox default-language: Haskell2010 - GHC-Options: -Wall - Build-Depends: base < 5 && >= 4.5 - , Cabal < 1.26 && >= 1.14 - , directory < 1.3 && >= 1.1.0.2 + ghc-options: -Wall + build-depends: base < 5 && >= 4.5 + , Cabal < 1.25 && >= 1.14 + , directory < 1.4 && >= 1.1.0.2 , filepath < 1.5 && >= 1.3.0.0 , transformers < 0.6 && >= 0.3.0.0 , mtl < 2.3 && >= 2.0 , process < 1.5 && >= 1.1.0.1 , ghc-prim -Executable cabal-helper-wrapper-v0.7 - Default-Language: Haskell2010 - Other-Extensions: TemplateHaskell - Main-Is: CabalHelper/Wrapper.hs - Other-Modules: Paths_cabal_helper +executable cabal-helper-wrapper + default-language: Haskell2010 + other-extensions: TemplateHaskell + main-is: CabalHelper/Wrapper.hs + other-modules: Paths_cabal_helper CabalHelper.Types CabalHelper.Common CabalHelper.GuessGhc @@ -69,12 +80,12 @@ CabalHelper.Compile CabalHelper.Log CabalHelper.Sandbox - GHC-Options: -Wall - X-Install-Target: $libexecdir - Build-Depends: base < 5 && >= 4.5 - , Cabal < 1.26 && >= 1.14 + ghc-options: -Wall + x-internal: True + build-depends: base < 5 && >= 4.5 + , Cabal < 1.25 && >= 1.14 , bytestring < 0.11 && >= 0.9.2.1 - , directory < 1.3 && >= 1.1.0.2 + , directory < 1.4 && >= 1.1.0.2 , filepath < 1.5 && >= 1.3.0.0 , transformers < 0.6 && >= 0.3.0.0 , mtl < 2.3 && >= 2.0 @@ -85,11 +96,11 @@ , template-haskell , ghc-prim -Test-Suite spec - Default-Language: Haskell2010 - Type: exitcode-stdio-1.0 - Main-Is: Spec.hs - Other-Modules: CabalHelper.Common +test-suite spec + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: CabalHelper.Common CabalHelper.Compile CabalHelper.Data CabalHelper.Log @@ -97,13 +108,13 @@ CabalHelper.Types Distribution.Helper Paths_cabal_helper - Hs-Source-Dirs: tests, . - GHC-Options: -Wall - Build-Tools: cabal - Build-Depends: base < 5 && >= 4.5 + hs-source-dirs: tests, . + ghc-options: -Wall + build-tools: cabal + build-depends: base < 5 && >= 4.5 , Cabal < 1.26 && >= 1.14 , bytestring < 0.11 && >= 0.9.2.1 - , directory < 1.3 && >= 1.1.0.2 + , directory < 1.4 && >= 1.1.0.2 , filepath < 1.5 && >= 1.3.0.0 , transformers < 0.6 && >= 0.3.0.0 , mtl < 2.3 && >= 2.0 @@ -119,28 +130,20 @@ , ghc-prim , cabal-helper - - - --- custom-setup --- setup-depends: base, --- Cabal, --- filepath - -- TODO: Use cabal_macros.h to replace -D flags by including it in -- CabalHelper.Data -- --- Executable cabal-helper-main +-- executable cabal-helper-main -- if flag(dev) --- Buildable: True +-- buildable: True -- else --- Buildable: False --- Default-Language: Haskell2010 --- Default-Extensions: NondecreasingIndentation --- Main-Is: CabalHelper/Main.hs --- Other-Modules: --- GHC-Options: -Wall -fno-warn-unused-imports -optP-DCABAL_MAJOR=1 -optP-DCABAL_MINOR=25 -optP-DCABAL_HELPER=1 -optP-DCABAL_HELPER_DEV=1 --- Build-Depends: base +-- buildable: False +-- default-language: Haskell2010 +-- default-extensions: NondecreasingIndentation +-- main-is: CabalHelper/Main.hs +-- other-modules: +-- ghc-options: -Wall -fno-warn-unused-imports -optP-DCABAL_MAJOR=1 -optP-DCABAL_MINOR=25 -optP-DCABAL_HELPER=1 -optP-DCABAL_HELPER_DEV=1 +-- build-depends: base -- , Cabal -- , containers -- , bytestring diff --git a/tests/Spec.hs b/tests/Spec.hs --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -45,11 +45,13 @@ , "1.18.1.4" , "1.18.1.5" , "1.18.1.6" + , "1.18.1.7" , "1.20.0.0" , "1.20.0.1" , "1.20.0.2" , "1.20.0.3" + , "1.20.0.4" , "1.22.0.0" , "1.22.1.0" , "1.22.1.1" @@ -66,7 +68,9 @@ ]), ("8.0", [ "1.24.0.0" - , "HEAD" + , "1.24.1.0" + , "1.24.2.0" +-- , "HEAD" ]) ] @@ -76,25 +80,38 @@ rvs <- mapM compilePrivatePkgDb cabalVers - if any isLeft' rvs - then print rvs >> exitFailure + let printStatus (cv, rv) = putStrLn $ "- Cabal "++show cv++" "++status + where status = case rv of + Right _ -> + "suceeded" + Left rvc -> + "failed (exit code "++show rvc++")" + + let drvs = cabalVers `zip` rvs + + mapM_ printStatus (cabalVers `zip` rvs) + if any isLeft' $ map snd $ filter ((/=Left HEAD) . fst) drvs + then exitFailure else exitSuccess + where isLeft' (Left _) = True isLeft' (Right _) = False -data HEAD = HEAD deriving (Show) +data HEAD = HEAD deriving (Eq, Show) compilePrivatePkgDb :: Either HEAD Version -> IO (Either ExitCode FilePath) compilePrivatePkgDb (Left HEAD) = do _ <- rawSystem "rm" [ "-r", "/tmp/.ghc-mod" ] (db, commit) <- installCabalHEAD defaultOptions { verbose = True } `E.catch` - \(SomeException ex) -> error $ "Installing cabal HEAD failed: " ++ show ex + \(SomeException ex) -> + error $ "Installing cabal HEAD failed: " ++ show ex compileWithPkg "." (Just db) (Left commit) compilePrivatePkgDb (Right cabalVer) = do _ <- rawSystem "rm" [ "-r", "/tmp/.ghc-mod" ] db <- installCabal defaultOptions { verbose = True } cabalVer `E.catch` - \(SomeException _) -> errorInstallCabal cabalVer "dist" + \(SomeException _) -> + errorInstallCabal cabalVer "dist" compileWithPkg "." (Just db) (Right cabalVer) compileWithPkg :: FilePath