Implement workaround for installing 1.18.{0,1}

There are quite a few distributions of cabal-install that are built with
these broken versions so we patch them on installation now.

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"