cabal-install/tests/UnitTests/Distribution/Client/Init/Utils.hs

   1 module UnitTests.Distribution.Client.Init.Utils
   2   ( dummyFlags
   3   , emptyFlags
   4   , mkLicense
   5   , baseVersion
   6   , mangleBaseDep
   7   , (@?!)
   8   , (@!?)
   9   ) where
  10
  11 import Distribution.Client.Init.Types
  12
  13 import qualified Distribution.SPDX as SPDX
  14
  15 import Distribution.CabalSpecVersion
  16 import Distribution.FieldGrammar.Newtypes
  17 import Distribution.Pretty
  18 import Distribution.Simple.Compiler
  19 import Distribution.Simple.Setup
  20 import Distribution.Types.Dependency
  21 import Distribution.Types.PackageName
  22 import Distribution.Types.Version
  23 import Distribution.Types.VersionRange
  24 import Language.Haskell.Extension
  25 import Test.Tasty.HUnit
  26
  27 -- -------------------------------------------------------------------- --
  28 -- Test flags
  29
  30 dummyFlags :: InitFlags
  31 dummyFlags =
  32   emptyFlags
  33     { noComments = Flag True
  34     , packageName = Flag (mkPackageName "QuxPackage")
  35     , version = Flag (mkVersion [4, 2, 6])
  36     , cabalVersion = Flag CabalSpecV2_2
  37     , license = Flag $ SpecLicense $ Left $ SPDX.License $ SPDX.ELicense (SPDX.ELicenseId SPDX.MIT) Nothing
  38     , author = Flag "Foobar"
  39     , email = Flag "foobar@qux.com"
  40     , homepage = Flag "qux.com"
  41     , synopsis = Flag "We are Qux, and this is our package"
  42     , category = Flag "Control"
  43     , language = Flag Haskell98
  44     , initializeTestSuite = Flag True
  45     , sourceDirs = Flag ["quxSrc"]
  46     , testDirs = Flag ["quxTest"]
  47     , applicationDirs = Flag ["quxApp"]
  48     }
  49
  50 emptyFlags :: InitFlags
  51 emptyFlags = mempty
  52
  53 -- | Retrieves the proper base version based on the GHC version
  54 baseVersion :: Compiler -> VersionRange
  55 baseVersion Compiler{compilerId = CompilerId GHC ver} =
  56   let ghcToBase = baseVersion' . prettyShow $ ver
  57    in if null ghcToBase
  58         then anyVersion
  59         else majorBoundVersion $ mkVersion ghcToBase
  60 baseVersion _ = anyVersion
  61
  62 baseVersion' :: String -> [Int]
  63 baseVersion' "9.0.1" = [4, 15, 0, 0]
  64 baseVersion' "8.10.4" = [4, 14, 1, 0]
  65 baseVersion' "8.8.4" = [4, 13, 0, 0]
  66 baseVersion' "8.6.5" = [4, 12, 0, 0]
  67 baseVersion' "8.4.4" = [4, 11, 1, 0]
  68 baseVersion' "8.2.2" = [4, 10, 1, 0]
  69 baseVersion' "7.10.3" = [4, 9, 0, 0]
  70 baseVersion' "7.8.4" = [4, 8, 0, 0]
  71 baseVersion' "7.6.3" = [4, 7, 0, 0]
  72 baseVersion' _ = []
  73
  74 -- -------------------------------------------------------------------- --
  75 -- Test utils
  76
  77 mkLicense :: SPDX.LicenseId -> SPDX.License
  78 mkLicense lid = SPDX.License (SPDX.ELicense (SPDX.ELicenseId lid) Nothing)
  79
  80 mangleBaseDep :: a -> (a -> [Dependency]) -> [Dependency]
  81 mangleBaseDep target f =
  82   [ if unPackageName x == "base"
  83     then Dependency x anyVersion z
  84     else dep
  85   | dep@(Dependency x _ z) <- f target
  86   ]
  87
  88 infix 1 @?!, @!?
  89
  90 -- | Just like @'@?='@, except it checks for difference rather than equality.
  91 (@?!)
  92   :: (Eq a, Show a, HasCallStack)
  93   => a
  94   -> a
  95   -> Assertion
  96 actual @?! unexpected =
  97   assertBool
  98     ("unexpected: " ++ show unexpected)
  99     (actual /= unexpected)
 100
 101 -- | Just like @'@=?'@, except it checks for difference rather than equality.
 102 (@!?)
 103   :: (Eq a, Show a, HasCallStack)
 104   => a
 105   -> a
 106   -> Assertion
 107 (@!?) = flip (@?!)