cabal-install/tests/UnitTests/Distribution/Client/UserConfig.hs

   1 {-# LANGUAGE CPP #-}
   2
   3 module UnitTests.Distribution.Client.UserConfig
   4   ( tests
   5   ) where
   6
   7 import Control.Exception (bracket)
   8 import Control.Monad (replicateM_)
   9 import Data.List (nub, sort)
  10 import System.Directory
  11   ( doesFileExist
  12   , getCurrentDirectory
  13   , getTemporaryDirectory
  14   )
  15 import System.FilePath ((</>))
  16
  17 import Test.Tasty
  18 import Test.Tasty.HUnit
  19
  20 import Distribution.Client.Config
  21 import Distribution.Client.Setup (GlobalFlags (..), InstallFlags (..))
  22 import Distribution.Client.Utils (removeExistingFile)
  23 import Distribution.Simple.Setup (ConfigFlags (..), Flag (..), fromFlag)
  24 import Distribution.Simple.Utils (withTempDirectory)
  25 import Distribution.Utils.NubList (fromNubList)
  26 import Distribution.Verbosity (silent)
  27
  28 tests :: [TestTree]
  29 tests =
  30   [ testCase "nullDiffOnCreate" nullDiffOnCreateTest
  31   , testCase "canDetectDifference" canDetectDifference
  32   , testCase "canUpdateConfig" canUpdateConfig
  33   , testCase "doubleUpdateConfig" doubleUpdateConfig
  34   , testCase "newDefaultConfig" newDefaultConfig
  35   ]
  36
  37 nullDiffOnCreateTest :: Assertion
  38 nullDiffOnCreateTest = bracketTest $ \configFile -> do
  39   -- Create a new default config file in our test directory.
  40   _ <- createDefaultConfigFile silent [] configFile
  41   -- Now we read it in and compare it against the default.
  42   diff <- userConfigDiff silent (globalFlags configFile) []
  43   assertBool (unlines $ "Following diff should be empty:" : diff) $ null diff
  44
  45 canDetectDifference :: Assertion
  46 canDetectDifference = bracketTest $ \configFile -> do
  47   -- Create a new default config file in our test directory.
  48   _ <- createDefaultConfigFile silent [] configFile
  49   appendFile configFile "verbose: 0\n"
  50   diff <- userConfigDiff silent (globalFlags configFile) []
  51   assertBool (unlines $ "Should detect a difference:" : diff) $
  52     diff == ["+ verbose: 0"]
  53
  54 canUpdateConfig :: Assertion
  55 canUpdateConfig = bracketTest $ \configFile -> do
  56   -- Write a trivial cabal file.
  57   writeFile configFile "tests: True\n"
  58   -- Update the config file.
  59   userConfigUpdate silent (globalFlags configFile) []
  60   -- Load it again.
  61   updated <- loadConfig silent (Flag configFile)
  62   assertBool ("Field 'tests' should be True") $
  63     fromFlag (configTests $ savedConfigureFlags updated)
  64
  65 doubleUpdateConfig :: Assertion
  66 doubleUpdateConfig = bracketTest $ \configFile -> do
  67   -- Create a new default config file in our test directory.
  68   _ <- createDefaultConfigFile silent [] configFile
  69   -- Update it twice.
  70   replicateM_ 2 $ userConfigUpdate silent (globalFlags configFile) []
  71   -- Load it again.
  72   updated <- loadConfig silent (Flag configFile)
  73
  74   assertBool ("Field 'remote-repo' doesn't contain duplicates") $
  75     listUnique (map show . fromNubList . globalRemoteRepos $ savedGlobalFlags updated)
  76   assertBool ("Field 'extra-prog-path' doesn't contain duplicates") $
  77     listUnique (map show . fromNubList . configProgramPathExtra $ savedConfigureFlags updated)
  78   assertBool ("Field 'build-summary' doesn't contain duplicates") $
  79     listUnique (map show . fromNubList . installSummaryFile $ savedInstallFlags updated)
  80
  81 newDefaultConfig :: Assertion
  82 newDefaultConfig = do
  83   sysTmpDir <- getTemporaryDirectory
  84   withTempDirectory silent sysTmpDir "cabal-test" $ \tmpDir -> do
  85     let configFile = tmpDir </> "tmp.config"
  86     _ <- createDefaultConfigFile silent [] configFile
  87     exists <- doesFileExist configFile
  88     assertBool ("Config file should be written to " ++ configFile) exists
  89
  90 globalFlags :: FilePath -> GlobalFlags
  91 globalFlags configFile = mempty{globalConfigFile = Flag configFile}
  92
  93 listUnique :: Ord a => [a] -> Bool
  94 listUnique xs =
  95   let sorted = sort xs
  96    in nub sorted == xs
  97
  98 bracketTest :: (FilePath -> IO ()) -> Assertion
  99 bracketTest =
 100   bracket testSetup testTearDown
 101   where
 102     testSetup :: IO FilePath
 103     testSetup = fmap (</> "test-user-config") getCurrentDirectory
 104
 105     testTearDown :: FilePath -> IO ()
 106     testTearDown configFile =
 107       mapM_ removeExistingFile [configFile, configFile ++ ".backup"]