Allow more general flag revisions

Allow changing manual flag defaults.
Allow changing flags from manual to automatic.

Author: TuongNM

src/Distribution/Server/Util/CabalRevisions.hs

@@ -250,21 +250,6 @@ checkFlag flagOld flagNew = do
     checkSame "Cannot change ordering of flags"
               (flagName flagOld) (flagName flagNew)
 
-    -- Automatic flags' defaults may be changed as they don't make new
-    -- configurations reachable by the solver that weren't before
-    --
-    -- Moreover, automatic flags may be converted into manual flags
-    -- but not the other way round.
-    --
-    -- NB: We always allow to change the flag description as it has
-    --     purely informational value
-    when (flagManual flagOld) $ do
-        checkSame "Cannot change the default of a manual flag"
-                  (flagDefault flagOld) (flagDefault flagNew)
-
-        checkSame "Cannot change a manual flag into an automatic flag"
-                  (flagManual flagOld) (flagManual flagNew)
-
     let fname = unFlagName (flagName flagOld)
 
     changesOk ("type of flag '" ++ fname ++ "'")

tests/HighLevelTest.hs

@@ -218,7 +218,7 @@ runPackageUploadTests = do
     (testpackageTarFilename, testpackageTarFileContent, _, _, _, _) =
       testpackage
     (testpackageTarFilenameVariant, testpackageTarFileContentVariant, _, _, _, _) =
-      mkPackage "testPackage"
+      mkPackage "testPackage" Nothing
     uploadTime = "Tue Oct 18 20:54:28 UTC 2010"
     uploadTimeISO = "2010-10-18T20:54:28Z"
     uploadTimeISO2 = "2020-10-18T20:54:28Z"
@@ -234,11 +234,66 @@ runRevisionTests = do
        xs <- getUrl NoAuth "/package/testpackage-1.0.0.0/revision/1.cabal"
        unless (xs == revisedCabalFileContent) $
            die "Bad revised cabal file content"
+    do info "Uploading testpackage with flags"
+       postFile isOk
+                (Auth "HackageTestUser1" "testpass1")
+                "/packages/" "package"
+                (testpackageFlagsTarFilename, testpackageFlagsTarFileContent)
+    do info "Revising default for automatic flag"
+       post (Auth "HackageTestUser1" "testpass1") "/package/testpackageFlags-1.0.0.0/testpackageFlags.cabal/edit"
+         [ ("cabalfile", revisedCabalFileContentDefaultAutomaticFlag)
+         , ("publish", "Publish new revision")
+         ]
+    do info "Checking automatic default flag revision exists"
+       xs <- getUrl NoAuth "/package/testpackageFlags-1.0.0.0/revision/1.cabal"
+       unless (xs == revisedCabalFileContentDefaultAutomaticFlag) $
+           die "Bad revised cabal file content"
+    do info "Revising flag to manual"
+       post (Auth "HackageTestUser1" "testpass1") "/package/testpackageFlags-1.0.0.0/testpackageFlags.cabal/edit"
+         [ ("cabalfile", revisedCabalFileContentToManualFlag)
+         , ("publish", "Publish new revision")
+         ]
+    do info "Checking automatic -> manual flag revision exists"
+       xs <- getUrl NoAuth "/package/testpackageFlags-1.0.0.0/revision/2.cabal"
+       unless (xs == revisedCabalFileContentToManualFlag) $
+           die "Bad revised cabal file content"
+    do info "Revising default for manual flag"
+       post (Auth "HackageTestUser1" "testpass1") "/package/testpackageFlags-1.0.0.0/testpackageFlags.cabal/edit"
+         [ ("cabalfile", revisedCabalFileContentDefaultManualFlag)
+         , ("publish", "Publish new revision")
+         ]
+    do info "Checking manual default flag revision exists"
+       xs <- getUrl NoAuth "/package/testpackageFlags-1.0.0.0/revision/3.cabal"
+       unless (xs == revisedCabalFileContentDefaultManualFlag) $
+           die "Bad revised cabal file content"
+    do info "Revising flag to automatic"
+       post (Auth "HackageTestUser1" "testpass1") "/package/testpackageFlags-1.0.0.0/testpackageFlags.cabal/edit"
+         [ ("cabalfile", revisedCabalFileContentToAutomaticFlag)
+         , ("publish", "Publish new revision")
+         ]
+    do info "Checking manual -> automatic flag revision exists"
+       xs <- getUrl NoAuth "/package/testpackageFlags-1.0.0.0/revision/4.cabal"
+       unless (xs == revisedCabalFileContentToAutomaticFlag) $
+           die "Bad revised cabal file content"
   where
     (_, _, _, testpackageCabalFileContent, _, _) = testpackage
     revisedCabalFileContent =
       "x-revision: 1\ndescription: a description added by revision\n"
          ++ testpackageCabalFileContent
