{-# LANGUAGE PatternSynonyms #-} module UnitTests.Distribution.Client.UserConfig ( tests ) where import Control.Exception (bracket) import Control.Monad (replicateM_) import Data.List (sort) import System.Directory ( doesFileExist , getCurrentDirectory , getTemporaryDirectory ) import System.FilePath (()) import System.IO (hClose, openTempFile) import Test.Tasty import Test.Tasty.HUnit import Distribution.Client.Config import Distribution.Client.Setup (GlobalFlags (..), InstallFlags (..)) import Distribution.Simple.Setup (ConfigFlags (..), fromFlag, pattern Flag) import Distribution.Simple.Utils (ordNub, removeFileForcibly, withTempDirectory) import Distribution.Utils.NubList (fromNubList) import Distribution.Verbosity tests :: [TestTree] tests = [ testCase "nullDiffOnCreate" nullDiffOnCreateTest , testCase "canDetectDifference" canDetectDifference , testCase "canUpdateConfig" canUpdateConfig , testCase "doubleUpdateConfig" doubleUpdateConfig , testCase "newDefaultConfig" newDefaultConfig ] nullDiffOnCreateTest :: Assertion nullDiffOnCreateTest = bracketTest $ \configFile -> do -- Create a new default config file in our test directory. _ <- createDefaultConfigFile (mkVerbosity defaultVerbosityHandles silent) [] configFile -- Now we read it in and compare it against the default. diff <- userConfigDiff (mkVerbosity defaultVerbosityHandles silent) (globalFlags configFile) [] assertBool (unlines $ "Following diff should be empty:" : diff) $ null diff canDetectDifference :: Assertion canDetectDifference = bracketTest $ \configFile -> do -- Create a new default config file in our test directory. _ <- createDefaultConfigFile (mkVerbosity defaultVerbosityHandles silent) [] configFile appendFile configFile "verbose: 0\n" diff <- userConfigDiff (mkVerbosity defaultVerbosityHandles silent) (globalFlags configFile) [] assertBool (unlines $ "Should detect a difference:" : diff) $ diff == ["+ verbose: 0"] canUpdateConfig :: Assertion canUpdateConfig = bracketTest $ \configFile -> do -- Write a trivial cabal file. writeFile configFile "tests: True\n" -- Update the config file. userConfigUpdate (mkVerbosity defaultVerbosityHandles silent) (globalFlags configFile) [] -- Load it again. updated <- loadConfig (mkVerbosity defaultVerbosityHandles silent) (Flag configFile) assertBool "Field 'tests' should be True" $ fromFlag (configTests $ savedConfigureFlags updated) doubleUpdateConfig :: Assertion doubleUpdateConfig = bracketTest $ \configFile -> do -- Create a new default config file in our test directory. _ <- createDefaultConfigFile (mkVerbosity defaultVerbosityHandles silent) [] configFile -- Update it twice. replicateM_ 2 $ userConfigUpdate (mkVerbosity defaultVerbosityHandles silent) (globalFlags configFile) [] -- Load it again. updated <- loadConfig (mkVerbosity defaultVerbosityHandles silent) (Flag configFile) assertBool "Field 'remote-repo' doesn't contain duplicates" $ listUnique (map show . fromNubList . globalRemoteRepos $ savedGlobalFlags updated) assertBool "Field 'extra-prog-path' doesn't contain duplicates" $ listUnique (map show . fromNubList . configProgramPathExtra $ savedConfigureFlags updated) assertBool "Field 'build-summary' doesn't contain duplicates" $ listUnique (map show . fromNubList . installSummaryFile $ savedInstallFlags updated) newDefaultConfig :: Assertion newDefaultConfig = do sysTmpDir <- getTemporaryDirectory withTempDirectory sysTmpDir "cabal-test" $ \tmpDir -> do let configFile = tmpDir "tmp.config" _ <- createDefaultConfigFile (mkVerbosity defaultVerbosityHandles silent) [] configFile exists <- doesFileExist configFile assertBool ("Config file should be written to " ++ configFile) exists globalFlags :: FilePath -> GlobalFlags globalFlags configFile = mempty{globalConfigFile = Flag configFile} listUnique :: Ord a => [a] -> Bool listUnique xs = let sorted = sort xs in ordNub sorted == xs bracketTest :: (FilePath -> IO ()) -> Assertion bracketTest = bracket testSetup testTearDown where testSetup :: IO FilePath testSetup = do cwd <- getCurrentDirectory (configFile, h) <- openTempFile cwd "test-user-config" hClose h pure configFile testTearDown :: FilePath -> IO () testTearDown configFile = mapM_ removeFileForcibly [configFile, configFile ++ ".backup"]