diff options
| -rw-r--r-- | CabalHelper/Common.hs | 8 | ||||
| -rw-r--r-- | CabalHelper/Compile.hs | 67 | ||||
| -rw-r--r-- | cabal-helper.cabal | 2 | ||||
| -rw-r--r-- | tests/Spec.hs | 8 |
4 files changed, 75 insertions, 10 deletions
diff --git a/CabalHelper/Common.hs b/CabalHelper/Common.hs index 154441e..391a842 100644 --- a/CabalHelper/Common.hs +++ b/CabalHelper/Common.hs @@ -95,3 +95,11 @@ takeExtension' p = if takeFileName p == takeExtension p then "" -- just ".cabal" is not a valid cabal file else takeExtension p + +replace n r h = go "" n r h + where + go acc n r h + | take (length n) h == n = + reverse acc ++ r ++ drop (length n) h + go acc n r (h:hs) = go (h:acc) n r hs + go acc n r [] = reverse acc diff --git a/CabalHelper/Compile.hs b/CabalHelper/Compile.hs index 0de69b8..85d4370 100644 --- a/CabalHelper/Compile.hs +++ b/CabalHelper/Compile.hs @@ -34,6 +34,7 @@ import System.FilePath import System.Process import System.Exit import System.IO +import System.IO.Temp import Prelude import Distribution.System (buildPlatform) @@ -248,7 +249,17 @@ installCabal opts ver = do \\n\ \Installing Cabal %s ...\n" appdir sver sver sver - db <- createPkgDb opts ver + withSystemTempDirectory "cabal-helper" $ \tmpdir -> do + let + mpatch :: Maybe (FilePath -> IO ()) + mpatch = snd <$> find ((ver`elem`) . fst) patchyCabalVersions + msrcdir <- sequenceA $ unpackPatchedCabal opts ver tmpdir <$> mpatch + db <- createPkgDb opts ver + cabalInstall opts db ver msrcdir + return db + +cabalInstall :: Options -> FilePath -> Version -> Maybe FilePath -> IO () +cabalInstall opts db ver msrcdir = do cabalInstallVer <- cabalInstallVersion opts cabal_opts <- return $ concat [ @@ -264,15 +275,61 @@ installCabal opts ver = do , if ghcPkgProgram opts /= ghcPkgProgram defaultOptions then [ "--with-ghc-pkg=" ++ ghcPkgProgram opts ] else [] - , [ "install", "Cabal", "--constraint" - , "Cabal == " ++ showVersion ver ] + , + case msrcdir of + Nothing -> + [ "install", "Cabal" + , "--constraint", "Cabal == " ++ showVersion ver + ] + Just srcdir -> + [ "install", srcdir ] ] - vLog opts $ intercalate " " $ map (("\""++) . (++"\"")) $ cabalProgram opts:cabal_opts + vLog opts $ intercalate " " + $ map (("\""++) . (++"\"")) + $ cabalProgram opts:cabal_opts callProcessStderr (Just "/") (cabalProgram opts) cabal_opts hPutStrLn stderr "done" - return db + +patchyCabalVersions :: [([Version], FilePath -> IO ())] +patchyCabalVersions = [ + ( [ Version [1,18,1] [] ] + , fixArrayConstraint + ), + ( [ Version [1,18,0] [] ] + , \dir -> do + fixArrayConstraint dir + fixOrphanInstance dir + ) + ] + where + fixArrayConstraint dir = do + let cabalFile = dir </> "Cabal.cabal" + cabalFileTmp = cabalFile ++ ".tmp" + + cf <- readFile cabalFile + writeFile cabalFileTmp $ replace "&& < 0.5" "&& < 0.6" cf + renameFile cabalFileTmp cabalFile + + fixOrphanInstance dir = do + let versionFile = dir </> "Distribution/Version.hs" + versionFileTmp = versionFile ++ ".tmp" + + vf <- readFile versionFile + writeFile versionFileTmp $ replace "deriving instance Data Version" "" vf + renameFile versionFileTmp versionFile + +unpackPatchedCabal :: + Options -> Version -> FilePath -> (FilePath -> IO ()) -> IO FilePath +unpackPatchedCabal opts cabalVer tmpdir patch = do + let cabal = "Cabal-" ++ showVersion cabalVer + dir = tmpdir </> cabal + + callProcessStderr (Just tmpdir) (cabalProgram opts) [ "get", cabal ] + + patch dir + return dir errorInstallCabal :: Version -> FilePath -> a errorInstallCabal cabalVer _distdir = panic $ printf "\ diff --git a/cabal-helper.cabal b/cabal-helper.cabal index ca55044..9a7a2b6 100644 --- a/cabal-helper.cabal +++ b/cabal-helper.cabal @@ -102,4 +102,4 @@ Test-Suite spec , bytestring , utf8-string , template-haskell - , temporary
\ No newline at end of file + , temporary diff --git a/tests/Spec.hs b/tests/Spec.hs index 35bdcc2..54d88df 100644 --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -32,10 +32,10 @@ main = do ]), ("7.8", [ --- "1.18.0" --- , "1.18.1" - "1.18.1.1" --- , "1.18.1.2" + "1.18.0" + , "1.18.1" + , "1.18.1.1" + , "1.18.1.2" , "1.18.1.3" , "1.18.1.4" , "1.18.1.5" |