+    (testpackageFlagsTarFilename, testpackageFlagsTarFileContent, _, _, _, _) = mkPackage "testpackageFlags" $ Just $ flagDefaultManual False False
+    revisedCabalFileContentDefaultAutomaticFlag = mkTestPackageRevisionFlagDefaultManual True False 1
+    revisedCabalFileContentToManualFlag = mkTestPackageRevisionFlagDefaultManual True True 2
+    revisedCabalFileContentDefaultManualFlag = mkTestPackageRevisionFlagDefaultManual False True 3
+    revisedCabalFileContentToAutomaticFlag = mkTestPackageRevisionFlagDefaultManual False False 4
+    flagDefaultManual flagDefault manual = unlines [
+                                                "flag isTest",
+                                                "  default: " ++ show flagDefault,
+                                                "  manual: " ++ show manual]
+
+    mkTestPackageRevisionFlagDefaultManual :: Bool -> Bool -> Int -> String
+    mkTestPackageRevisionFlagDefaultManual flagDefault manual revision =
+      let (_, _, _, testpackageCabalFlagsFileContent, _, _) = mkPackage "testpackageFlags" $ Just $ flagDefaultManual flagDefault manual
+      in  "x-revision: " ++ show revision ++ "\n" ++ testpackageCabalFlagsFileContent
 
 runPackageTests :: IO ()
 runPackageTests = do
@@ -308,4 +363,4 @@ runPackageTests = do
        = testpackage
 
 testpackage :: (FilePath, String, FilePath, String, FilePath, String)
-testpackage = mkPackage "testpackage"
+testpackage = mkPackage "testpackage" Nothing

tests/Package.hs

@@ -8,13 +8,16 @@ import qualified Data.ByteString.Lazy.Char8 as BS
 import Data.Char
 import System.FilePath
 
-mkPackage :: String -> (FilePath,   -- Tar filename
-                        String,     -- Tar file content
-                        FilePath,   -- Cabal filename in index
-                        String,     -- Cabal file content
-                        FilePath,   -- Haskell filename in source tree
-                        String)     -- Haskell file content
-mkPackage name = (name ++ "-1.0.0.0.tar.gz",               BS.unpack targz,
+mkPackage :: String -> -- Package name
+             Maybe String -> -- Optional additional Cabal file contents
+             (FilePath,   -- Tar filename
+              String,     -- Tar file content
+              FilePath,   -- Cabal filename in index
+              String,     -- Cabal file content
+              FilePath,   -- Haskell filename in source tree
+              String)     -- Haskell file content
+mkPackage name additionalCabalFileContents =
+                 (name ++ "-1.0.0.0.tar.gz",               BS.unpack targz,
                   name ++ "/1.0.0.0/" ++ name ++ ".cabal", cabalFile,
                   modName <.> "hs",                        modFile)
     where targz = compress tar
@@ -39,7 +42,7 @@ mkPackage name = (name ++ "-1.0.0.0.tar.gz",               BS.unpack targz,
                           "",
                           "Library {",
                           "    exposed-modules: " ++ modName,
-                          "}"]
+                          "}"] ++ maybe "" ("\n" ++) additionalCabalFileContents
           modFile = unlines [
                         "module " ++ modName ++ " where",
                         "f" ++ name ++ " :: () -> ()",